Ignore:
Timestamp:
Jan 17, 2008, 3:03:18 PM (12 years ago)
Author:
gb
Message:

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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/1.2/devel/source/level-1/l1-readloop-lds.lisp

    r8130 r8168  
    273273              (setq *in-read-loop* nil
    274274                    *break-level* break-level)
    275               (multiple-value-bind (form path print-result)
     275              (multiple-value-bind (form env print-result)
    276276                  (toplevel-read :input-stream input-stream
    277277                                 :output-stream output-stream
     
    287287                    (exit-interactive-process *current-process*))
    288288                    (or (check-toplevel-command form)
    289                         (let* ((values (toplevel-eval form path)))
     289                        (let* ((values (toplevel-eval form env)))
    290290                          (if print-result (toplevel-print values))))))))
    291291           (format *terminal-io* "~&Cancelled")))
     
    327327                          (cons keyword params)
    328328                          keyword)))
    329                     (params (eval param))))))))))))
     329                    (params param)))))))))))
    330330
    331331;;; Read a form from the specified stream.
     
    346346    form))
    347347
    348 (defun toplevel-eval (form &optional *loading-file-source-file*)
    349   (setq +++ ++ ++ + + - - form)
    350   (let* ((package *package*)
    351          (values (multiple-value-list (cheap-eval-in-environment form nil))))
    352     (unless (eq package *package*)
    353       (application-ui-operation *application* :note-current-package *package*))
    354     values))
     348(defun toplevel-eval (form &optional env)
     349  (destructuring-bind (vars . vals) (or env '(nil . nil))
     350    (progv vars vals
     351      (setq +++ ++ ++ + + - - form)
     352      (unwind-protect
     353          (let* ((package *package*)
     354                 (values (multiple-value-list (cheap-eval-in-environment form nil))))
     355            (unless (eq package *package*)
     356              ;; If changing a local value (e.g. buffer-local), not useful to notify app
     357              ;; without more info.  Perhaps should have a *source-context* that can send along?
     358              (unless (member '*package* vars)
     359                (application-ui-operation *application* :note-current-package *package*)))
     360            values)
     361        (loop for var in vars as pval on vals
     362          do (setf (car pval) (symbol-value var)))))))
     363
    355364
    356365(defun toplevel-print (values &optional (out *standard-output*))
     
    362371    (dolist (val values) (write val :stream out) (terpri out))))
    363372
     373(defparameter *listener-prompt-format* "~[?~:;~:*~d>~] ")
     374
     375 
    364376(defun print-listener-prompt (stream &optional (force t))
    365377  (unless *quiet-flag*
    366378    (when (or force (neq *break-level* *last-break-level*))
    367379      (let* ((*listener-indent* nil))
    368         (fresh-line stream)           
    369         (if (%izerop *break-level*)
    370           (%write-string "?" stream)
    371           (format stream "~s >" *break-level*)))       
    372       (write-string " " stream)       
     380        (fresh-line stream)
     381        (format stream *listener-prompt-format* *break-level*))
    373382      (setq *last-break-level* *break-level*)))
    374383    (force-output stream))
     
    399408(defmethod application-error ((a lisp-development-system) condition error-pointer)
    400409  (break-loop-handle-error condition error-pointer))
    401 
    402 (defun abnormal-application-exit ()
    403   (print-call-history)
    404   (force-output *debug-io*)
    405   (quit -1))
    406410
    407411(defun break-loop-handle-error (condition error-pointer)
Note: See TracChangeset for help on using the changeset viewer.