[clim-desktop-cvs] CVS clim-desktop

[thenriksen]

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)
     ()