[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