[slime-devel] More slime.el fixes

Lawrence Mitchell wence at gmx.li
Wed Apr 7 12:43:25 UTC 2004


Hmmm, can you tell I have real work I should be doing?

Here are a bunch of small fixes for slime.el.  Most should be
fairly self-explanatory.

Index: ChangeLog
===================================================================
RCS file: /project/slime/cvsroot/slime/ChangeLog,v
retrieving revision 1.325
diff -u -r1.325 ChangeLog
--- ChangeLog	7 Apr 2004 10:07:50 -0000	1.325
+++ ChangeLog	7 Apr 2004 12:40:14 -0000
@@ -1,3 +1,35 @@
+2004-04-07  Lawrence Mitchell  <wence at gmx.li>
+
+	* slime.el (slime-repl-prompt-face): New face.
+	(slime-repl-insert-prompt): Use it.
+	(when-let, slime-with-chosen-connection, with-struct): Docstring
+	fix for function's arglist display.
+	(slime-read-package-name): Use `slime-bogus-completion-alist' to
+	construct completion table.
+	(slime-maybe-rearrange-inferior-lisp): Use `rename-buffer's
+	optional argument to rename uniquely.
+	(slime-check-connected): Display keybinding for `slime' via
+	`substitute-command-keys'.
+	(slime-repl-send-repl-command): Use whitespace character class in
+	regexp.
+	(slime-same-line-p): Use `line-beginning-position' and
+	`line-end-position'.  Fix typo in docstring.
+	(slime-autodoc-stop-timer): New function.
+	(slime-autodoc-mode): Add `interactive' spec to specify optional
+	arg.  This allows prefix toggling of mode (behaves more like
+	most Emacs modes now).  Stop timer if switching mode off with
+	`slime-autodoc-stop-timer'.
+	(slime-autodoc-start-timer, slime-complete-symbol)
+	(slime-complete-saved-window-configuration)
+	(slime-insert-balanced-comments): Docstring fix.
+	(slime-ed): Call `slime-from-lisp-filename' on filename for list
+	case of argument.
+	(slime-insert-transcript-delimiter, slime-thread-insert): Use
+	?\040 to indicate SPC.
+	(line-beginning-position): `forward-line' always puts us in
+	column 0.
+	(line-end-position): New function.
+
 2004-04-07  Luke Gorrie  <luke at bluetail.com>
 
 	* swank.lisp (completion-set): Also complete package
@@ -39,8 +71,8 @@
 
 2004-04-05  Lawrence Mitchell  <wence at gmx.li>
 
-	* swank.lisp (*swank-pprint-circle*, *swank-pprint-escape*,
-	*swank-pprint-level*, *swank,pprint-length*): Fix typo in
+	* swank.lisp (*swank-pprint-circle*, *swank-pprint-escape*)
+	(*swank-pprint-level*, *swank-pprint-length*): Fix typo in
 	docstring.
 
 	* slime.el (slime-arglist): Don't `message' arglist directly, in


Index: slime.el
===================================================================
RCS file: /project/slime/cvsroot/slime/slime.el,v
retrieving revision 1.255
diff -u -r1.255 slime.el
--- slime.el	6 Apr 2004 16:08:36 -0000	1.255
+++ slime.el	7 Apr 2004 12:41:35 -0000
@@ -179,6 +179,11 @@
   "Face for compiler notes while selected."
   :group 'slime)
 
+(defface slime-repl-prompt-face
+  '((t (:inherit font-lock-keyword-face)))
+  "Face for the prompt in the SLIME REPL."
+  :group 'slime)
+
 (defface slime-repl-output-face
   '((t (:inherit font-lock-string-face)))
   "Face for Lisp output in the SLIME REPL."
@@ -644,7 +649,7 @@
   "Evaluate VALUE, and if the result is non-nil bind it to VAR and
 evaluate BODY.
 
-\(when-let (VAR VALUE) &rest BODY)"
+\(fn (VAR VALUE) &rest BODY)"
   `(let ((,var ,value))
      (when ,var , at body)))
 
@@ -691,8 +696,7 @@
                                          &body body)
   "Make the connection choosen by PREFIX-ARG current.
 
-\(slime-with-chosen-connection (&optional (PREFIX-ARG 'current-prefix-arg))
-  &body BODY)"
+\(fn (&optional (PREFIX-ARG 'current-prefix-arg)) &body BODY)"
   `(let ((slime-dispatching-connection 
           (slime-get-named-connection ,prefix-arg)))
      , at body))
@@ -977,9 +981,9 @@
 (defun slime-read-package-name (prompt &optional initial-value)
   "Read a package name from the minibuffer, prompting with PROMPT."
   (let ((completion-ignore-case t))
-    (completing-read prompt (mapcar (lambda (x) (cons x x))
-				    (slime-eval 
-				     `(swank:list-all-package-names)))
+    (completing-read prompt (slime-bogus-completion-alist 
+                             (slime-eval 
+                              `(swank:list-all-package-names)))
 		     nil nil initial-value)))
 
 (defmacro slime-propertize-region (props &rest body)
@@ -1052,9 +1056,8 @@
 (defun slime-maybe-rearrange-inferior-lisp ()
   "Offer to rename *inferior-lisp* so that another can be started."
   (when (y-or-n-p "Create an additional *inferior-lisp*? ")
-    (let ((bufname (generate-new-buffer-name "*inferior-lisp*")))
-            (with-current-buffer "*inferior-lisp*"
-              (rename-buffer bufname)))))
+    (with-current-buffer "*inferior-lisp*"
+      (rename-buffer bufname t))))
 
 (defun slime-maybe-start-lisp ()
   "Start an inferior lisp unless one is already running."
@@ -1666,7 +1669,8 @@
 
 (defun slime-check-connected ()
   (unless (slime-connected-p)
-    (error "Not connected. Use `M-x slime' to start a Lisp.")))
+    (error "Not connected. Use `%s' to start a Lisp."
+           (substitute-command-keys "\\[slime]"))))
 
 (defun slime-connected-p ()
   "Return true if the Swank connection is open."
@@ -2015,7 +2019,7 @@
     (unless (bolp) (insert "\n"))
     (let ((prompt-start (point)))
       (slime-propertize-region
-          '(face font-lock-keyword-face 
+          '(face slime-repl-prompt-face
                  read-only t
                  intangible t
                  slime-repl-prompt t
@@ -2206,7 +2210,7 @@
   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 " *,"))
+                                                 (search-forward-regexp "\\s-*,"))
                                                (save-excursion
                                                  (goto-char slime-repl-input-end-mark)
                                                  (when (and (eq (char-before) ?\n)
@@ -2218,7 +2222,7 @@
                          '(face slime-repl-input-face rear-nonsticky (face)))
     (slime-mark-output-start)
     (slime-mark-input-start)
-    (if (string-match "^ *\\+ *$" input)
+    (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)))))
@@ -2806,7 +2810,9 @@
 ;;;;;;; Tree Widget
 
 (defmacro* with-struct ((conc-name &rest slots) struct &body body)
-  "Like with-slots but works only for structs."
+  "Like with-slots but works only for structs.
+
+\(fn (CONC-NAME &rest SLOTS) STRUCT &body BODY)"
   (flet ((reader (slot) (intern (concat (symbol-name conc-name)
 					(symbol-name slot)))))
     (let ((struct-var (gensym "struct")))
@@ -2970,9 +2976,9 @@
                            (point))))))))
 
 (defun slime-same-line-p (pos1 pos2)
-  "Return true if buffer positions PoS1 and POS2 are on the same line."
-  (save-excursion (goto-char (min pos1 pos2))
-                  (not (search-forward "\n" (max pos1 pos2) t))))
+  "Return t if buffer positions POS1 and POS2 are on the same line."
+  (and (<= (line-beginning-position) (min pos1 pos2))
+       (<= (max pos1 pos2) (line-end-position))))
 
 (defun slime-severity-face (severity)
   "Return the name of the font-lock face representing SEVERITY."
@@ -3284,11 +3290,13 @@
 
 (defun slime-autodoc-mode (&optional arg)
   "Enable `slime-autodoc'."
-  (interactive)
-  (cond ((and arg (not (eq -1 arg))) (setq slime-autodoc-mode t))
-        ((eq -1 arg) (setq slime-autodoc-mode nil))
+  (interactive "P")
+  (cond ((< (prefix-numeric-value arg) 0) (setq slime-autodoc-mode nil))
+        (arg (setq slime-autodoc-mode t))
         (t (setq slime-autodoc-mode (not slime-autodoc-mode))))
-  (when slime-autodoc-mode (slime-autodoc-start-timer)))
+  (if slime-autodoc-mode
+      (slime-autodoc-start-timer)
+    (slime-autodoc-stop-timer)))
 
 (defun slime-autodoc ()
   "Print some apropos information about the code at point, if applicable."
@@ -3342,7 +3350,7 @@
   "*Delay before autodoc messages are fetched and displayed, in seconds.")
 
 (defun slime-autodoc-start-timer ()
-  "*(Re)start the timer that prints autodocs every `slime-autodoc-delay' seconds."
+  "(Re)start the timer that prints autodocs every `slime-autodoc-delay' seconds."
   (interactive)
   (when slime-autodoc-idle-timer
     (cancel-timer slime-autodoc-idle-timer))
@@ -3350,6 +3358,12 @@
         (run-with-idle-timer slime-autodoc-delay slime-autodoc-delay
                              'slime-autodoc-timer-hook)))
 
+(defun slime-autodoc-stop-timer ()
+  "Stop the timer that prints autodocs.
+See also `slime-autodoc-start-timer'."
+  (when slime-autodoc-idle-timer
+    (cancel-timer slime-autodoc-idle-timer)))
+
 (defun slime-autodoc-timer-hook ()
   "Function to be called after each Emacs becomes idle.
 When `slime-autodoc-mode' is non-nil, print apropos information about
@@ -3418,7 +3432,7 @@
 (defvar slime-completions-buffer-name "*Completions*")
 
 (defvar slime-complete-saved-window-configuration nil
-  "Window configuration before we show the *Completions* buffer.\n\
+  "Window configuration before we show the *Completions* buffer.
 This is buffer local in the buffer where the complition is
 performed.")
 
@@ -3470,8 +3484,8 @@
   
 (defun slime-complete-symbol ()
   "Complete the symbol at point.
-If the symbol lacks an explicit package prefix, the current buffer's
-package is used."
+
+Completion is performed by `slime-complete-symbol-function'."
   (interactive)
   (funcall slime-complete-symbol-function))
 
@@ -3744,7 +3758,7 @@
     (cond ((stringp what)
            (find-file (slime-from-lisp-filename what)))
           ((listp what) 
-           (find-file (first what))
+           (find-file (first (slime-from-lisp-filename what)))
            (goto-line (second what))
            ;; Find the correct column, without going past the end of
            ;; the line.
@@ -3787,7 +3801,7 @@
      (unless (bolp) (insert "\n"))
      (slime-insert-propertized
       '(slime-transcript-delimiter t)
-      ";;;; " (subst-char-in-string ?\n ?\ 
+      ";;;; " (subst-char-in-string ?\n ?\040
                                     (substring string 0 
                                                (min 60 (length string))))
       " ...\n"))))
@@ -5066,7 +5080,7 @@
 (defun slime-thread-insert (id name summary)
   (slime-propertize-region `(thread-id ,id)
     (slime-insert-propertized '(face bold) name)
-    (insert-char ?\  (- 30 (current-column)))
+    (insert-char ?\040 (- 30 (current-column)))
     (let ((summary-start (point)))
       (insert " " summary)
       (unless (bolp) (insert "\n"))
@@ -5456,7 +5470,7 @@
 (defun slime-insert-balanced-comments (arg)
   "Insert a set of balanced comments around the s-expression
 containing the point.  If this command is invoked repeatedly
-(without any other command occurring between invocations), the
+\(without any other command occurring between invocations), the
 comment progressively moves outward over enclosing expressions.
 If invoked with a positive prefix argument, the s-expression arg
 expressions out is enclosed in a set of balanced comments."
@@ -6276,7 +6290,12 @@
 (defun-if-undefined line-beginning-position (&optional n)
   (save-excursion
     (forward-line n)
-    (beginning-of-line)
+    (point)))
+
+(defun-if-undefined line-end-position (&optional n)
+  (save-excursion
+    (forward-line n)
+    (end-of-line)
     (point)))
 
 (defun-if-undefined check-parens ()


-- 
Lawrence Mitchell <wence at gmx.li>





More information about the slime-devel mailing list