Changeset 7968


Ignore:
Timestamp:
Dec 31, 2007, 11:05:17 PM (12 years ago)
Author:
gz
Message:

Fix ticket #106: allow toplevel-read to return a set of bindings to be used
and updated by toplevel-eval. Arrange for selection-input-streams to use this
to set up *package* and have it persist over multiple forms in a single
selection.

Location:
trunk/ccl/level-1
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/level-1/l1-readloop-lds.lisp

    r7808 r7968  
    218218              (setq *in-read-loop* nil
    219219                    *break-level* break-level)
    220               (multiple-value-bind (form path print-result)
     220              (multiple-value-bind (form env print-result)
    221221                  (toplevel-read :input-stream input-stream
    222222                                 :output-stream output-stream
     
    232232                    (exit-interactive-process *current-process*))
    233233                    (or (check-toplevel-command form)
    234                         (let* ((values (toplevel-eval form path)))
     234                        (let* ((values (toplevel-eval form env)))
    235235                          (if print-result (toplevel-print values))))))))
    236236           (format *terminal-io* "~&Cancelled")))
     
    291291    form))
    292292
    293 (defun toplevel-eval (form &optional *loading-file-source-file*)
    294   (setq +++ ++ ++ + + - - form)
    295   (let* ((package *package*)
    296          (values (multiple-value-list (cheap-eval-in-environment form nil))))
    297     (unless (eq package *package*)
    298       (application-ui-operation *application* :note-current-package *package*))
    299     values))
     293(defun toplevel-eval (form &optional env)
     294  (destructuring-bind (vars . vals) (or env '(nil . nil))
     295    (progv vars vals
     296      (setq +++ ++ ++ + + - - form)
     297      (unwind-protect
     298          (let* ((package *package*)
     299                 (values (multiple-value-list (cheap-eval-in-environment form nil))))
     300            (unless (eq package *package*)
     301              ;; If changing a local value (e.g. buffer-local), not useful to notify app
     302              ;; without more info.  Perhaps should have a *source-context* that can send along?
     303              (unless (member '*package* vars)
     304                (application-ui-operation *application* :note-current-package *package*)))
     305            values)
     306        (loop for var in vars as pval on vals
     307          do (setf (car pval) (symbol-value var)))))))
     308
    300309
    301310(defun toplevel-print (values &optional (out *standard-output*))
  • trunk/ccl/level-1/l1-streams.lisp

    r7809 r7968  
    54285428
    54295429(defclass selection-input-stream (fd-character-input-stream)
    5430     ((package :initform nil :reader selection-input-stream-package)
    5431      (pathname :initform nil :reader selection-input-stream-pathname)
    5432      (peer-fd  :reader selection-input-stream-peer-fd)))
     5430  ((package :initform nil :reader selection-input-stream-package)
     5431   (pathname :initform nil :reader selection-input-stream-pathname)
     5432   (env :initform nil :reader selection-input-stream-env)
     5433   (peer-fd  :reader selection-input-stream-peer-fd)))
    54335434
    54345435(defmethod select-stream-class ((class (eql 'selection-input-stream))
     
    54545455;;; else raw data
    54555456(defmethod stream-read-char ((s selection-input-stream))
    5456   (with-slots (package pathname) s
     5457  (with-slots (env package pathname) s
    54575458    (let* ((quoted nil))
    54585459      (loop
     
    54615462            (return ch)
    54625463            (case ch
    5463               (#\^p (setq package nil)
     5464              (#\^p (setq package nil env nil)
    54645465                    (let* ((p (read-line s nil nil)))
    54655466                      (unless (zerop (length p))
    54665467                        (setq package p))))
    5467               (#\^v (setq pathname nil)
     5468              (#\^v (setq pathname nil env nil)
    54685469                    (let* ((p (read-line s nil nil)))
    54695470                      (unless (zerop (length p))
     
    56395640
    56405641;;; Interaction with the REPL.  READ-TOPLEVEL-FORM should return 3
    5641 ;;; values: a form, a (possibly null) pathname, and a boolean that
     5642;;; values: a form, a (possibly null) evaluation env, and a boolean that
    56425643;;; indicates whether or not the result(s) of evaluating the form
    56435644;;; should be printed.  (The last value has to do with how selections
     
    56895690                               eof-value)
    56905691  (if (eq (stream-peek-char stream) :eof)
    5691     (values eof-value nil t)
    5692     (let* ((*package* *package*)
    5693            (pkg-name (selection-input-stream-package stream)))
    5694       (when pkg-name (setq *package* (pkg-arg pkg-name)))
    5695       (let* ((form (call-next-method))
     5692    (with-slots (env package pathname) stream
     5693      (setf env nil package nil pathname nil)
     5694      (values eof-value nil t))
     5695    (with-slots (env package pathname) stream
     5696      (when (and (or package pathname) (null env))
     5697        (setf env (cons '(*package* *loading-file-source-file*)
     5698                        (list (or (and package (pkg-arg package)) *package*) pathname))))
     5699      (let* ((form (progv (car env) (cdr env)
     5700                     (call-next-method)))
    56965701             (last-form-in-selection (not (listen stream))))
    5697         (values form
    5698                 (selection-input-stream-pathname stream)
    5699                 (or last-form-in-selection *verbose-eval-selection*))))))
    5700 
    5701                              
     5702        (values form env (or last-form-in-selection *verbose-eval-selection*))))))
     5703
     5704
    57025705(defun column (&optional stream)
    57035706  (let* ((stream (real-print-stream stream)))
Note: See TracChangeset for help on using the changeset viewer.