Changeset 6665

Timestamp:

Jun 3, 2007, 2:58:06 AM (17 years ago)

Author:

Gary Byers

Message:

New selection-stream scheme.
Macroexpand prints to listener output stream.

File:

• branches/ide-1.0/ccl/hemlock/src/listener.lisp (modified) (4 diffs)

branches/ide-1.0/ccl/hemlock/src/listener.lisp

@@ -73 +73 @@
         :buffer buffer
         :value (copy-mark point :right-inserting))
+      (defhvar "Buffer Output Mark"
+        "Mark used for Listener Mode output."
+        :buffer buffer
+        :value (copy-mark point :left-inserting))
       (defhvar "Interactive History"
         "A ring of the regions input to an interactive mode (Eval or Typescript)."
@@ -121 +125 @@
          (output-end (region-end output-region)))
     (hi::with-active-font-region (buffer output-region)
-      (insert-string output-end string)
+      (with-mark ((output-mark output-end :left-inserting))
+        ;(setf (mark-charpos output-mark) 0)
+        (insert-string output-mark string))
       (move-mark (variable-value 'buffer-input-mark :buffer buffer)
                  output-end))))
@@ -486 +492 @@
                     (path (buffer-pathname (current-buffer))))
   (evaluate-input-selection
-   (ccl::make-input-selection
-    :package package
-    :source-file path
-    :string-stream (make-string-input-stream
-                    (region-to-string region)))))                   
+   (list package path (region-to-string region))))
        
                                         
@@ -540 +542 @@
        (message "Evaluation returned ~S" (eval form))))))
 
-(defcommand "Editor Macroexpand Expression" (p)
+(defun macroexpand-expression (expander)
+  (let* ((out (hi::top-listener-output-stream)))
+    (when out
+      (let* ((point (buffer-point (current-buffer)))
+             (region (if (region-active-p)
+                       (current-region)
+                       (with-mark ((start point))
+                         (pre-command-parse-check start)
+                         (with-mark ((end start))
+                           (unless (form-offset end 1) (editor-error))
+                           (region start end)))))
+             (expr (with-input-from-region (s region)
+                           (read s))))
+        (let* ((*print-pretty* t))
+          (format out "~&~s~&" (funcall expander expr)))))))
+
+(defcommand "Editor Macroexpand-1 Expression" (p)
   "Show the macroexpansion of the current expression in the null environment.
    With an argument, use MACROEXPAND instead of MACROEXPAND-1."
   "Show the macroexpansion of the current expression in the null environment.
    With an argument, use MACROEXPAND instead of MACROEXPAND-1."
-  (let ((point (buffer-point (current-buffer))))
-    (with-mark ((start point))
-      (pre-command-parse-check start)
-      (with-mark ((end start))
-        (unless (form-offset end 1) (editor-error))
-        (in-lisp
-         (with-pop-up-display (rts)
-           (write-string (with-input-from-region (s (region start end))
-                           (prin1-to-string (funcall (if p
-                                                         'macroexpand
-                                                         'macroexpand-1)
-                                                     (read s))))
-                         rts)))))))
+  (macroexpand-expression (if p 'macroexpand 'macroexpand-1)))
+
+(defcommand "Editor Macroexpand Expression" (p)
+  "Show the macroexpansion of the current expression in the null environment.
+   With an argument, use MACROEXPAND-1 instead of MACROEXPAND."
+  "Show the macroexpansion of the current expression in the null environment.
+   With an argument, use MACROEXPAND-1 instead of MACROEXPAND."
+  (macroexpand-expression (if p 'macroexpand-1 'macroexpand)))
+
 
 (defcommand "Editor Evaluate Expression" (p)