? repl-shortcuts.patch
Index: slime.el
===================================================================
RCS file: /project/slime/cvsroot/slime/slime.el,v
retrieving revision 1.255
diff -u -d -u -r1.255 slime.el
--- slime.el	6 Apr 2004 16:08:36 -0000	1.255
+++ slime.el	7 Apr 2004 18:45:28 -0000
@@ -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.")
@@ -401,25 +409,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)))
@@ -1812,6 +1801,8 @@
                               (process-id (slime-connection))
                             (process-contact (slime-connection)))
                           (slime-pid))))
+      ;; set the directory stack
+      (setq slime-repl-directory-stack (list (expand-file-name default-directory)))
       ;; Emacs21 has the fancy persistent header-line.
       (cond ((boundp 'header-line-format)
              (setq header-line-format banner)
@@ -1979,6 +1970,11 @@
  (defvar slime-repl-input-end-mark)
  (defvar slime-repl-last-input-start-mark))
 
+(defcustom slime-repl-command-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)
@@ -2178,10 +2174,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)
@@ -2201,28 +2193,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 " *,"))
-                                               (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)
@@ -2411,6 +2381,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)
+  ("," 'slime-repl-command)
   )
 
 (define-minor-mode slime-repl-read-mode 
@@ -4399,7 +4370,7 @@
   (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)))
   (message "default-directory: %s" 
@@ -5742,6 +5713,96 @@
 (put 'def-slime-test 'lisp-indent-function 4)
 (put 'slime-check 'lisp-indent-function 1)
 
+;;;; REPL handlers
+
+(defvar slime-repl-command-table nil)
+
+(defun slime-repl-command ()
+  (interactive)
+  (if (save-excursion
+        (goto-char slime-repl-input-start-mark)
+        (looking-at " *$"))
+      (let* ((command-name (completing-read "Command: " 
+                                            slime-repl-command-table 
+                                            nil
+                                            t
+                                            nil
+                                            'slime-repl-command-history))
+             (command-spec (cdr (assoc command-name slime-repl-command-table))))
+        (call-interactively (cdr (assoc :handler command-spec))))
+      (insert ",")))
+
+(setf slime-repl-command-table
+      (list (list "cd"
+                  (cons :handler 'slime-set-default-directory)
+                  (cons :one-liner "Change the default directory."))
+            (list "directory-push" 
+                  (cons :handler 'slime-repl-command/DIRECTORY-PUSH)
+                  (cons :one-liner "Push a new directory onto the directory stack."))
+            (list "directory-pop"
+                  (cons :handler 'slime-repl-command/DIRECTORY-POP)
+                  (cons :one-liner "Pop the current directory."))
+            (list "cp"
+                  (cons :handler 'slime-repl-set-package)
+                  (cons :one-liner "Change the current package."))
+            (list "package-push"
+                  (cons :handler 'slime-repl-command/PACKAGE-PUSH)
+                  (cons :one-liner "Pop the package stack."))
+            (list "package-pop"
+                  (cons :handler 'slime-repl-command/PACKAGE-POP)
+                  (cons :one-liner "Push a new package onte the package stack."))
+            (list "+"
+                  (cons :handler 'slime-repl-command/+)
+                  (cons :one-liner "Resend the last form."))
+            (list "!"
+                  (cons :handler 'slime-repl-command/DEFPARAMETER)
+                  (cons :one-liner "Define a new global, special, variable."))
+            (list "sayoonara"
+                  (cons :handler 'slime-repl-command/SAYOONARA)
+                  (cons :one-liner "Quit the lisp and close all SLIME buffers."))))
+
+(defun slime-repl-command/DIRECTORY-PUSH (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))
+
+(defun slime-repl-command/DIRECTORY-POP ()
+  (interactive)
+  (unless (= 1 (length slime-repl-directory-stack))
+    (pop slime-repl-directory-stack))
+  (slime-set-default-directory (car slime-repl-directory-stack)))
+
+(defun slime-repl-command/+ ()
+  (interactive)
+  (insert (car slime-repl-input-history))
+  (insert "\n")
+  (slime-repl-send-input))
+
+(defun slime-repl-command/PACKAGE-PUSH (package)
+  (interactive (list (slime-read-package-name "Package: ")))
+  (push package slime-repl-package-stack)
+  (slime-repl-set-package package))
+
+(defun slime-repl-command/PACKAGE-POP ()
+  (interactive)
+  (unless (= 1 (length slime-repl-package-stack))
+    (pop slime-repl-package-stack))
+  (slime-repl-set-package (car slime-repl-package-stack)))
+
+(defun slime-repl-command/DEFPARAMETER (name value-form)
+  (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))
+
+(defun slime-repl-command/SAYOONARA ()
+  (interactive)
+  (slime-eval-async '(swank-backend:quit-lisp) "SWANK-BACKEND" (lambda (_) nil))
+  (slime-kill-all-buffers))
+
 ;;;; Cleanup after a quit
 
 (defun slime-kill-all-buffers ()
@@ -5749,7 +5810,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: swank.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank.lisp,v
retrieving revision 1.165
diff -u -d -u -r1.165 swank.lisp
--- swank.lisp	7 Apr 2004 16:24:03 -0000	1.165
+++ swank.lisp	7 Apr 2004 18:45:30 -0000
@@ -2011,49 +2011,6 @@
 			(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:
