Permalink
Browse files

See ChangeLog entry 2004-04-06 Marco Baringer

  • Loading branch information...
1 parent aa16c94 commit 9decabc7fb65f03bcc7e8a9a2fa3e1e4c96fa082 Marco Baringer committed Apr 6, 2004
Showing with 139 additions and 2 deletions.
  1. +20 −0 ChangeLog
  2. +57 −2 slime.el
  3. +3 −0 swank-allegro.lisp
  4. +4 −0 swank-backend.lisp
  5. +3 −0 swank-clisp.lisp
  6. +3 −0 swank-cmucl.lisp
  7. +3 −0 swank-openmcl.lisp
  8. +3 −0 swank-sbcl.lisp
  9. +43 −0 swank.lisp
View
@@ -1,3 +1,23 @@
+2004-04-06 Marco Baringer <mb@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@bluetail.com>
* swank.lisp (macro-indentation): Check that the arglist is
View
@@ -401,6 +401,25 @@ A prefix argument disables this behaviour."
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 @@ after the last prompt to the end of buffer."
(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 @@ balanced."
(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 @@ balanced."
(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)
@@ -5668,6 +5713,16 @@ BODY returns true if the check succeeds."
(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
View
@@ -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))
View
@@ -24,6 +24,7 @@
#:position-p
#:position-pos
#:print-output-to-string
+ #:quit-lisp
))
(in-package :swank-backend)
@@ -524,3 +525,6 @@ Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time."
(definterface receive ()
"Return the next message from current thread's mailbox.")
+
+(definterface quit-lisp ()
+ "Exit the current lisp image.")
View
@@ -435,6 +435,9 @@ Execute BODY with NAME's funtion slot set to FUNCTION."
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)
View
@@ -1466,3 +1466,6 @@ LRA = ~X~%" (mapcar #'fixnum
(pop (mailbox.queue mbox)))))
)
+
+(defimplementation quit-lisp ()
+ (ext::quit))
View
@@ -562,3 +562,6 @@ out IDs for.")
(ccl:wait-on-semaphore (mailbox.semaphore mbox))
(ccl:with-lock-grabbed (mutex)
(pop (mailbox.queue mbox)))))
+
+(defimplementation quit-lisp ()
+ (ccl::quit))
View
@@ -713,3 +713,6 @@ stack."
mutex))))))))
)
+
+(defimplementation quit-lisp ()
+ (sb-ext::quit))
View
@@ -1991,6 +1991,49 @@ a time.")
(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 ,@body))
+ ',name))
+
+(defmacro repl-command (op &rest args)
+ `(if (gethash ,(symbol-name op) *repl-commands*)
+ (funcall (gethash ,(symbol-name op) *repl-commands*) ,@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:

0 comments on commit 9decabc

Please sign in to comment.