/[slime]/slime/swank.lisp
ViewVC logotype

Diff of /slime/swank.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.322 by eweitz, Thu Aug 11 08:41:34 2005 UTC revision 1.323 by mkoeppe, Sun Aug 14 15:41:18 2005 UTC
# Line 1676  by adding a template for the missing arg Line 1676  by adding a template for the missing arg
1676          :not-available))))          :not-available))))
1677    
1678    
1679    ;;;; Recording and accessing results of computations
1680    
1681    (defvar *record-repl-results* t
1682      "Non-nil means that REPL results are saved for later lookup.")
1683    
1684    (defvar *object-to-presentation-id*
1685      (make-hash-table :test 'eq
1686                       #+openmcl :weak #+openmcl :key)
1687      "Store the mapping of objects to numeric identifiers")
1688    
1689    (defvar *presentation-id-to-object*
1690      (make-hash-table :test 'eq
1691                       #+openmcl :weak #+openmcl :value)
1692      "Store the mapping of numeric identifiers to objects")
1693    
1694    (defun clear-presentation-tables ()
1695      (clrhash *object-to-presentation-id*)
1696      (clrhash *presentation-id-to-object*))
1697    
1698    (defvar *presentation-counter* 0 "identifier counter")
1699    
1700    (defun save-presented-object (object &optional id)
1701      "If the object doesn't already have an id, save it and allocate
1702    one. Otherwise return the old one."
1703      (cond
1704        ((and (not id)
1705              (gethash object *object-to-presentation-id*)))
1706        (t
1707         (let ((newid (or id (decf *presentation-counter*))))
1708           (setf (gethash newid *presentation-id-to-object*) object)
1709           (setf (gethash object *object-to-presentation-id*) newid)
1710           newid))))
1711    
1712    (defvar *not-present* (gensym "NOT-PRESENT"))
1713    
1714    (defun lookup-presented-object (id)
1715      "Retrieve the object corresponding to id. *not-present* returned if it isn't there"
1716      (if (consp id)
1717          (let ((values (gethash (car id) *presentation-id-to-object* *not-present*)))
1718            (if (eql values *not-present*)
1719                *not-present*
1720                (nth (cdr id) values)))
1721          (gethash id *presentation-id-to-object* *not-present*)))
1722    
1723    (defvar *last-repl-result-id* nil)
1724    
1725    (defun add-repl-result (id val)
1726      (save-presented-object val id)
1727      (setq *last-repl-result-id* id)
1728      t)
1729    
1730    (defslimefun get-repl-result (id)
1731      "Get the result of the previous REPL evaluation with ID."
1732      (let ((previous-output (lookup-presented-object id)))
1733        (when (eq previous-output *not-present*)
1734          (if swank::*record-repl-results*
1735              (error "Attempt to access no longer existing result (number ~D)." id)
1736              (error "Attempt to access unrecorded result (number ~D). ~&See ~S."
1737                     id '*record-repl-results*)))
1738        previous-output))
1739    
1740    (defslimefun clear-last-repl-result ()
1741      "Forget the result of the previous REPL evaluation."
1742      (remhash *last-repl-result-id* *presentation-id-to-object*)
1743      t)
1744    
1745    (defslimefun clear-repl-results ()
1746      "Forget the results of all previous REPL evaluations."
1747      (clear-presentation-tables)
1748      t)
1749    
1750    
1751  ;;;; Evaluation  ;;;; Evaluation
1752    
1753  (defvar *pending-continuations* '()  (defvar *pending-continuations* '()
# Line 1871  Return its name and the string to use in Line 1943  Return its name and the string to use in
1943    (let ((p (setq *package* (guess-package-from-string package))))    (let ((p (setq *package* (guess-package-from-string package))))
1944      (list (package-name p) (package-string-for-prompt p))))      (list (package-name p) (package-string-for-prompt p))))
1945    
   
 (defvar *record-repl-results* t  
   "Non-nil means that REPL results are saved in *REPL-RESULTS*.")  
   
 (defparameter *repl-results* '()  
   "Association list of old repl results.")  
   
1946  (defslimefun listener-eval (string)  (defslimefun listener-eval (string)
1947    (clear-user-input)    (clear-user-input)
1948    (with-buffer-syntax ()    (with-buffer-syntax ()
# Line 1899  Return its name and the string to use in Line 1964  Return its name and the string to use in
1964                    (t                    (t
1965                     (mapcar #'prin1-to-string values))))))))                     (mapcar #'prin1-to-string values))))))))
1966    
 (defun add-repl-result (id val)  
   (push (cons id val) *repl-results*)  
   t)  
   
 (defslimefun get-repl-result (id)  
   "Get the result of the previous REPL evaluation with ID."  
   (let ((previous-output (assoc (- id) *repl-results*)))  
     (when (null previous-output)  
       (if *record-repl-results*  
           (error "Attempt to access no longer existing result (number ~D)." (- id))  
           (error "Attempt to access unrecorded result (number ~D). ~&See ~S."  
                  id '*record-repl-results*)))  
     (cdr previous-output)))  
   
 (defslimefun clear-last-repl-result ()  
   "Forget the result of the previous REPL evaluation."  
   (pop *repl-results*)  
   t)  
   
 (defslimefun clear-repl-results ()  
   "Forget the results of all previous REPL evaluations."  
   (setf *repl-results* '())  
   t)  
   
1967  (defslimefun ed-in-emacs (&optional what)  (defslimefun ed-in-emacs (&optional what)
1968    "Edit WHAT in Emacs.    "Edit WHAT in Emacs.
1969    

Legend:
Removed from v.1.322  
changed lines
  Added in v.1.323

  ViewVC Help
Powered by ViewVC 1.1.5