[climacs-cvs] CVS climacs

[thenriksen]

Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv24921

Modified Files:
	lisp-syntax.lisp 
Log Message:
Now calling `buffer-substring' and `token-string' instead of
`buffer-subsequence'.


--- /project/climacs/cvsroot/climacs/lisp-syntax.lisp	2006/05/06 11:57:23	1.64
+++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp	2006/05/06 17:23:33	1.65
@@ -1141,29 +1141,22 @@
                     (let ((package-name
                            (typecase package-form
                              (token-mixin
-                              (coerce (buffer-sequence
-                                       buffer
-                                       (start-offset package-form)
-                                       (end-offset package-form))
-                                      'string))
+                              (token-string syntax package-form))
                              (complete-string-form
-                              (coerce (buffer-sequence
-                                       buffer
-                                       (1+ (start-offset package-form))
-                                       (1- (end-offset package-form)))
-                                      'string))
+                              (buffer-substring
+                               buffer
+                               (1+ (start-offset package-form))
+                               (1- (end-offset package-form))))
                              (quote-form 
-                              (coerce (buffer-sequence
-                                       buffer
-                                       (start-offset (second-noncomment (children package-form)))
-                                       (end-offset (second-noncomment (children package-form))))
-                                      'string))
+                              (buffer-substring
+                               buffer
+                               (start-offset (second-noncomment (children package-form)))
+                               (end-offset (second-noncomment (children package-form)))))
                              (uninterned-symbol-form
-                              (coerce (buffer-sequence
-                                       buffer
-                                       (start-offset (second-noncomment (children package-form)))
-                                       (end-offset (second-noncomment (children package-form))))
-                                      'string))
+                              (buffer-substring
+                               buffer
+                               (start-offset (second-noncomment (children package-form)))
+                               (end-offset (second-noncomment (children package-form)))))
                              (t 'nil))))
                       (when package-name
                         (let ((package-symbol (parse-token package-name)))
@@ -1430,10 +1423,7 @@
 
 (defmethod display-parse-tree ((parse-symbol token-mixin) (syntax lisp-syntax) pane)
   (if (> (the fixnum (end-offset parse-symbol)) (the fixnum (start-offset parse-symbol)))
-      (let ((string (coerce (buffer-sequence (buffer syntax)
-                                             (start-offset parse-symbol)
-                                             (end-offset parse-symbol))
-                            'string)))
+      (let ((string (token-string syntax parse-symbol)))
         (multiple-value-bind (symbol status)
             (token-to-object syntax parse-symbol)
           (with-output-as-presentation
@@ -1471,10 +1461,7 @@
       (with-slots (ink face) parser-symbol
 	(setf ink (medium-ink (sheet-medium pane))
 	      face (text-style-face (medium-text-style (sheet-medium pane))))
-	(let ((string (coerce (buffer-sequence (buffer syntax)
-					       (start-offset parser-symbol)
-					       (end-offset parser-symbol))
-			      'string)))
+	(let ((string (token-string syntax parser-symbol)))
           (present string 'string :stream pane))))))
           
 (defmethod display-parse-tree :before ((parse-symbol lisp-lexeme) (syntax lisp-syntax) pane)
@@ -1487,10 +1474,9 @@
 (defmethod display-parse-tree ((parse-symbol complete-string-form) (syntax lisp-syntax) pane)
   (let ((children (children parse-symbol)))
     (if (third children)
-        (let ((string (coerce (buffer-sequence (buffer syntax)
-                                               (start-offset (second children))
-                                               (end-offset (car (last children 2))))
-                              'string)))
+        (let ((string (buffer-substring (buffer syntax)
+                                        (start-offset (second children))
+                                        (end-offset (car (last children 2))))))
           (with-output-as-presentation (pane string 'lisp-string
                                              :single-box :highlighting)
             (display-parse-tree  (pop children) syntax pane)
@@ -1504,10 +1490,9 @@
 (defmethod display-parse-tree ((parse-symbol incomplete-string-form) (syntax lisp-syntax) pane)
   (let ((children (children parse-symbol)))
     (if (second children)
-        (let ((string (coerce (buffer-sequence (buffer syntax)
-                                               (start-offset (second children))
-                                               (end-offset (car (last children))))
-                              'string)))
+        (let ((string (buffer-substring (buffer syntax)
+                                        (start-offset (second children))
+                                        (end-offset (car (last children))))))
           (with-output-as-presentation (pane string 'lisp-string
                                              :single-box :highlighting)
             (display-parse-tree  (pop children) syntax pane)
@@ -1553,10 +1538,7 @@
   "The KEYWORD package.")
 
 (defmethod eval-feature-conditional ((conditional token-mixin) (syntax lisp-syntax))
-  (let* ((string (coerce (buffer-sequence (buffer syntax)
-					 (start-offset conditional)
-					 (end-offset conditional))
-		  'string))
+  (let* ((string (token-string syntax conditional))
 	 (symbol (parse-symbol string :package +keyword-package+)))
     (member symbol *features*)))
 
@@ -1572,10 +1554,7 @@
 				(remove-if
 				 #'(lambda (child) (typep child 'comment))
 				 children))))
-	       (type-string (coerce (buffer-sequence (buffer syntax)
-						     (start-offset type)
-						     (end-offset type))
-				    'string))
+	       (type-string (token-string syntax type))
 	       (type-symbol (parse-symbol type-string :package +keyword-package+)))
 	  (case type-symbol
 	    (:and (funcall #'every #'eval-fc conditionals))
@@ -1781,10 +1760,7 @@
 	   when (and (mark<= (start-offset form) mark)
 		     (mark<= mark (end-offset form)))
 	     do (return (eval (read-from-string 
-			       (coerce (buffer-sequence (buffer syntax)
-							(start-offset form)
-							(end-offset form))
-				       'string)))))))
+			       (token-string syntax form)))))))
 
 (defmethod beginning-of-definition (mark (syntax lisp-syntax))
   (with-slots (stack-top) syntax
@@ -1962,10 +1938,9 @@
 (defun token-string (syntax token)
   "Return the string that specifies `token' in the buffer of
   `syntax'."
-  (coerce (buffer-sequence (buffer syntax)
-                           (start-offset token)
-                           (end-offset token))
-          'string))
+  (buffer-substring (buffer syntax)
+                    (start-offset token)
+                    (end-offset token)))
 
 (defun parse-symbol (string &key (package *package*) (case (readtable-case *readtable*)))
   "Find the symbol named STRING.