[slime-cvs] CVS slime
heller
heller at common-lisp.net
Fri Aug 31 11:48:23 UTC 2007
Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv22347
Modified Files:
ChangeLog swank-loader.lisp swank.lisp slime.el
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/ChangeLog 2007/08/30 23:44:10 1.1190
+++ /project/slime/cvsroot/slime/ChangeLog 2007/08/31 11:48:22 1.1191
@@ -1,3 +1,14 @@
+2007-08-31 Helmut Eller <heller at common-lisp.net>
+
+ 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.
+
2007-08-31 Andreas Fuchs <asf at boinkor.net>
* slime.el (slime-reindent-defun): Fixed when used in lisp file
@@ -35,7 +46,7 @@
have been witnessed in `*Messages*'.) `Lisp-mode' was activated to
get the right syntax-table for `slime-sexp-at-point', but this one
sets the correct syntax-table itself now.
-
+
2007-08-28 Matthias Koeppe <mkoeppe at mail.math.uni-magdeburg.de>
Fix user input type-ahead again (this change from 2007-08-25 got
@@ -48,7 +59,7 @@
(slime-repl-write-string): Insert a :repl-result before the
prompt, not at point-max. Update markers properly.
-2007-08-29 Helmut Eller <heller at common-lisp.net>
+2007-08-28 Helmut Eller <heller at common-lisp.net>
* swank-cmucl.lisp (safe-definition-finding): Remove whitespace
around error messages.
--- /project/slime/cvsroot/slime/swank-loader.lisp 2007/08/28 08:22:58 1.69
+++ /project/slime/cvsroot/slime/swank-loader.lisp 2007/08/31 11:48:23 1.70
@@ -198,7 +198,8 @@
(defvar *fasl-directory* (default-fasl-directory)
"The directory where fasl files should be placed.")
-(defvar *contribs* '(swank-fuzzy swank-fancy-inspector
+(defvar *contribs* '(swank-c-p-c swank-arglists swank-fuzzy
+ swank-fancy-inspector
swank-presentations swank-presentation-streams)
"List of names for contrib modules.")
--- /project/slime/cvsroot/slime/swank.lisp 2007/08/28 22:03:26 1.506
+++ /project/slime/cvsroot/slime/swank.lisp 2007/08/31 11:48:23 1.507
@@ -1568,10 +1568,9 @@
(untokenize-symbol \"quux\" t \"foo\") ==> \"quux::foo\"
(untokenize-symbol nil nil \"foo\") ==> \"foo\"
"
- (let ((prefix (cond ((not package-name) "")
- (internal-p (format nil "~A::" package-name))
- (t (format nil "~A:" package-name)))))
- (concatenate 'string prefix symbol-name)))
+ (cond ((not package-name) symbol-name)
+ (internal-p (cat package-name "::" symbol-name))
+ (t (cat package-name ":" symbol-name))))
(defun casify-char (char)
"Convert CHAR accoring to readtable-case."
@@ -1639,1141 +1638,6 @@
:test #'string=)))
*readtable*)))
-(defun valid-operator-symbol-p (symbol)
- "Is SYMBOL the name of a function, a macro, or a special-operator?"
- (or (fboundp symbol)
- (macro-function symbol)
- (special-operator-p symbol)))
-
-(defun valid-operator-name-p (string)
- "Is STRING the name of a function, macro, or special-operator?"
- (let ((symbol (parse-symbol string)))
- (valid-operator-symbol-p symbol)))
-
-
-;;;; Arglists
-
-(defslimefun arglist-for-echo-area (raw-specs &key arg-indices
- print-right-margin print-lines)
- "Return the arglist for the first valid ``form spec'' in
-RAW-SPECS. A ``form spec'' is a superset of functions, macros,
-special-ops, declarations and type specifiers.
-
-For more information about the format of ``raw form specs'' and
-``form specs'', please see PARSE-FORM-SPEC."
- (handler-case
- (with-buffer-syntax ()
- (multiple-value-bind (form-spec arg-index newly-interned-symbols)
- (parse-first-valid-form-spec raw-specs arg-indices)
- (unwind-protect
- (when form-spec
- (let ((arglist (arglist-from-form-spec form-spec :remove-args nil)))
- (unless (eql arglist :not-available)
- (multiple-value-bind (type operator arguments)
- (split-form-spec form-spec)
- (declare (ignore arguments))
- (multiple-value-bind (stringified-arglist)
- (decoded-arglist-to-string
- arglist
- :operator operator
- :print-right-margin print-right-margin
- :print-lines print-lines
- :highlight (and arg-index
- (not (zerop arg-index))
- ;; don't highlight the operator
- arg-index))
- (case type
- (:declaration (format nil "(declare ~A)" stringified-arglist))
- (:type-specifier (format nil "[Typespec] ~A" stringified-arglist))
- (t stringified-arglist)))))))
- (mapc #'unintern newly-interned-symbols))))
- (error (cond)
- (format nil "ARGLIST (error): ~A" cond))
- ))
-
-(defun parse-form-spec (raw-spec)
- "Takes a raw (i.e. unparsed) form spec from SLIME and returns a
-proper form spec for further processing within SWANK. Returns NIL
-if RAW-SPEC could not be parsed. Symbols that had to be interned
-in course of the conversion, are returned as secondary return value.
-
-A ``raw form spec'' can be either:
-
- i) a list of strings representing a Common Lisp form
-
- ii) a list of strings as of i), but which additionally
- contains other raw form specs
-
- iii) one of:
-
- a) (:declaration declspec)
-
- where DECLSPEC is a raw form spec.
-
- b) (:type-specifier typespec)
-
- where TYPESPEC is a raw form spec.
-
-
-A ``form spec'' is either
-
- 1) a normal Common Lisp form
-
- 2) a Common Lisp form with a list as its CAR specifying what namespace
- the operator is supposed to be interpreted in:
-
- a) ((:declaration decl-identifier) declarg1 declarg2 ...)
-
- b) ((:type-specifier typespec-op) typespec-arg1 typespec-arg2 ...)
-
-
-Examples:
-
- (\"defmethod\") => (defmethod)
- (\"cl:defmethod\") => (cl:defmethod)
- (\"defmethod\" \"print-object\") => (defmethod print-object)
-
- (\"foo\" (\"bar\" (\"quux\")) \"baz\" => (foo (bar (quux)) baz)
-
- (:declaration \"optimize\" \"(optimize)\") => ((:declaration optimize))
- (:declaration \"type\" \"(type string)\") => ((:declaration type) string)
- (:type-specifier \"float\" \"(float)\") => ((:type-specifier float))
- (:type-specifier \"float\" \"(float 0 100)\") => ((:type-specifier float) 0 100)
-"
- (flet ((parse-extended-spec (raw-extension extension-flag)
- (when (and (stringp (first raw-extension)) ; (:DECLARATION (("a" "b" ("c")) "d"))
- (nth-value 1 (parse-symbol (first raw-extension))))
- (multiple-value-bind (extension introduced-symbols)
- (read-form-spec raw-extension)
- (unless (recursively-empty-p extension) ; (:DECLARATION (())) &c.
- (destructuring-bind (identifier &rest args) extension
- (values `((,extension-flag ,identifier) , at args)
- introduced-symbols)))))))
- (when (consp raw-spec)
- (destructure-case raw-spec
- ((:declaration raw-declspec)
- (parse-extended-spec raw-declspec :declaration))
- ((:type-specifier raw-typespec)
- (parse-extended-spec raw-typespec :type-specifier))
- (t
- (when (every #'(lambda (x) (or (stringp x) (consp x))) raw-spec)
- (destructuring-bind (raw-operator &rest raw-args) raw-spec
- (multiple-value-bind (operator found?) (parse-symbol raw-operator)
- (when (and found? (valid-operator-symbol-p operator))
- (multiple-value-bind (parsed-args introduced-symbols)
- (read-form-spec raw-args)
- (values `(,operator , at parsed-args) introduced-symbols)))))))))))
-
-(defun split-form-spec (spec)
- "Returns all three relevant information a ``form spec''
-contains: the operator type, the operator, and the operands."
- (destructuring-bind (operator-designator &rest arguments) spec
- (multiple-value-bind (type operator)
- (if (listp operator-designator)
- (values (first operator-designator) (second operator-designator))
- (values :function operator-designator)) ; functions, macros, special ops
- (values type operator arguments)))) ; are all fbound.
-
-(defun parse-first-valid-form-spec (raw-specs &optional arg-indices)
- "Returns the first parsed form spec in RAW-SPECS that can
-successfully be parsed. Additionally returns its respective index
-in ARG-INDICES (or NIL.), and all newly interned symbols as tertiary
-return value."
- (block traversal
- (mapc #'(lambda (raw-spec index)
- (multiple-value-bind (spec symbols) (parse-form-spec raw-spec)
- (when spec (return-from traversal
- (values spec index symbols)))))
- raw-specs
- (append arg-indices '#1=(nil . #1#)))
- nil)) ; found nothing
-
-(defun read-form-spec (spec)
- "Turns the ``raw form spec'' SPEC into a proper Common Lisp form.
-
-It returns symbols that had to interned for the conversion as
-secondary return value."
- (when spec
- (with-buffer-syntax ()
- (call-with-ignored-reader-errors
- #'(lambda ()
- (let ((result) (newly-interned-symbols) (ok))
- (unwind-protect
- (progn
- (dolist (element spec)
- (etypecase element
- (string
- (multiple-value-bind (symbol found? symbol-name package)
- (parse-symbol element)
- (if found?
- (push symbol result)
- (let ((sexp (read-from-string element)))
- (when (symbolp sexp)
- (push sexp newly-interned-symbols)
- ;; assert that PARSE-SYMBOL didn't parse incorrectly.
- (assert (and (equal symbol-name (symbol-name sexp))
- (eq package (symbol-package sexp)))))
- (push sexp result)))))
- (cons
- (multiple-value-bind (read-spec interned-symbols)
- (read-form-spec element)
- (push read-spec result)
- (setf newly-interned-symbols
- (append interned-symbols
- newly-interned-symbols))))))
- (setq ok t))
- (mapc #'unintern newly-interned-symbols))
- (values (nreverse result)
- (nreverse newly-interned-symbols))))))))
-
-
-
-(defun clean-arglist (arglist)
- "Remove &whole, &enviroment, and &aux elements from ARGLIST."
- (cond ((null arglist) '())
- ((member (car arglist) '(&whole &environment))
- (clean-arglist (cddr arglist)))
- ((eq (car arglist) '&aux)
- '())
- (t (cons (car arglist) (clean-arglist (cdr arglist))))))
-
-
-(defstruct (arglist (:conc-name arglist.) (:predicate arglist-p))
- provided-args ; list of the provided actual arguments
- required-args ; list of the required arguments
- optional-args ; list of the optional arguments
- key-p ; whether &key appeared
- keyword-args ; list of the keywords
- rest ; name of the &rest or &body argument (if any)
- body-p ; whether the rest argument is a &body
- allow-other-keys-p ; whether &allow-other-keys appeared
- aux-args ; list of &aux variables
- any-p ; whether &any appeared
- any-args ; list of &any arguments [*]
- known-junk ; &whole, &environment
- unknown-junk) ; unparsed stuff
-
-;;;
-;;; [*] The &ANY lambda keyword is an extension to ANSI Common Lisp,
-;;; and is only used to describe certain arglists that cannot be
-;;; described in another way.
-;;;
-;;; &ANY is very similiar to &KEY but while &KEY is based upon
-;;; the idea of a plist (key1 value1 key2 value2), &ANY is a
-;;; cross between &OPTIONAL, &KEY and *FEATURES* lists:
-;;;
-;;; a) (&ANY :A :B :C) means that you can provide any (non-null)
-;;; set consisting of the keywords `:A', `:B', or `:C' in
-;;; the arglist. E.g. (:A) or (:C :B :A).
-;;;
-;;; (This is not restricted to keywords only, but any self-evaluating
-;;; expression is allowed.)
-;;;
-;;; b) (&ANY (key1 v1) (key2 v2) (key3 v3)) means that you can
-;;; provide any (non-null) set consisting of lists where
-;;; the CAR of the list is one of `key1', `key2', or `key3'.
-;;; E.g. ((key1 100) (key3 42)), or ((key3 66) (key2 23))
-;;;
-;;;
-;;; For example, a) let us describe the situations of EVAL-WHEN as
-;;;
-;;; (EVAL-WHEN (&ANY :compile-toplevel :load-toplevel :execute) &BODY body)
-;;;
-;;; and b) let us describe the optimization qualifiers that are valid
-;;; in the declaration specifier `OPTIMIZE':
-;;;
-;;; (DECLARE (OPTIMIZE &ANY (compilation-speed 1) (safety 1) ...))
-;;;
-
-(defun print-arglist (arglist &key operator highlight)
- (let ((index 0)
- (need-space nil))
- (labels ((print-arg (arg)
- (typecase arg
- (arglist ; destructuring pattern
- (print-arglist arg))
- (optional-arg
- (princ (encode-optional-arg arg)))
- (keyword-arg
- (let ((enc-arg (encode-keyword-arg arg)))
- (etypecase enc-arg
- (symbol (princ enc-arg))
- ((cons symbol)
- (pprint-logical-block (nil nil :prefix "(" :suffix ")")
- (princ (car enc-arg))
- (write-char #\space)
- (pprint-fill *standard-output* (cdr enc-arg) nil)))
- ((cons cons)
- (pprint-logical-block (nil nil :prefix "(" :suffix ")")
- (pprint-logical-block (nil nil :prefix "(" :suffix ")")
- (prin1 (caar enc-arg))
- (write-char #\space)
- (print-arg (keyword-arg.arg-name arg)))
- (unless (null (cdr enc-arg))
- (write-char #\space))
- (pprint-fill *standard-output* (cdr enc-arg) nil))))))
- (t ; required formal or provided actual arg
- (princ arg))))
- (print-space ()
- (ecase need-space
- ((nil))
- ((:miser)
- (write-char #\space)
- (pprint-newline :miser))
- ((t)
- (write-char #\space)
- (pprint-newline :fill)))
- (setq need-space t))
- (print-with-space (obj)
- (print-space)
- (print-arg obj))
- (print-with-highlight (arg &optional (index-ok-p #'=))
- (print-space)
- (cond
- ((and highlight (funcall index-ok-p index highlight))
- (princ "===> ")
- (print-arg arg)
- (princ " <==="))
- (t
- (print-arg arg)))
- (incf index)))
- (pprint-logical-block (nil nil :prefix "(" :suffix ")")
- (when operator
- (print-with-highlight operator)
- (setq need-space :miser))
- (mapc #'print-with-highlight
- (arglist.provided-args arglist))
- (mapc #'print-with-highlight
- (arglist.required-args arglist))
- (when (arglist.optional-args arglist)
- (print-with-space '&optional)
- (mapc #'print-with-highlight
- (arglist.optional-args arglist)))
- (when (arglist.key-p arglist)
- (print-with-space '&key)
- (mapc #'print-with-space
- (arglist.keyword-args arglist)))
- (when (arglist.allow-other-keys-p arglist)
- (print-with-space '&allow-other-keys))
- (when (arglist.any-args arglist)
- (print-with-space '&any)
- (mapc #'print-with-space
- (arglist.any-args arglist)))
- (cond ((not (arglist.rest arglist)))
- ((arglist.body-p arglist)
- (print-with-space '&body)
- (print-with-highlight (arglist.rest arglist) #'<=))
- (t
- (print-with-space '&rest)
- (print-with-highlight (arglist.rest arglist) #'<=)))
- (mapc #'print-with-space
- (arglist.unknown-junk arglist))))))
-
-(defun decoded-arglist-to-string (arglist
- &key operator highlight (package *package*)
- print-right-margin print-lines)
- "Print the decoded ARGLIST for display in the echo area. The
-argument name are printed without package qualifiers and pretty
-printing of (function foo) as #'foo is suppressed. If HIGHLIGHT is
-non-nil, it must be the index of an argument; highlight this argument.
-If OPERATOR is non-nil, put it in front of the arglist."
- (with-output-to-string (*standard-output*)
- (with-standard-io-syntax
- (let ((*package* package) (*print-case* :downcase)
- (*print-pretty* t) (*print-circle* nil) (*print-readably* nil)
- (*print-level* 10) (*print-length* 20)
- (*print-right-margin* print-right-margin)
- (*print-lines* print-lines)
- (*print-escape* nil)) ; no package qualifies.
- (print-arglist arglist :operator operator :highlight highlight)))))
-
-(defslimefun variable-desc-for-echo-area (variable-name)
- "Return a short description of VARIABLE-NAME, or NIL."
- (with-buffer-syntax ()
- (let ((sym (parse-symbol variable-name)))
- (if (and sym (boundp sym))
- (let ((*print-pretty* nil) (*print-level* 4)
- (*print-length* 10) (*print-circle* t))
- (format nil "~A => ~A" sym (symbol-value sym)))))))
-
-(defun decode-required-arg (arg)
- "ARG can be a symbol or a destructuring pattern."
- (etypecase arg
- (symbol arg)
- (list (decode-arglist arg))))
-
-(defun encode-required-arg (arg)
- (etypecase arg
- (symbol arg)
- (arglist (encode-arglist arg))))
-
-(defstruct (keyword-arg
- (:conc-name keyword-arg.)
- (:constructor make-keyword-arg (keyword arg-name default-arg)))
- keyword
- arg-name
- default-arg)
-
-(defun decode-keyword-arg (arg)
- "Decode a keyword item of formal argument list.
-Return three values: keyword, argument name, default arg."
- (cond ((symbolp arg)
- (make-keyword-arg (intern (symbol-name arg) keyword-package)
[1157 lines skipped]
--- /project/slime/cvsroot/slime/slime.el 2007/08/30 23:43:41 1.839
+++ /project/slime/cvsroot/slime/slime.el 2007/08/31 11:48:23 1.840
@@ -65,9 +65,6 @@
(require 'overlay))
(require 'easymenu)
-(defvar slime-use-autodoc-mode nil
- "When non-nil always enable slime-autodoc-mode in slime-mode.")
-
(defvar slime-highlight-compiler-notes t
"When non-nil highlight buffers with compilation notes, warnings and errors."
)
@@ -84,9 +81,7 @@
(setq slime-use-highlight-edits-mode highlight-edits))
(defun slime-shared-lisp-mode-hook ()
- (slime-mode 1)
- (when slime-use-autodoc-mode
- (slime-autodoc-mode 1)))
+ (slime-mode 1))
(defun slime-lisp-mode-hook ()
(slime-shared-lisp-mode-hook)
@@ -259,7 +254,7 @@
:group 'slime-mode
:type 'boolean)
-(defcustom slime-complete-symbol-function 'slime-complete-symbol*
+(defcustom slime-complete-symbol-function 'slime-simple-complete-symbol
"*Function to perform symbol completion."
:group 'slime-mode
:type '(choice (const :tag "Simple" slime-simple-complete-symbol)
@@ -3151,8 +3146,6 @@
(add-local-hook 'kill-buffer-hook 'slime-repl-safe-save-merged-history)
(add-hook 'kill-emacs-hook 'slime-repl-save-all-histories)
(slime-setup-command-hooks)
- (when slime-use-autodoc-mode
- (slime-autodoc-mode 1))
;; At the REPL, we define beginning-of-defun and end-of-defun to be
;; the start of the previous prompt or next prompt respectively.
;; Notice the interplay with SLIME-REPL-BEGINNING-OF-DEFUN.
@@ -5127,278 +5120,26 @@
(slime-background-activities-enabled-p))
(slime-echo-arglist)))
-(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))))
+(defvar slime-echo-arglist-function 'slime-show-arglist)
(defun slime-echo-arglist ()
"Display the arglist of the current form in the echo area."
- (slime-autodoc))
-
-(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")))))
-
-(defun slime-incomplete-form-at-point ()
- "Looks for a ``raw form spec'' around point to be processed by
-SWANK::PARSE-FORM-SPEC. It is similiar to
-SLIME-INCOMPLETE-SEXP-AT-POINT but looks further back than just
-one sexp to find out the context."
- (multiple-value-bind (operators arg-indices points)
- (slime-enclosing-form-specs)
- (if (null operators)
- ""
- (let ((op (first operators)))
- (destructure-case (slime-ensure-list op)
- ((:declaration declspec) op)
- ((:type-specifier typespec) op)
- (t (slime-ensure-list
- (save-excursion (goto-char (first points))
- (slime-sexp-at-point (1+ (first arg-indices)))))))))))
-
-(defun slime-complete-form ()
- "Complete the form at point.
-This is a superset of the functionality of `slime-insert-arglist'."
- (interactive)
- ;; Find the (possibly incomplete) form around point.
- (let ((form-string (slime-incomplete-form-at-point)))
- (let ((result (slime-eval `(swank:complete-form ',form-string))))
- (if (eq result :not-available)
- (error "Could not generate completion for the form `%s'" form-string)
- (progn
- (just-one-space)
- (save-excursion
- ;; SWANK:COMPLETE-FORM always returns a closing
- ;; parenthesis; but we only want to insert one if it's
- ;; really necessary (thinking especially of paredit.el.)
- (insert (substring result 0 -1))
- (let ((slime-close-parens-limit 1))
- (slime-close-all-parens-in-sexp)))
- (save-excursion
- (backward-up-list 1)
- (indent-sexp)))))))
-
-
-(defun slime-get-arglist (symbol-name)
- "Return the argument list for SYMBOL-NAME."
- (slime-eval `(swank:arglist-for-echo-area (quote (,symbol-name)))))
-
-
-;;;; 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)
+ (funcall slime-echo-arglist-function))
-(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)))
+(defun slime-show-arglist ()
+ (let ((op (slime-operator-before-point)))
+ (when op
+ (slime-eval-async `(swank:operator-arglist ,op ,(slime-current-package))
+ (lambda (arglist)
+ (when arglist
+ (slime-message "%s" arglist)))))))
-(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)))
+(defun slime-operator-before-point ()
+ (ignore-errors
+ (save-excursion
+ (backward-up-list 1)
+ (down-list 1)
+ (slime-symbol-name-at-point))))
;;;; Completion
@@ -5514,65 +5255,6 @@
(interactive)
(funcall slime-complete-symbol-function))
-(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)))
-
-(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-simple-complete-symbol ()
"Complete the symbol at point.
[608 lines skipped]
More information about the slime-cvs
mailing list