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)