[slime-cvs] CVS update: slime/ChangeLog slime/slime.el slime/swank.lisp
Marco Baringer
mbaringer at common-lisp.net
Thu Apr 8 15:26:45 UTC 2004
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv11965
Modified Files:
ChangeLog slime.el swank.lisp
Log Message:
REPL Shortcuts. See ChangeLog entry 2004-04-08 Marco Baringer
Date: Thu Apr 8 11:26:44 2004
Author: mbaringer
Index: slime/ChangeLog
diff -u slime/ChangeLog:1.329 slime/ChangeLog:1.330
--- slime/ChangeLog:1.329 Thu Apr 8 07:58:31 2004
+++ slime/ChangeLog Thu Apr 8 11:26:44 2004
@@ -1,3 +1,30 @@
+2004-04-08 Marco Baringer <mb at bese.it>
+
+ * slime.el (slime-repl-package-stack): New buffer local variable.
+ (slime-repl-directory-stack): New buffer local variable.
+ (slime-repl-command-input-complete-p): Remove.
+ (slime-repl-update-banner): New function.
+ (slime-init-output-buffer): Use slime-repl-update-banner.
+ (slime-repl-shortcut-dispatch-char): New variable.
+ (slime-repl-return): Don't check for repl commands anymore.
+ (slime-repl-send-repl-command): Remove.
+ (slime-repl-mode-map): Bind slime-repl-shortcut-dispatch-char to
+ slime-handle-repl-shortcut.
+ (slime-set-default-directory): Use read-directory-name, call
+ slime-repl-update-banner.
+ (slime-repl-shortcut-table): New global variable.
+ (slime-handle-repl-shortcut): New function.
+ (defslime-repl-shortcut): New macro for defining repl shortcuts.
+ (slime-repl-shortcut-help, "change-directory",
+ slime-repl-push-directory, slime-repl-pop-directory,
+ "change-package", slime-repl-push-package, slime-repl-pop-package,
+ slime-repl-resend, slime-repl-sayoonara, slime-repl-defparameter,
+ slime-repl-compile-and-load): New repl shortcuts.
+ (slime-kill-all-buffers): Kill sldb buffers as well.
+
+ * swank.lisp: Remove the repl related functions.
+ (requires-compile-p): New function.
+
2004-04-07 Lawrence Mitchell <wence at gmx.li>
* slime.el (slime-repl-prompt-face): New face.
Index: slime/slime.el
diff -u slime/slime.el:1.257 slime/slime.el:1.258
--- slime/slime.el:1.257 Thu Apr 8 07:55:12 2004
+++ slime/slime.el Thu Apr 8 11:26:44 2004
@@ -88,6 +88,14 @@
Don't access this value directly in a program. Call the function with
the same name instead."))
+(make-variable-buffer-local
+ (defvar slime-repl-package-stack nil
+ "The stack of packages visited in this repl."))
+
+(make-variable-buffer-local
+ (defvar slime-repl-directory-stack nil
+ "The stack of default directories associated with this repl."))
+
(defvar slime-dont-prompt nil
"* When true, don't prompt the user for input during startup.
This is used for batch-mode testing.")
@@ -406,25 +414,6 @@
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)))
@@ -1807,28 +1796,34 @@
(unless noprompt (slime-repl-insert-prompt "" 0))
(current-buffer)))))
+(defun slime-repl-update-banner ()
+ (let ((banner (format "%s Port: %s Pid: %s Pwd: %s"
+ (slime-lisp-implementation-type)
+ (if (featurep 'xemacs)
+ (process-id (slime-connection))
+ (process-contact (slime-connection)))
+ (slime-pid)
+ (expand-file-name default-directory))))
+ ;; Emacs21 has the fancy persistent header-line.
+ (cond ((boundp 'header-line-format)
+ (setq header-line-format banner)
+ (pop-to-buffer (current-buffer))
+ (when (fboundp 'animate-string)
+ ;; and dancing text
+ (when (zerop (buffer-size))
+ (animate-string (format "; SLIME %s" slime-changelog-date)
+ 0 0)))
+ (slime-repl-insert-prompt ""))
+ (t
+ (slime-repl-insert-prompt (concat "; " banner))
+ (pop-to-buffer (current-buffer))))))
+
(defun slime-init-output-buffer (connection)
(with-current-buffer (slime-output-buffer t)
(set (make-local-variable 'slime-buffer-connection) connection)
- (let ((banner (format "%s Port: %s Pid: %s"
- (slime-lisp-implementation-type)
- (if (featurep 'xemacs)
- (process-id (slime-connection))
- (process-contact (slime-connection)))
- (slime-pid))))
- ;; Emacs21 has the fancy persistent header-line.
- (cond ((boundp 'header-line-format)
- (setq header-line-format banner)
- (pop-to-buffer (current-buffer))
- (when (fboundp 'animate-string)
- ;; and dancing text
- (when (zerop (buffer-size))
- (animate-string (format "; SLIME %s" slime-changelog-date)
- 0 0)))
- (slime-repl-insert-prompt ""))
- (t
- (slime-repl-insert-prompt (concat "; " banner))
- (pop-to-buffer (current-buffer)))))))
+ ;; set the directory stack
+ (setq slime-repl-directory-stack (list (expand-file-name default-directory)))
+ (slime-repl-update-banner)))
(defvar slime-show-last-output-function
'slime-maybe-display-output-buffer
@@ -1983,6 +1978,11 @@
(defvar slime-repl-input-end-mark)
(defvar slime-repl-last-input-start-mark))
+(defcustom slime-repl-shortcut-dispatch-char ?\,
+ "Character used to distinguish repl commands from lisp forms."
+ :type '(character)
+ :group 'slime)
+
(defvar slime-repl-mode-map)
(defun slime-repl-buffer (&optional create)
@@ -2182,10 +2182,6 @@
(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)
@@ -2205,28 +2201,6 @@
(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 "\\s-*,"))
- (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 "^\\s-*\\+\\s-*$" 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)
@@ -2415,6 +2389,7 @@
("\C-c\C-p" 'slime-repl-previous-prompt)
("\M-\C-a" 'slime-repl-beginning-of-defun)
("\M-\C-e" 'slime-repl-end-of-defun)
+ ((string slime-repl-shortcut-dispatch-char) 'slime-handle-repl-shortcut)
)
(define-minor-mode slime-repl-read-mode
@@ -4414,9 +4389,10 @@
(message "*package*: %s" (slime-eval `(swank:set-package ,package))))
(defun slime-set-default-directory (directory)
- (interactive (list (read-file-name "Directory: " nil default-directory t)))
+ (interactive (list (read-directory-name "Directory: " nil nil t)))
(with-current-buffer (slime-output-buffer)
- (setq default-directory (expand-file-name directory)))
+ (setq default-directory (expand-file-name directory))
+ (slime-repl-update-banner))
(message "default-directory: %s"
(slime-eval `(swank:set-default-directory
,(expand-file-name directory)))))
@@ -5757,6 +5733,145 @@
(put 'def-slime-test 'lisp-indent-function 4)
(put 'slime-check 'lisp-indent-function 1)
+;;;; REPL handlers
+
+(defvar slime-repl-shortcut-table nil)
+
+(defun slime-handle-repl-shortcut ()
+ (interactive)
+ (if (save-excursion
+ (goto-char slime-repl-input-start-mark)
+ (looking-at " *$"))
+ (let* ((command-name (completing-read "Command: "
+ slime-repl-shortcut-table
+ nil
+ t
+ nil
+ 'slime-repl-shortcut-history))
+ (command-spec (cdr (assoc command-name slime-repl-shortcut-table))))
+ (call-interactively (cdr (assoc :handler command-spec))))
+ (insert (string slime-repl-shortcut-dispatch-char))))
+
+(defmacro defslime-repl-shortcut (elisp-name names &rest options)
+ `(progn
+ ,(when elisp-name
+ `(defun ,elisp-name ()
+ (interactive)
+ (call-interactively ,(cdr (assoc :handler options)))))
+ ,@(loop
+ initially (setf options (mapcar (lambda (option)
+ `(cons ,(first option) ,(second option)))
+ options))
+ for name in names
+ collect `(if (assoc ,name slime-repl-shortcut-table)
+ (setf (cdr (assoc ,name slime-repl-shortcut-table))
+ (list ,name , at options))
+ (push (list ,name , at options) slime-repl-shortcut-table)))
+ ',elisp-name))
+
+(defslime-repl-shortcut slime-repl-shortcut-help ("?" "help")
+ (:handler (lambda ()
+ (interactive)
+ (slime-with-output-to-temp-buffer "*slime-repl-help*"
+ (dolist (repl-shortcut slime-repl-shortcut-table)
+ (insert (first repl-shortcut) "\n")
+ (insert " " (cdr (assoc :one-liner repl-shortcut)) "\n")))))
+ (:one-liner "Display the help."))
+
+(defslime-repl-shortcut nil ("!d" "change-directory")
+ (:handler 'slime-set-default-directory)
+ (:one-liner "Change the current directory."))
+
+(defslime-repl-shortcut slime-repl-push-directory ("+d" "push-directory")
+ (:handler (lambda (directory)
+ (interactive (list (expand-file-name (read-directory-name "Push directory: "
+ (slime-eval '(cl:namestring
+ (cl:truename
+ cl:*default-pathname-defaults*)))
+ nil nil ""))))
+ (push directory slime-repl-directory-stack)
+ (slime-set-default-directory directory)))
+ (:one-liner "Push a new directory onto the directory stack."))
+
+(defslime-repl-shortcut slime-repl-pop-directory ("-d" "pop-directory")
+ (:handler (lambda ()
+ (interactive)
+ (unless (= 1 (length slime-repl-directory-stack))
+ (pop slime-repl-directory-stack))
+ (slime-set-default-directory (car slime-repl-directory-stack))))
+ (:one-liner "Pop the current directory."))
+
+(defslime-repl-shortcut nil ("!p" "change-package")
+ (:handler 'slime-repl-set-package)
+ (:one-liner "Change the current package."))
+
+(defslime-repl-shortcut slime-repl-push-package ("+p" "push-package")
+ (:handler (lambda (package)
+ (interactive (list (slime-read-package-name "Package: ")))
+ (push package slime-repl-package-stack)
+ (slime-repl-set-package package)))
+ (:one-liner "Push a package onto the package stack."))
+
+(defslime-repl-shortcut slime-repl-pop-package ("-p" "pop-package")
+ (:handler (lambda ()
+ (interactive)
+ (unless (= 1 (length slime-repl-package-stack))
+ (pop slime-repl-package-stack))
+ (slime-repl-set-package (car slime-repl-package-stack))))
+ (:one-liner "Pop the top of the package stack."))
+
+(defslime-repl-shortcut slime-repl-resend ("resend-form")
+ (:handler (lambda ()
+ (interactive)
+ (insert (car slime-repl-input-history))
+ (insert "\n")
+ (slime-repl-send-input)))
+ (:one-liner "Resend the last form."))
+
+(defslime-repl-shortcut slime-repl-sayoonara ("sayoonara")
+ (:handler (lambda ()
+ (interactive)
+ (slime-eval-async '(swank-backend:quit-lisp) "SWANK-BACKEND" (lambda (_) nil))
+ (slime-kill-all-buffers)))
+ (:one-liner "Quit the lisp and close all SLIME buffers."))
+
+(defslime-repl-shortcut slime-repl-defparameter ("!" "defparameter")
+ (:handler (lambda (name value)
+ (interactive (list (slime-read-symbol-name "Name (symbol): " t)
+ (slime-read-from-minibuffer "Value: " "nil")))
+ (insert "(cl:defparameter " name " " value-form " \"REPL generated global variable.\")")
+ (slime-repl-send-input)))
+ (:one-liner "Define a new global, special, variable."))
+
+(defslime-repl-shortcut slime-repl-compile-and-load ("compile-and-load")
+ (:handler (lambda (file-name)
+ (interactive (list (expand-file-name (read-file-name "File: "
+ nil nil nil nil
+ (lambda (filename)
+ (string-match ".*\\.\\(lisp\\|cl\\)$" filename))))))
+ (lexical-let ((lisp-file-name (slime-to-lisp-filename file.lisp)))
+ (if (slime-eval `(swank::requires-compile-p ,lisp-file-name))
+ (progn
+ (save-some-buffers)
+ (slime-insert-transcript-delimiter
+ (format "Compile file %s" lisp-file-name))
+ (slime-display-output-buffer)
+ (slime-eval-async
+ `(swank:compile-file-for-emacs ,file.lisp nil)
+ nil
+ ;; after compiling we must load.
+ (lexical-let ((buffer (current-buffer)))
+ (lambda (result)
+ (slime-compilation-finished result buffer)
+ (message "Loading %s.." lisp-file-name)
+ (slime-eval-with-transcript `(swank:load-file ,lisp-file-name) nil))))
+ (message "Compiling %s.." lisp-file-name))
+ ;; don't need to compile, just load
+ (progn
+ (message "Loading %s.." lisp-file-name)
+ (slime-eval-with-transcript `(swank:load-file ,lisp-file-name) nil))))))
+ (:one-liner "Compile (if neccessary) and load a lisp file."))
+
;;;; Cleanup after a quit
(defun slime-kill-all-buffers ()
@@ -5764,7 +5879,8 @@
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)))
+ (string-match "\*slime-repl\[\d+\]\*" (buffer-name buf))
+ (string-match "\*sldb .*\*" (buffer-name buf)))
(kill-buffer buf))))
Index: slime/swank.lisp
diff -u slime/swank.lisp:1.165 slime/swank.lisp:1.166
--- slime/swank.lisp:1.165 Wed Apr 7 12:24:03 2004
+++ slime/swank.lisp Thu Apr 8 11:26:44 2004
@@ -1755,6 +1755,12 @@
(defslimefun load-file (filename)
(to-string (load filename)))
+(defun requires-compile-p (pathname)
+ (let ((compile-file-truename (probe-file (compile-file-pathname pathname))))
+ (or (not compile-file-truename)
+ (< (file-write-date compile-file-truename)
+ (file-write-date pathname)))))
+
;;;; Profiling
@@ -2010,49 +2016,6 @@
(lambda ()
(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))))
More information about the slime-cvs
mailing list