[slime-cvs] CVS slime/contrib
heller
heller at common-lisp.net
Fri Aug 31 11:48:24 UTC 2007
Update of /project/slime/cvsroot/slime/contrib
In directory clnet:/tmp/cvs-serv22347/contrib
Modified Files:
ChangeLog swank-fuzzy.lisp
Added Files:
slime-autodoc.el slime-c-p-c.el slime-editing-commands.el
slime-parse.el swank-arglists.lisp swank-c-p-c.lisp
Log Message:
Move compound prefix completion and autodoc to contrib.
* swank.lisp (simple-completions): Rewritten for simplicity.
(operator-arglist): Rewritten for simplicity.
* slime.el (slime-complete-symbol-function): Make simple
completion the default.
(slime-echo-arglist-function, slime-echo-arglist): New hook.
--- /project/slime/cvsroot/slime/contrib/ChangeLog 2007/08/28 22:00:48 1.15
+++ /project/slime/cvsroot/slime/contrib/ChangeLog 2007/08/31 11:48:23 1.16
@@ -1,3 +1,16 @@
+2007-08-31 Helmut Eller <heller at common-lisp.net>
+
+ Move compound prefix completion and autodoc to contrib.
+ Interdependencies made it almost necessary to move parsing code
+ and editing commands in the same patch.
+
+ * slime-c-p-c.el: New file.
+ * swank-c-p-c.el: New file.
+ * slime-parse.el: New file.
+ * swank-arglists.el: New file.
+ * slime-editing-commands.el: New file.
+ * slime-autodoc.el: New file.
+
2007-08-28 Matthias Koeppe <mkoeppe at mail.math.uni-magdeburg.de>
* slime-presentations.el (slime-last-output-target-id)
--- /project/slime/cvsroot/slime/contrib/swank-fuzzy.lisp 2007/08/27 15:00:35 1.3
+++ /project/slime/cvsroot/slime/contrib/swank-fuzzy.lisp 2007/08/31 11:48:23 1.4
@@ -7,6 +7,9 @@
(in-package :swank)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (swank-require :swank-c-p-c))
+
;;; For nomenclature of the fuzzy completion section, please read
;;; through the following docstring.
@@ -108,6 +111,10 @@
symbol-chunks))
(classify-symbol symbol)))))
+(defun format-completion-result (string internal-p package-name)
+ (let ((result (untokenize-symbol package-name internal-p string)))
+ ;; We return the length of the possibly added prefix as second value.
+ (values result (search string result))))
(defun fuzzy-completion-set (string default-package-name &key limit time-limit-in-msec)
"Returns two values: an array of completion objects, sorted by
--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2007/08/31 11:48:24 NONE
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2007/08/31 11:48:24 1.1
;;; slime-autodoc.el --- show fancy arglist in echo area
;;
;; Authors: Luke Gorrie <luke at bluetail.com>
;; Lawrence Mitchell <wence at gmx.li>
;; Matthias Koeppe <mkoeppe at mail.math.uni-magdeburg.de>
;; Tobias C. Rittweiler <tcr at freebits.de>
;; and others
;;
;; License: GNU GPL (same license as Emacs)
;;
(require 'slime-parse)
(defvar slime-use-autodoc-mode nil
"When non-nil always enable slime-autodoc-mode in slime-mode.")
(defun slime-fontify-string (string)
"Fontify STRING as `font-lock-mode' does in Lisp mode."
(with-current-buffer (get-buffer-create " *slime-fontify*")
(erase-buffer)
(if (not (eq major-mode 'lisp-mode))
(lisp-mode))
(insert string)
(let ((font-lock-verbose nil))
(font-lock-fontify-buffer))
(goto-char (point-min))
(when (re-search-forward "===> \\(\\(.\\|\n\\)*\\) <===" nil t)
(let ((highlight (match-string 1)))
;; Can't use (replace-match highlight) here -- broken in Emacs 21
(delete-region (match-beginning 0) (match-end 0))
(slime-insert-propertized '(face highlight) highlight)))
(buffer-substring (point-min) (point-max))))
(defun slime-arglist (name)
"Show the argument list for NAME."
(interactive (list (slime-read-symbol-name "Arglist of: ")))
(slime-eval-async
`(swank:arglist-for-echo-area (quote (,name)))
(lambda (arglist)
(if arglist
(message "%s" (slime-fontify-string arglist))
(error "Arglist not available")))))
;;;; Autodocs (automatic context-sensitive help)
(defvar slime-autodoc-mode nil
"*When non-nil, print documentation about symbols as the point moves.")
(defvar slime-autodoc-cache-type 'last
"*Cache policy for automatically fetched documentation.
Possible values are:
nil - none.
last - cache only the most recently-looked-at symbol's documentation.
The values are stored in the variable `slime-autodoc-cache'.
More caching means fewer calls to the Lisp process, but at the risk of
using outdated information.")
(defvar slime-autodoc-cache nil
"Cache variable for when `slime-autodoc-cache-type' is 'last'.
The value is (SYMBOL-NAME . DOCUMENTATION).")
(defun slime-autodoc-mode (&optional arg)
"Enable `slime-autodoc'."
(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))))
(if slime-autodoc-mode
(progn
(slime-autodoc-start-timer)
(add-hook 'pre-command-hook
'slime-autodoc-pre-command-refresh-echo-area t))
(slime-autodoc-stop-timer)))
(defvar slime-autodoc-last-message "")
(defun slime-autodoc ()
"Print some apropos information about the code at point, if applicable."
(destructuring-bind (cache-key retrieve-form) (slime-autodoc-thing-at-point)
(let ((cached (slime-get-cached-autodoc cache-key)))
(if cached
(slime-autodoc-message cached)
;; Asynchronously fetch, cache, and display documentation
(slime-eval-async
retrieve-form
(with-lexical-bindings (cache-key)
(lambda (doc)
(let ((doc (if doc (slime-fontify-string doc) "")))
(slime-update-autodoc-cache cache-key doc)
(slime-autodoc-message doc)))))))))
(defcustom slime-autodoc-use-multiline-p nil
"If non-nil, allow long autodoc messages to resize echo area display."
:type 'boolean
:group 'slime-ui)
(defvar slime-autodoc-message-function 'slime-autodoc-show-message)
(defun slime-autodoc-message (doc)
"Display the autodoc documentation string DOC."
(funcall slime-autodoc-message-function doc))
(defun slime-autodoc-show-message (doc)
(unless slime-autodoc-use-multiline-p
(setq doc (slime-oneliner doc)))
(setq slime-autodoc-last-message doc)
(message "%s" doc))
(defun slime-autodoc-message-dimensions ()
"Return the available width and height for pretty printing autodoc
messages."
(cond
(slime-autodoc-use-multiline-p
;; Use the full width of the minibuffer;
;; minibuffer will grow vertically if necessary
(values (window-width (minibuffer-window))
nil))
(t
;; Try to fit everything in one line; we cut off when displaying
(values 1000 1))))
(defun slime-autodoc-pre-command-refresh-echo-area ()
(unless (string= slime-autodoc-last-message "")
(if (slime-autodoc-message-ok-p)
(message "%s" slime-autodoc-last-message)
(setq slime-autodoc-last-message ""))))
(defun slime-autodoc-thing-at-point ()
"Return a cache key and a swank form."
(let ((global (slime-autodoc-global-at-point)))
(if global
(values (slime-qualify-cl-symbol-name global)
`(swank:variable-desc-for-echo-area ,global))
(multiple-value-bind (operators arg-indices points)
(slime-enclosing-form-specs)
(values (mapcar* (lambda (designator arg-index)
(cons
(if (symbolp designator)
(slime-qualify-cl-symbol-name designator)
designator)
arg-index))
operators arg-indices)
(multiple-value-bind (width height)
(slime-autodoc-message-dimensions)
`(swank:arglist-for-echo-area ',operators
:arg-indices ',arg-indices
:print-right-margin ,width
:print-lines ,height)))))))
(defun slime-autodoc-global-at-point ()
"Return the global variable name at point, if any."
(when-let (name (slime-symbol-name-at-point))
(if (slime-global-variable-name-p name) name)))
(defcustom slime-global-variable-name-regexp "^\\(.*:\\)?\\([*+]\\).+\\2$"
"Regexp used to check if a symbol name is a global variable.
Default value assumes +this+ or *that* naming conventions."
:type 'regexp
:group 'slime)
(defun slime-global-variable-name-p (name)
"Is NAME a global variable?
Globals are recognised purely by *this-naming-convention*."
(and (< (length name) 80) ; avoid overflows in regexp matcher
(string-match slime-global-variable-name-regexp name)))
(defun slime-get-cached-autodoc (symbol-name)
"Return the cached autodoc documentation for SYMBOL-NAME, or nil."
(ecase slime-autodoc-cache-type
((nil) nil)
((last)
(when (equal (car slime-autodoc-cache) symbol-name)
(cdr slime-autodoc-cache)))
((all)
(when-let (symbol (intern-soft symbol-name))
(get symbol 'slime-autodoc-cache)))))
(defun slime-update-autodoc-cache (symbol-name documentation)
"Update the autodoc cache for SYMBOL with DOCUMENTATION.
Return DOCUMENTATION."
(ecase slime-autodoc-cache-type
((nil) nil)
((last)
(setq slime-autodoc-cache (cons symbol-name documentation)))
((all)
(put (intern symbol-name) 'slime-autodoc-cache documentation)))
documentation)
;;;;; Asynchronous message idle timer
(defvar slime-autodoc-idle-timer nil
"Idle timer for the next autodoc message.")
(defvar slime-autodoc-delay 0.2
"*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."
(interactive)
(when slime-autodoc-idle-timer
(cancel-timer slime-autodoc-idle-timer))
(setq slime-autodoc-idle-timer
(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)
(setq slime-autodoc-idle-timer nil)))
(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
the symbol at point if applicable."
(when (slime-autodoc-message-ok-p)
(condition-case err
(slime-autodoc)
(error
(setq slime-autodoc-mode nil)
(message "Error: %S; slime-autodoc-mode now disabled." err)))))
(defun slime-autodoc-message-ok-p ()
"Return true if printing a message is currently okay (shouldn't
annoy the user)."
(and (or slime-mode (eq major-mode 'slime-repl-mode)
(eq major-mode 'sldb-mode))
slime-autodoc-mode
(or (null (current-message))
(string= (current-message) slime-autodoc-last-message))
(not executing-kbd-macro)
(not (and (boundp 'edebug-active) (symbol-value 'edebug-active)))
(not cursor-in-echo-area)
(not (eq (selected-window) (minibuffer-window)))
(slime-background-activities-enabled-p)))
;;; Initialization
(defun slime-autodoc-init ()
(setq slime-echo-arglist-function 'slime-autodoc)
(add-hook 'slime-connected-hook 'slime-autodoc-on-connect)
(dolist (h '(slime-mode-hook slime-repl-mode-hook sldb-mode-hook))
(add-hook h 'slime-autodoc-maybe-enable)))
(defun slime-autodoc-on-connect ()
(slime-eval-async '(swank:swank-require :swank-arglists)))
(defun slime-autodoc-maybe-enable ()
(when slime-use-autodoc-mode
(slime-autodoc-mode 1)))
(slime-autodoc-init)
(provide 'slime-autodoc)
--- /project/slime/cvsroot/slime/contrib/slime-c-p-c.el 2007/08/31 11:48:24 NONE
+++ /project/slime/cvsroot/slime/contrib/slime-c-p-c.el 2007/08/31 11:48:24 1.1
;;; slime-c-p-c.el --- ILISP style Compound Prefix Completion
;;
;; Authors: Luke Gorrie <luke at synap.se>
;; Edi Weitz <edi at agharta.de>
;; Matthias Koeppe <mkoeppe at mail.math.uni-magdeburg.de>
;; Tobias C. Rittweiler <tcr at freebits.de>
;; and others
;;
;; License: GNU GPL (same license as Emacs)
;;
;;;
;;
;;
(require 'slime-parse)
(require 'slime-editing-commands)
(defun slime-complete-symbol* ()
"Expand abbreviations and complete the symbol at point."
;; NB: It is only the name part of the symbol that we actually want
;; to complete -- the package prefix, if given, is just context.
(or (slime-maybe-complete-as-filename)
(slime-expand-abbreviations-and-complete)))
;; FIXME: there is no consesus where point should end up after
;; completion. Some want it after the first non-completed prefix,
;; others at the end of the inserted text.
(defun slime-expand-abbreviations-and-complete ()
(let* ((end (move-marker (make-marker) (slime-symbol-end-pos)))
(beg (move-marker (make-marker) (slime-symbol-start-pos)))
(prefix (buffer-substring-no-properties beg end))
(completion-result (slime-contextual-completions beg end))
(completion-set (first completion-result))
(completed-prefix (second completion-result)))
(if (null completion-set)
(progn (slime-minibuffer-respecting-message
"Can't find completion for \"%s\"" prefix)
(ding)
(slime-complete-restore-window-configuration))
(goto-char end)
(insert-and-inherit completed-prefix)
(delete-region beg end)
(goto-char (+ beg (length completed-prefix)))
(cond ((and (member completed-prefix completion-set)
(slime-length= completion-set 1))
(slime-minibuffer-respecting-message "Sole completion")
(when slime-complete-symbol*-fancy
(slime-complete-symbol*-fancy-bit))
(slime-complete-restore-window-configuration))
;; Incomplete
(t
(when (member completed-prefix completion-set)
(slime-minibuffer-respecting-message
"Complete but not unique"))
(slime-display-or-scroll-completions completion-set
completed-prefix))))))
(defun slime-complete-symbol*-fancy-bit ()
"Do fancy tricks after completing a symbol.
\(Insert a space or close-paren based on arglist information.)"
(let ((arglist (slime-get-arglist (slime-symbol-name-at-point))))
(when arglist
(let ((args
;; Don't intern these symbols
(let ((obarray (make-vector 10 0)))
(cdr (read arglist))))
(function-call-position-p
(save-excursion
(backward-sexp)
(equal (char-before) ?\())))
(when function-call-position-p
(if (null args)
(insert-and-inherit ")")
(insert-and-inherit " ")
(when (and slime-space-information-p
(slime-background-activities-enabled-p)
(not (minibuffer-window-active-p (minibuffer-window))))
(slime-echo-arglist))))))))
(defun slime-get-arglist (symbol-name)
"Return the argument list for SYMBOL-NAME."
(slime-eval `(swank:arglist-for-echo-area (quote (,symbol-name)))))
(defun* slime-contextual-completions (beg end)
"Return a list of completions of the token from BEG to END in the
current buffer."
(let ((token (buffer-substring-no-properties beg end)))
(cond
((and (< beg (point-max))
(string= (buffer-substring-no-properties beg (1+ beg)) ":"))
;; Contextual keyword completion
(multiple-value-bind (operator-names arg-indices points)
(save-excursion
(goto-char beg)
(slime-enclosing-form-specs))
(when operator-names
(let ((completions
(slime-completions-for-keyword operator-names token
arg-indices)))
(when (first completions)
(return-from slime-contextual-completions completions))
;; If no matching keyword was found, do regular symbol
;; completion.
))))
((and (> beg 2)
(string= (buffer-substring-no-properties (- beg 2) beg) "#\\"))
;; Character name completion
(return-from slime-contextual-completions
(slime-completions-for-character token))))
;; Regular symbol completion
(slime-completions token)))
(defun slime-completions (prefix)
(slime-eval `(swank:completions ,prefix ',(slime-current-package))))
[45 lines skipped]
--- /project/slime/cvsroot/slime/contrib/slime-editing-commands.el 2007/08/31 11:48:24 NONE
+++ /project/slime/cvsroot/slime/contrib/slime-editing-commands.el 2007/08/31 11:48:24 1.1
[225 lines skipped]
--- /project/slime/cvsroot/slime/contrib/slime-parse.el 2007/08/31 11:48:24 NONE
+++ /project/slime/cvsroot/slime/contrib/slime-parse.el 2007/08/31 11:48:24 1.1
[575 lines skipped]
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2007/08/31 11:48:24 NONE
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2007/08/31 11:48:24 1.1
[1711 lines skipped]
--- /project/slime/cvsroot/slime/contrib/swank-c-p-c.lisp 2007/08/31 11:48:24 NONE
+++ /project/slime/cvsroot/slime/contrib/swank-c-p-c.lisp 2007/08/31 11:48:24 1.1
[1990 lines skipped]
More information about the slime-cvs
mailing list