Changeset 8168

Timestamp:

Jan 17, 2008, 7:03:18 AM (17 years ago)

Author:

Gary Byers

Message:

gz's changes to READ-LOOP (from trunk.)

File:

• branches/1.2/devel/source/level-1/l1-readloop-lds.lisp (modified) (6 diffs)

branches/1.2/devel/source/level-1/l1-readloop-lds.lisp

@@ -273 +273 @@
               (setq *in-read-loop* nil
                     *break-level* break-level)
-              (multiple-value-bind (form path print-result)
+              (multiple-value-bind (form env print-result)
                   (toplevel-read :input-stream input-stream
                                  :output-stream output-stream
@@ -287 +287 @@
                     (exit-interactive-process *current-process*))
                     (or (check-toplevel-command form)
-                        (let* ((values (toplevel-eval form path)))
+                        (let* ((values (toplevel-eval form env)))
                           (if print-result (toplevel-print values))))))))
            (format *terminal-io* "~&Cancelled")))
@@ -327 +327 @@
                           (cons keyword params)
                           keyword)))
-                    (params (eval param))))))))))))
+                    (params param)))))))))))
 
 ;;; Read a form from the specified stream.
@@ -346 +346 @@
     form))
 
-(defun toplevel-eval (form &optional *loading-file-source-file*)
-  (setq +++ ++ ++ + + - - form)
-  (let* ((package *package*)
-         (values (multiple-value-list (cheap-eval-in-environment form nil))))
-    (unless (eq package *package*)
-      (application-ui-operation *application* :note-current-package *package*))
-    values))
+(defun toplevel-eval (form &optional env)
+  (destructuring-bind (vars . vals) (or env '(nil . nil))
+    (progv vars vals
+      (setq +++ ++ ++ + + - - form)
+      (unwind-protect
+          (let* ((package *package*)
+                 (values (multiple-value-list (cheap-eval-in-environment form nil))))
+            (unless (eq package *package*)
+              ;; If changing a local value (e.g. buffer-local), not useful to notify app
+              ;; without more info.  Perhaps should have a *source-context* that can send along?
+              (unless (member '*package* vars)
+                (application-ui-operation *application* :note-current-package *package*)))
+            values)
+        (loop for var in vars as pval on vals
+          do (setf (car pval) (symbol-value var)))))))
+
 
 (defun toplevel-print (values &optional (out *standard-output*))
@@ -362 +371 @@
     (dolist (val values) (write val :stream out) (terpri out))))
 
+(defparameter *listener-prompt-format* "~[?~:;~:*~d>~] ")
+
+  
 (defun print-listener-prompt (stream &optional (force t))
   (unless *quiet-flag*
     (when (or force (neq *break-level* *last-break-level*))
       (let* ((*listener-indent* nil))
-        (fresh-line stream)            
-        (if (%izerop *break-level*)
-          (%write-string "?" stream)
-          (format stream "~s >" *break-level*)))        
-      (write-string " " stream)        
+        (fresh-line stream)
+        (format stream *listener-prompt-format* *break-level*))
       (setq *last-break-level* *break-level*)))
     (force-output stream))
@@ -399 +408 @@
 (defmethod application-error ((a lisp-development-system) condition error-pointer)
   (break-loop-handle-error condition error-pointer))
-
-(defun abnormal-application-exit ()
-  (print-call-history)
-  (force-output *debug-io*)
-  (quit -1))
 
 (defun break-loop-handle-error (condition error-pointer)