[slime-cvs] CVS update: slime/swank.lisp

[Alan Ruttenberg]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv10608/slime

Modified Files:
	swank.lisp 
Log Message:
2005-05-12  Alan Ruttenberg  <alanr-l at mumble.net>

	* swank.lisp Add ability to customize behavior of the repl. To do
	so, add a function to the list swank::*slime-repl-eval-hooks*.
	This function is passed the form typed into the repl. The function
	should decide whether it wants to handle evaluation of the
	form. If not, call (repl-eval-hook-pass) and the next hook is
	tried. Otherwise the values the function returns are used instead
	of calling eval. Inside the body of the function you can also
	suppress having the repl print the result by calling
	(repl-suppress-output) and/or suppress the advancement of the
	history variables (*** ** * /// // /) by calling
	(repl-suppress-advance-history).

Date: Thu May 12 21:04:41 2005
Author: aruttenberg

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.297 slime/swank.lisp:1.298
--- slime/swank.lisp:1.297	Tue May  3 20:58:54 2005
+++ slime/swank.lisp	Thu May 12 21:04:41 2005
@@ -1692,6 +1692,37 @@
       (list (get-output-stream-string s) 
             (format nil "~{~S~^~%~}" values)))))
 
+(defvar *slime-repl-advance-history* nil 
+  "In the dynamic scope of a single form typed at the repl, is set to nil to 
+   prevent the repl from advancing the history - * ** *** etc.")
+
+(defvar *slime-repl-suppress-output* nil
+  "In the dynamic scope of a single form typed at the repl, is set to nil to
+   prevent the repl from printing the result of the evalation.")
+  
+(defvar *slime-repl-eval-hook-pass* (gensym "PASS")
+  "Token to indicate that a repl hook declines to evaluate the form")
+
+(defvar *slime-repl-eval-hooks* nil
+  "A list of functions. When the repl is about to eval a form, first try running each of
+   these hooks. The first hook which returns a value which is not *slime-repl-eval-hook-pass*
+   is considered a replacement for calling eval. If there are no hooks, or all
+   pass, then eval is used.")
+
+(defslimefun repl-eval-hook-pass ()
+  "call when repl hook declines to evaluate the form"
+  (throw *slime-repl-eval-hook-pass* *slime-repl-eval-hook-pass*))
+
+(defslimefun repl-suppress-output ()
+  "In the dynamic scope of a single form typed at the repl, call to
+   prevent the repl from printing the result of the evalation."
+  (setq *slime-repl-suppress-output* t))
+
+(defslimefun repl-suppress-advance-history ()
+  "In the dynamic scope of a single form typed at the repl, call to 
+   prevent the repl from advancing the history - * ** *** etc."
+  (setq *slime-repl-advance-history* nil))
+
 (defun eval-region (string &optional package-update-p)
   "Evaluate STRING and return the result.
 If PACKAGE-UPDATE-P is non-nil, and evaluation causes a package
@@ -1706,7 +1737,15 @@
                 (force-output)
                 (return (values values -)))
               (setq - form)
-              (setq values (multiple-value-list (eval form)))
+	      (if *slime-repl-eval-hooks* 
+		  (loop for hook in *slime-repl-eval-hooks* 
+			for res =  (catch *slime-repl-eval-hook-pass* (multiple-value-list (funcall hook form)))
+			until (not (eq res *slime-repl-eval-hook-pass*))
+			finally 
+			(if (eq res *slime-repl-eval-hook-pass*)
+			    (setq values (multiple-value-list (eval form)))
+                            (setq values res)))
+		  (setq values (multiple-value-list (eval form))))
               (force-output)))))
     (when (and package-update-p (not (eq *package* *buffer-package*)))
       (send-to-emacs 
@@ -1786,13 +1825,19 @@
 (defslimefun listener-eval (string)
   (clear-user-input)
   (with-buffer-syntax ()
-    (multiple-value-bind (values last-form) (eval-region string t)
-      (setq +++ ++  ++ +  + last-form
-            *** **  ** *  * (car values)
-            /// //  // /  / values)
-      (cond ((null values) "; No value")
-            (t
-             (format nil "~{~S~^~%~}" values))))))
+    (let ((*slime-repl-suppress-output* :unset)
+	  (*slime-repl-advance-history* :unset))
+      (multiple-value-bind (values last-form) (eval-region string t)
+	(unless (or (and (eq values nil) (eq last-form nil))
+		    (eq *slime-repl-advance-history* nil))
+	  (setq *** **  ** *  * (car values)
+		/// //  // /  / values))
+	(setq +++ ++  ++ +  + last-form)
+	(if (eq *slime-repl-suppress-output* t)
+	    ""
+	    (cond ((null values) "; No value")
+		  (t
+		   (format nil "~{~S~^~%~}" values))))))))
 
 (defslimefun ed-in-emacs (&optional what)
   "Edit WHAT in Emacs.