File: swank-listener-hooks.lisp

package info (click to toggle)
slime 1:20080223.dfsg-1
  • links: PTS
  • area: main
  • in suites: lenny
  • size: 2,600 kB
  • ctags: 3,345
  • sloc: lisp: 30,707; sh: 163; makefile: 119; awk: 10
file content (82 lines) | stat: -rw-r--r-- 3,110 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
;;; swank-listener-hooks.lisp --- listener with special hooks
;;
;; Author: Alan Ruttenberg  <alanr-l@mumble.net>

;; I guess that only Alan Ruttenberg knows how to use this code.  It
;; was in swank.lisp for a long time, so here it is. -- Helmut Eller

(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)
  (with-input-from-string (stream string)
    (let (- values)
      (loop
       (let ((form (read stream nil stream)))
	 (when (eq form stream)
	   (fresh-line)
	   (finish-output)
	   (return (values values -)))
	 (setq - form)
	 (if *slime-repl-eval-hooks* 
	     (setq values (run-repl-eval-hooks form))
	     (setq values (multiple-value-list (eval form))))
	 (finish-output))))))

(defun run-repl-eval-hooks (form)
  (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 (return 
		  (if (eq res *slime-repl-eval-hook-pass*)
		      (multiple-value-list (eval form))
		      res))))

(defun %listener-eval (string)
  (clear-user-input)
  (with-buffer-syntax ()
    (track-package 
     (lambda ()
       (let ((*slime-repl-suppress-output* :unset)
	     (*slime-repl-advance-history* :unset))
	 (multiple-value-bind (values last-form) (%eval-region string)
	   (unless (or (and (eq values nil) (eq last-form nil))
		       (eq *slime-repl-advance-history* nil))
	     (setq *** **  ** *  * (car values)
		   /// //  // /  / values))
	   (setq +++ ++  ++ +  + last-form)
	   (unless (eq *slime-repl-suppress-output* t)
	     (funcall *send-repl-results-function* values))))))))

(setq *listener-eval-function* '%listener-eval)

(provide :swank-listener-hooks)