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

Modified Files: swine.lisp swine-cmds.lisp Log Message: Changed the macroexpansion code to be more sane, simpler and not use Swank.

--- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/18 21:32:15 1.6 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/18 22:13:24 1.7 @@ -47,9 +47,7 @@ (defun text-of-expression-at-mark (mark syntax) "Return the text of the expression at mark." (let ((expression (expression-at-mark mark syntax))) - (buffer-substring (buffer mark) - (start-offset expression) - (end-offset expression)))) + (token-string syntax expression)))

(defun symbol-name-at-mark (mark syntax) "Return the text of the symbol at mark." @@ -57,27 +55,28 @@ (expression-at-mark mark syntax) :preserve)))

-(defun macroexpand-with-swank (mark syntax &optional (all nil)) - (with-slots (package) syntax - (let* ((string (text-of-expression-at-mark mark syntax)) - (swank::*buffer-package* (or package *package*)) - (swank::*buffer-readtable* *readtable*) - (expansion (if all - (swank::swank-macroexpand-all string) - (swank::swank-macroexpand string)))) - (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) - (insert-object point #\Newline))))) +(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))))

(defun last-expression (mark syntax) "Returns the expression before MARK" --- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/18 21:32:15 1.12 +++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/18 22:13:24 1.13 @@ -41,8 +41,11 @@

The expanded expression will be displayed in a "*Macroexpansion*"-buffer." - (macroexpand-with-swank (point (current-window)) - (syntax (buffer (current-window))))) + (let* ((syntax (syntax (buffer (current-window)))) + (token (expression-at-mark (point (current-window)) syntax))) + (if token + (macroexpand-token syntax token) + (esa:display-message "Nothing to expand at point."))))

(esa:set-key 'com-macroexpand-1 'lisp-table @@ -58,8 +61,11 @@

The expanded expression will be displayed in a "*Macroexpansion*"-buffer." - (macroexpand-with-swank (point (current-window)) - (syntax (buffer (current-window))) t)) + (let* ((syntax (syntax (buffer (current-window)))) + (token (expression-at-mark (point (current-window)) syntax))) + (if token + (macroexpand-token syntax token t) + (esa:display-message "Nothing to expand at point."))))

(define-command (com-eval-region :name t :command-table lisp-table) ()