[clim-desktop-cvs] CVS clim-desktop

[thenriksen]

Update of /project/clim-desktop/cvsroot/clim-desktop
In directory clnet:/tmp/cvs-serv19304

Modified Files:
	swine.lisp 
Log Message:
Fixed `macroexpand-token' to set the package "properly" before
macroexpanding and fixed `one-line-ify' to not break on strings with
ending linespace.


--- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp	2006/06/03 11:26:45	1.21
+++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp	2006/06/03 17:50:56	1.22
@@ -153,27 +153,29 @@
 ;;; Real code:
 
 (defun macroexpand-token (syntax token &optional (all nil))
-  (let* ((string (token-string syntax token))
-         (expression (read-from-string string))
-         (expansion (funcall (if all
-                                 #'macroexpand
-                                 #'macroexpand-1)
-                             expression))
-         (expansion-string (with-output-to-string (s)
-                             (pprint expansion s))))
-    (let ((buffer (climacs-gui::switch-to-buffer "*Macroexpansion*")))
-      (climacs-gui::set-syntax buffer "Lisp"))
-    (let ((point (point (climacs-gui::current-window)))
-          (header-string (one-line-ify (subseq string 0
-                                               (min 40 (length string))))))
-      (climacs-gui::end-of-buffer point)
-      (unless (beginning-of-buffer-p point)
-        (insert-object point #\Newline))
-      (insert-sequence point
-                       (format nil ";;; Macroexpand-~:[1~;all~] ~A...~%"
-                               all header-string))
-      (insert-sequence point expansion-string)
-      (insert-object point #\Newline))))
+  (with-syntax-package syntax (package)
+    (let ((*package* package))
+      (let* ((string (token-string syntax token))
+             (expression (read-from-string string))
+             (expansion (funcall (if all
+                                     #'macroexpand
+                                     #'macroexpand-1)
+                                 expression))
+             (expansion-string (with-output-to-string (s)
+                                 (pprint expansion s))))
+        (let ((buffer (climacs-gui::switch-to-buffer "*Macroexpansion*")))
+          (climacs-gui::set-syntax buffer "Lisp"))
+        (let ((point (point (climacs-gui::current-window)))
+              (header-string (one-line-ify (subseq string 0
+                                                   (min 40 (length string))))))
+          (climacs-gui::end-of-buffer point)
+          (unless (beginning-of-buffer-p point)
+            (insert-object point #\Newline))
+          (insert-sequence point
+                           (format nil ";;; Macroexpand-~:[1~;all~] ~A...~%"
+                                   all header-string))
+          (insert-sequence point expansion-string)
+          (insert-object point #\Newline))))))
 
 (defun eval-string (string)
   "Evaluate all expressions in STRING and return a list of
@@ -383,9 +385,13 @@
        with new-string = (make-array 0 :element-type 'character :adjustable t
                               :fill-pointer 0)
        when (char= (char string count) #\Newline)
-         do (vector-push-extend #\Space new-string)
-            (loop while (whitespacep (char string count))
-                  do (incf count))
+         do (loop while (and (< count (length string))
+                             (whitespacep (char string count)))
+                 do (incf count)
+                 ;; Just ignore whitespace if it is last in the
+                 ;; string.
+                 finally (when (< count (length string))
+                           (vector-push-extend #\Space new-string)))
        else
          do (vector-push-extend (char string count) new-string)
             (incf count)