[slime-cvs] CVS update: slime/ChangeLog slime/slime.el slime/swank-allegro.lisp slime/swank-backend.lisp slime/swank-clisp.lisp slime/swank-cmucl.lisp slime/swank-openmcl.lisp slime/swank-sbcl.lisp slime/swank.lisp
Marco Baringer
mbaringer at common-lisp.net
Tue Apr 6 10:42:55 UTC 2004
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv9920
Modified Files:
ChangeLog slime.el swank-allegro.lisp swank-backend.lisp
swank-clisp.lisp swank-cmucl.lisp swank-openmcl.lisp
swank-sbcl.lisp swank.lisp
Log Message:
See ChangeLog entry 2004-04-06 Marco Baringer
Date: Tue Apr 6 06:42:53 2004
Author: mbaringer
Index: slime/ChangeLog
diff -u slime/ChangeLog:1.322 slime/ChangeLog:1.323
--- slime/ChangeLog:1.322 Tue Apr 6 03:47:47 2004
+++ slime/ChangeLog Tue Apr 6 06:42:52 2004
@@ -1,3 +1,23 @@
+2004-04-06 Marco Baringer <mb at bese.it>
+
+ * slime.el (slime-repl-command-input-complete-p): New function.
+ (slime-repl-send-string): New optional arg specifying what string
+ to put on slime-repl-input-history, usefull when this string
+ differs from what we actually want to eval.
+ (slime-repl-return): Check for repl commands and pass then to
+ slime-repl-send-repl-command.
+ (slime-repl-send-repl-command): New function.
+ (slime-kill-all-buffers): New function.
+
+ * swank.lisp: Define the various repl command handlers: sayoonara,
+ cd, pwd, pack and cload.
+
+ * swank-backend.lisp (quit-lisp): Define as part of the backend
+ interface and export.
+
+ * swank-sbcl.lisp, swank-openmcl.lisp, swank-cmucl.lisp,
+ swank-clisp.lisp, swank-allegro.lisp (quit-lisp): implement.
+
2004-04-06 Luke Gorrie <luke at bluetail.com>
* swank.lisp (macro-indentation): Check that the arglist is
Index: slime/slime.el
diff -u slime/slime.el:1.253 slime/slime.el:1.254
--- slime/slime.el:1.253 Mon Apr 5 14:03:48 2004
+++ slime/slime.el Tue Apr 6 06:42:52 2004
@@ -401,6 +401,25 @@
t)))
(t t))))
+(defun slime-repl-command-input-complete-p (start end)
+ "Return t if the region from START to END contains a complete SLIME repl command.
+
+ So, what's a SLIME repl command? A #\, followed by the name of
+ a repl command followed by n complete lisp forms."
+ (interactive (list (point-min) (point-max)))
+ (save-excursion
+ (goto-char start)
+ (and (looking-at " *, *")
+ (save-restriction
+ (narrow-to-region (search-forward-regexp "\\s *,") end)
+ (loop
+ do (skip-chars-forward " \t\r\n")
+ until (eobp)
+ do (condition-case nil
+ (forward-sexp)
+ (scan-error (return nil)))
+ finally (return t))))))
+
(defun inferior-slime-input-complete-p ()
"Return true if the input is complete in the inferior lisp buffer."
(slime-input-complete-p (process-mark (get-buffer-process (current-buffer)))
@@ -2019,8 +2038,8 @@
(slime-repl-insert-prompt result)))
((:abort) (slime-repl-show-abort))))
-(defun slime-repl-send-string (string)
- (slime-repl-add-to-input-history string)
+(defun slime-repl-send-string (string &optional command-string)
+ (slime-repl-add-to-input-history (or command-string string))
(cond (slime-repl-read-mode
(slime-repl-return-string string))
(t (slime-repl-eval-string string))))
@@ -2130,6 +2149,10 @@
(cond (current-prefix-arg
(slime-repl-send-input)
(insert "\n"))
+ ((slime-repl-command-input-complete-p slime-repl-input-start-mark slime-repl-input-end-mark)
+ (goto-char slime-repl-input-end-mark)
+ (insert "\n")
+ (slime-repl-send-repl-command))
((slime-input-complete-p slime-repl-input-start-mark
slime-repl-input-end-mark)
(goto-char slime-repl-input-end-mark)
@@ -2149,6 +2172,28 @@
(slime-mark-input-start)
(slime-repl-send-string (concat input "\n"))))
+(defun slime-repl-send-repl-command ()
+ "Goto the end of the input and send the current input (which
+ we're assuming is a repl command."
+ (let ((input (buffer-substring-no-properties (save-excursion
+ (goto-char slime-repl-input-start-mark)
+ (search-forward-regexp " *,"))
+ (save-excursion
+ (goto-char slime-repl-input-end-mark)
+ (when (and (eq (char-before) ?\n)
+ (not (slime-reading-p)))
+ (backward-char 1))
+ (point)))))
+ (goto-char slime-repl-input-end-mark)
+ (add-text-properties slime-repl-input-start-mark (point)
+ '(face slime-repl-input-face rear-nonsticky (face)))
+ (slime-mark-output-start)
+ (slime-mark-input-start)
+ (if (string-match "^ *\\+ *$" input)
+ ;; majik ,+ command
+ (slime-repl-send-string (pop slime-repl-input-history))
+ (slime-repl-send-string (concat "(swank::repl-command " input ")\n") (concat "," input)))))
+
(defun slime-repl-closing-return ()
"Evaluate the current input string after closing all open lists."
(interactive)
@@ -5667,6 +5712,16 @@
(put 'def-slime-test 'lisp-indent-function 4)
(put 'slime-check 'lisp-indent-function 1)
+
+;;;; Cleanup after a quit
+
+(defun slime-kill-all-buffers ()
+ "Kill all the slime related buffers. This is only used by the
+ repl command sayoonara."
+ (dolist (buf (buffer-list))
+ (when (or (member (buffer-name buf) (list "*inferior-lisp*" "*slime-events*"))
+ (string-match "\*slime-repl\[\d+\]\*" (buffer-name buf)))
+ (kill-buffer buf))))
;;;;; Test case definitions
Index: slime/swank-allegro.lisp
diff -u slime/swank-allegro.lisp:1.26 slime/swank-allegro.lisp:1.27
--- slime/swank-allegro.lisp:1.26 Wed Mar 31 17:38:55 2004
+++ slime/swank-allegro.lisp Tue Apr 6 06:42:53 2004
@@ -322,3 +322,6 @@
(mp:process-wait "receive" #'mailbox.queue mbox)
(mp:with-process-lock (mutex)
(pop (mailbox.queue mbox)))))
+
+(defimplementation quit-lisp ()
+ (excl:exit 0 :quiet t))
Index: slime/swank-backend.lisp
diff -u slime/swank-backend.lisp:1.41 slime/swank-backend.lisp:1.42
--- slime/swank-backend.lisp:1.41 Mon Apr 5 02:18:06 2004
+++ slime/swank-backend.lisp Tue Apr 6 06:42:53 2004
@@ -24,6 +24,7 @@
#:position-p
#:position-pos
#:print-output-to-string
+ #:quit-lisp
))
(in-package :swank-backend)
@@ -524,3 +525,6 @@
(definterface receive ()
"Return the next message from current thread's mailbox.")
+
+(definterface quit-lisp ()
+ "Exit the current lisp image.")
Index: slime/swank-clisp.lisp
diff -u slime/swank-clisp.lisp:1.28 slime/swank-clisp.lisp:1.29
--- slime/swank-clisp.lisp:1.28 Tue Mar 23 16:32:17 2004
+++ slime/swank-clisp.lisp Tue Apr 6 06:42:53 2004
@@ -435,6 +435,9 @@
pairs)))
(nreverse pairs))))))
+(defimplementation quit-lisp ()
+ (#+lisp=cl ext:quit #-lisp=cl lisp:quit code))
+
;;; Local Variables:
;;; eval: (put 'compile-file-frobbing-notes 'lisp-indent-function 1)
;;; eval: (put 'dynamic-flet 'common-lisp-indent-function 1)
Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.93 slime/swank-cmucl.lisp:1.94
--- slime/swank-cmucl.lisp:1.93 Wed Mar 31 17:46:04 2004
+++ slime/swank-cmucl.lisp Tue Apr 6 06:42:53 2004
@@ -1466,3 +1466,6 @@
(pop (mailbox.queue mbox)))))
)
+
+(defimplementation quit-lisp ()
+ (ext::quit))
Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.71 slime/swank-openmcl.lisp:1.72
--- slime/swank-openmcl.lisp:1.71 Wed Mar 10 05:03:38 2004
+++ slime/swank-openmcl.lisp Tue Apr 6 06:42:53 2004
@@ -562,3 +562,6 @@
(ccl:wait-on-semaphore (mailbox.semaphore mbox))
(ccl:with-lock-grabbed (mutex)
(pop (mailbox.queue mbox)))))
+
+(defimplementation quit-lisp ()
+ (ccl::quit))
Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.82 slime/swank-sbcl.lisp:1.83
--- slime/swank-sbcl.lisp:1.82 Thu Apr 1 16:27:34 2004
+++ slime/swank-sbcl.lisp Tue Apr 6 06:42:53 2004
@@ -713,3 +713,6 @@
mutex))))))))
)
+
+(defimplementation quit-lisp ()
+ (sb-ext::quit))
Index: slime/swank.lisp
diff -u slime/swank.lisp:1.160 slime/swank.lisp:1.161
--- slime/swank.lisp:1.160 Tue Apr 6 03:46:00 2004
+++ slime/swank.lisp Tue Apr 6 06:42:53 2004
@@ -1991,6 +1991,49 @@
(with-connection (connection)
(simple-break))))))
+;;;; REPL Commands
+
+(defvar *repl-commands* (make-hash-table :test 'equal))
+
+(defmacro defslime-repl-command (name args &body body)
+ `(progn
+ (setf (gethash ,(symbol-name name) *repl-commands*)
+ (lambda ,args , at body))
+ ',name))
+
+(defmacro repl-command (op &rest args)
+ `(if (gethash ,(symbol-name op) *repl-commands*)
+ (funcall (gethash ,(symbol-name op) *repl-commands*) , at args)
+ (error "Unknown repl command ~S." ,(symbol-name op))))
+
+(defslime-repl-command sayoonara ()
+ (eval-in-emacs '(slime-kill-all-buffers))
+ (swank-backend:quit-lisp))
+
+(defslime-repl-command cd (namestring)
+ (set-default-directory namestring))
+
+(defslime-repl-command pwd ()
+ (truename *default-pathname-defaults*))
+
+(defslime-repl-command pack (&optional new-package)
+ (setf *package* (if new-package
+ (or (find-package new-package)
+ (progn
+ (warn "No package named ~S found." new-package)
+ *package*))
+ *package*)))
+
+(defslime-repl-command cload (file &optional force)
+ (unless (probe-file (merge-pathnames file))
+ (error "~S does not exist, can't load it." file))
+ (if (or force
+ (not (probe-file (compile-file-pathname file)))
+ (< (file-write-date (compile-file-pathname file))
+ (file-write-date file)))
+ (compile-file-for-emacs file t)
+ (load file)))
+
;;; Local Variables:
;;; eval: (font-lock-add-keywords 'lisp-mode '(("(\\(defslimefun\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)" (1 font-lock-keyword-face) (2 font-lock-function-name-face))))
;;; End:
More information about the slime-cvs
mailing list