[slime-cvs] CVS slime/contrib
CVS User trittweiler
trittweiler at common-lisp.net
Mon Dec 21 16:03:41 UTC 2009
Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv21032/contrib
Modified Files:
ChangeLog slime-autodoc.el slime-c-p-c.el
slime-enclosing-context.el slime-fancy.el slime-parse.el
slime-sbcl-exts.el swank-arglists.lisp
Log Message:
Today's cleanup day.
* slime-parse.el (slime-incomplete-form-at-point)
(slime-parse-sexp-at-point)
(slime-has-symbol-syntax-p)
(slime-incomplete-sexp-at-point)
(slime-parse-extended-operator-name)
(slime-extended-operator-name-parser-alist)
(slime-make-extended-operator-parser/look-ahead)
(slime-parse-extended-operator/proclaim)
(slime-parse-extended-operator/declare)
(slime-parse-extended-operator/check-type)
(slime-parse-extended-operator/the)
(slime-nesting-until-point)
(slime-make-form-spec-from-string)
(slime-enclosing-form-specs)
(slime-ensure-list)
(slime-beginning-of-string)
(slime-check-enclosing-form-specs)
(enclosing-form-specs.1 [test]): Deleted. The new arglist code made
all this superfluous.
* slime-autodoc.el (slime-autodoc-accuracy-depth): New defcustom.
(slime-retrieve-arglist): Return :not-available if appropriate.
(slime-arglist): Use `slime-retrieve-arglist'. Delete reference to
undefined variable.
(slime-autodoc-thing-at-point): Deleted, not needed anymore.
(slime-autodoc-hook): Deleted.
(slime-autodoc-worthwhile-p): Deleted.
(slime-make-autodoc-rpc-form): Simplified.
(slime-compute-autodoc-internal): Merged with `slime-compute-autodoc'.
(slime-compute-autodoc): Removed usage of old
infrastructure. Simplified.
* swank-arglists.lisp (print-decoded-arglist): Print ((:foo bar)
quux) &key parameters correctly.
(variable-desc-for-echo-area): Return :not-available, not nil.
* slime-c-p-c.el (slime-complete-symbol*-fancy-bit): Adapted for
new return value of `slime-retrieve-arglist'.
* slime-fancy.el: Disable `slime-mdot-fu' contrib because that has
to be adapted to new infrastructure.
* slime-sbcl-exts.el (slime-enable-autodoc-for-sb-assem:inst):
Deleted. Used old infrastructure.
--- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/12/21 14:18:46 1.312
+++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/12/21 16:03:41 1.313
@@ -1,5 +1,54 @@
2009-12-21 Tobias C. Rittweiler <tcr at freebits.de>
+ Today's cleanup day.
+
+ * slime-parse.el (slime-incomplete-form-at-point)
+ (slime-parse-sexp-at-point)
+ (slime-has-symbol-syntax-p)
+ (slime-incomplete-sexp-at-point)
+ (slime-parse-extended-operator-name)
+ (slime-extended-operator-name-parser-alist)
+ (slime-make-extended-operator-parser/look-ahead)
+ (slime-parse-extended-operator/proclaim)
+ (slime-parse-extended-operator/declare)
+ (slime-parse-extended-operator/check-type)
+ (slime-parse-extended-operator/the)
+ (slime-nesting-until-point)
+ (slime-make-form-spec-from-string)
+ (slime-enclosing-form-specs)
+ (slime-ensure-list)
+ (slime-beginning-of-string)
+ (slime-check-enclosing-form-specs)
+ (enclosing-form-specs.1 [test]): Deleted. The new arglist code made
+ all this superfluous.
+
+ * slime-autodoc.el (slime-autodoc-accuracy-depth): New defcustom.
+ (slime-retrieve-arglist): Return :not-available if appropriate.
+ (slime-arglist): Use `slime-retrieve-arglist'. Delete reference to
+ undefined variable.
+ (slime-autodoc-thing-at-point): Deleted, not needed anymore.
+ (slime-autodoc-hook): Deleted.
+ (slime-autodoc-worthwhile-p): Deleted.
+ (slime-make-autodoc-rpc-form): Simplified.
+ (slime-compute-autodoc-internal): Merged with `slime-compute-autodoc'.
+ (slime-compute-autodoc): Removed usage of old
+ infrastructure. Simplified.
+
+ * swank-arglists.lisp (print-decoded-arglist): Print ((:foo bar)
+ quux) &key parameters correctly.
+ (variable-desc-for-echo-area): Return :not-available, not nil.
+
+ * slime-c-p-c.el (slime-complete-symbol*-fancy-bit): Adapted for
+ new return value of `slime-retrieve-arglist'.
+
+ * slime-fancy.el: Disable `slime-mdot-fu' contrib because that has
+ to be adapted to new infrastructure.
+
+ * slime-sbcl-exts.el (slime-enable-autodoc-for-sb-assem:inst):
+ Deleted. Used old infrastructure.
+
+2009-12-21 Tobias C. Rittweiler <tcr at freebits.de>
+
* slime-parse.el (slime-parse-form-upto-point): Rewritten to make
it more performant.
(slime-parse-form-until): New helper.
--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2009/11/06 19:08:39 1.24
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2009/12/21 16:03:41 1.25
@@ -36,57 +36,48 @@
:type 'number
:group 'slime-ui)
+(defcustom slime-autodoc-accuracy-depth 10
+ "Number of paren levels that autodoc takes into account for
+ context-sensitive arglist display (local functions. etc)")
+
(defun slime-arglist (name)
"Show the argument list for NAME."
(interactive (list (slime-read-symbol-name "Arglist of: " t)))
- (let ((arglist (slime-eval `(swank:arglist-for-echo-area
- '(,name ,slime-cursor-marker)))))
+ (let ((arglist (slime-retrieve-arglist name)))
(if (eq arglist :not-available)
- (and errorp (error "Arglist not available"))
+ (error "Arglist not available")
(message "%s" (slime-fontify-string arglist)))))
(defun slime-retrieve-arglist (name)
- (let* ((name (etypecase name
+ (let ((name (etypecase name
(string name)
- (symbol (symbol-name name))))
- (arglist
- (slime-eval `(swank:arglist-for-echo-area
- '(,name ,slime-cursor-marker)))))
- (if (eq arglist :not-available)
- nil
- arglist)))
+ (symbol (symbol-name name)))))
+ (slime-eval `(swank:arglist-for-echo-area '(,name ,slime-cursor-marker)))))
;;;; Autodocs (automatic context-sensitive help)
-(defun slime-autodoc-thing-at-point ()
- "Not used; for debugging purposes."
- (multiple-value-bind (operators arg-indices points)
- (slime-enclosing-form-specs)
- (slime-make-autodoc-rpc-form operators arg-indices points)))
-
-;; TODO: get rid of args
-(defun slime-make-autodoc-rpc-form (operators arg-indices points)
+(defun slime-make-autodoc-rpc-form ()
"Return a cache key and a swank form."
- (unless (slime-inside-string-or-comment-p)
- (let ((global (slime-autodoc-global-at-point)))
- (if global
- (values (slime-qualify-cl-symbol-name global)
- `(swank:variable-desc-for-echo-area ,global))
- (let ((buffer-form (slime-parse-form-upto-point 10)))
- (values buffer-form
- (multiple-value-bind (width height)
- (slime-autodoc-message-dimensions)
- `(swank:arglist-for-echo-area ',buffer-form
- :print-right-margin ,width
- :print-lines ,height))))))))
+ (let ((global (slime-autodoc-global-at-point)))
+ (if global
+ (values (slime-qualify-cl-symbol-name global)
+ `(swank:variable-desc-for-echo-area ,global))
+ (let* ((levels slime-autodoc-accuracy-depth)
+ (buffer-form (slime-parse-form-upto-point levels)))
+ (values buffer-form
+ (multiple-value-bind (width height)
+ (slime-autodoc-message-dimensions)
+ `(swank:arglist-for-echo-area ',buffer-form
+ :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-at-point))
- (if (slime-global-variable-name-p name) name)))
+ (and (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.
@@ -189,49 +180,33 @@
;;;; slime-autodoc-mode
-(defvar slime-autodoc-hook '()
- "If autodoc is enabled, this hook is run periodically in the
-background everytime a new autodoc is computed. The hook is
-applied to the result of `slime-enclosing-form-specs'.")
-
-(defun slime-autodoc-worthwhile-p (ops)
- ;; Prevent an RPC call for when the user solely typed in an opening
- ;; parenthesis.
- (and (not (null ops))
- (or (not (null (first ops)))
- (slime-length> ops 1))))
-(defun slime-compute-autodoc-internal ()
+(defun slime-compute-autodoc ()
"Returns the cached arglist information as string, or nil.
If it's not in the cache, the cache will be updated asynchronously."
- (multiple-value-bind (ops arg-indices points)
- (slime-enclosing-form-specs)
- (when (slime-autodoc-worthwhile-p ops)
- (run-hook-with-args 'slime-autodoc-hook ops arg-indices points)
- (multiple-value-bind (cache-key retrieve-form)
- (slime-make-autodoc-rpc-form ops arg-indices points)
- (let ((cached (slime-get-cached-autodoc cache-key)))
- (if cached
- cached
- ;; If nothing is in the cache, we first decline, and fetch
- ;; the arglist information asynchronously.
- (prog1 nil
- (slime-eval-async retrieve-form
- (lexical-let ((cache-key cache-key))
- (lambda (doc)
- (let ((doc (if (or (null doc)
- (eq doc :not-available))
- ""
- (slime-format-autodoc doc))))
- ;; Now that we've got our information, get it to
- ;; the user ASAP.
- (eldoc-message doc)
- (slime-store-into-autodoc-cache cache-key doc))))))))))))
-
-(defun slime-compute-autodoc ()
(save-excursion
+ ;; Save match data just in case. This is automatically run in
+ ;; background, so it'd be rather disastrous if it touched match
+ ;; data.
(save-match-data
- (slime-compute-autodoc-internal))))
+ (unless (slime-inside-string-or-comment-p)
+ (multiple-value-bind (cache-key retrieve-form) (slime-make-autodoc-rpc-form)
+ (let ((cached (slime-get-cached-autodoc cache-key)))
+ (if cached
+ cached
+ ;; If nothing is in the cache, we first decline, and fetch
+ ;; the arglist information asynchronously.
+ (prog1 nil
+ (slime-eval-async retrieve-form
+ (lexical-let ((cache-key cache-key))
+ (lambda (doc)
+ (let ((doc (if (eq doc :not-available)
+ ""
+ (slime-format-autodoc doc))))
+ ;; Now that we've got our information, get it to
+ ;; the user ASAP.
+ (eldoc-message doc)
+ (slime-store-into-autodoc-cache cache-key doc)))))))))))))
(make-variable-buffer-local (defvar slime-autodoc-mode nil))
@@ -290,7 +265,7 @@
(slime-test-expect (format "Autodoc in `%s' (at %d) is as expected"
(buffer-string) (point))
arglist
- (slime-eval (second (slime-autodoc-thing-at-point)))
+ (slime-eval (second (slime-make-autodoc-rpc-form)))
'equal))
(def-slime-test autodoc.1
--- /project/slime/cvsroot/slime/contrib/slime-c-p-c.el 2009/11/06 19:08:39 1.15
+++ /project/slime/cvsroot/slime/contrib/slime-c-p-c.el 2009/12/21 16:03:41 1.16
@@ -85,7 +85,7 @@
"Do fancy tricks after completing a symbol.
\(Insert a space or close-paren based on arglist information.)"
(let ((arglist (slime-retrieve-arglist (slime-symbol-at-point))))
- (when arglist
+ (unless (eq arglist :not-available)
(let ((args
;; Don't intern these symbols
(let ((obarray (make-vector 10 0)))
--- /project/slime/cvsroot/slime/contrib/slime-enclosing-context.el 2009/03/09 22:40:21 1.6
+++ /project/slime/cvsroot/slime/contrib/slime-enclosing-context.el 2009/12/21 16:03:41 1.7
@@ -5,6 +5,9 @@
;; License: GNU GPL (same license as Emacs)
;;
+;;; TODO: with the removal of `slime-enclosing-form-specs' this
+;;; contrib won't work anymore.
+
(require 'slime-parse)
(defvar slime-variable-binding-ops-alist
--- /project/slime/cvsroot/slime/contrib/slime-fancy.el 2009/08/15 08:35:00 1.9
+++ /project/slime/cvsroot/slime/contrib/slime-fancy.el 2009/12/21 16:03:41 1.10
@@ -74,9 +74,11 @@
(require 'slime-references)
(slime-references-init)
+;;; Disabled -- after the removal of `slime-enclosing-form-specs',
+;;; this contrib has to be adapted.
;; Makes M-. work on local definitions, too.
-(require 'slime-mdot-fu)
-(slime-mdot-fu-init)
+;; (require 'slime-mdot-fu)
+;; (slime-mdot-fu-init)
;; Add/Remove a symbol at point from the relevant DEFPACKAGE form
;; via C-c x.
--- /project/slime/cvsroot/slime/contrib/slime-parse.el 2009/12/21 14:18:46 1.31
+++ /project/slime/cvsroot/slime/contrib/slime-parse.el 2009/12/21 16:03:41 1.32
@@ -7,325 +7,6 @@
;; License: GNU GPL (same license as Emacs)
;;
-(defun slime-incomplete-form-at-point ()
- (slime-make-form-spec-from-string
- (concat (slime-incomplete-sexp-at-point) ")")))
-
-(defun slime-parse-sexp-at-point (&optional n)
- "Returns the sexps at point as a list of strings, otherwise nil.
-\(If there are not as many sexps as N, a list with < N sexps is
-returned.\)
-If SKIP-BLANKS-P is true, leading whitespaces &c are skipped.
-"
- (interactive "p") (or n (setq n 1))
- (save-excursion
- (let ((result nil))
- (dotimes (i n)
- ;; Is there an additional sexp in front of us?
- (save-excursion
- (unless (slime-point-moves-p (ignore-errors (forward-sexp)))
- (return)))
- (push (slime-sexp-at-point) result)
- ;; Skip current sexp
- (ignore-errors (forward-sexp) (skip-chars-forward "[:space:]")))
- (nreverse result))))
-
-(defun slime-has-symbol-syntax-p (string)
- (if (and string (not (zerop (length string))))
- (member (char-syntax (aref string 0))
- '(?w ?_ ?\' ?\\))))
-
-(defun slime-incomplete-sexp-at-point (&optional n)
- (interactive "p") (or n (setq n 1))
- (buffer-substring-no-properties
- (save-excursion (backward-up-list n) (point))
- (point)))
-
-
-(defun slime-parse-extended-operator-name (user-point forms indices points)
- "Assume that point is directly at the operator that should be parsed.
-USER-POINT is the value of `point' where the user was looking at.
-OPS, INDICES and POINTS are updated to reflect the new values after
-parsing, and are then returned back as multiple values."
- ;; OPS, INDICES and POINTS are like the finally returned values of
- ;; SLIME-ENCLOSING-FORM-SPECS except that they're in reversed order,
- ;; i.e. the leftmost operator comes first.
- (save-excursion
- (ignore-errors
- (let* ((current-op (first (first forms)))
- (op-name (upcase (slime-cl-symbol-name current-op)))
- (assoc (assoc op-name slime-extended-operator-name-parser-alist))
- (entry (cdr assoc))
- (parser (if (and entry (listp entry))
- (apply (first entry) (rest entry))
- entry)))
- (ignore-errors
- (forward-char (1+ (length current-op)))
- (skip-chars-forward "[:space:]"))
- (when parser
- (multiple-value-setq (forms indices points)
- ;; We pass the fully qualified name (`current-op'), so it's the
- ;; fully qualified name that will be sent to SWANK.
- (funcall parser current-op user-point forms indices points))))))
- (values forms indices points))
-
-
-(defvar slime-extended-operator-name-parser-alist
- '(("MAKE-INSTANCE" . (slime-make-extended-operator-parser/look-ahead 1))
- ("MAKE-CONDITION" . (slime-make-extended-operator-parser/look-ahead 1))
- ("ERROR" . (slime-make-extended-operator-parser/look-ahead 1))
- ("SIGNAL" . (slime-make-extended-operator-parser/look-ahead 1))
- ("WARN" . (slime-make-extended-operator-parser/look-ahead 1))
- ("CERROR" . (slime-make-extended-operator-parser/look-ahead 2))
- ("CHANGE-CLASS" . (slime-make-extended-operator-parser/look-ahead 2))
- ("DEFMETHOD" . (slime-make-extended-operator-parser/look-ahead 1))
- ("DEFINE-COMPILER-MACRO" . (slime-make-extended-operator-parser/look-ahead 1))
- ("APPLY" . (slime-make-extended-operator-parser/look-ahead 1))
- ("DECLARE" . slime-parse-extended-operator/declare)
- ("DECLAIM" . slime-parse-extended-operator/declare)
- ("PROCLAIM" . slime-parse-extended-operator/proclaim)
- ("CHECK-TYPE" . slime-parse-extended-operator/check-type)
- ("TYPEP" . slime-parse-extended-operator/check-type)
- ("THE" . slime-parse-extended-operator/the)))
-
-
-(defun slime-make-extended-operator-parser/look-ahead (steps)
- "Returns a parser that parses the current operator at point
-plus (at most) STEPS-many additional sexps on the right side of
-the operator."
- (lexical-let ((n steps))
- #'(lambda (name user-point current-forms current-indices current-points)
- (let ((old-forms (rest current-forms))
- (arg-idx (first current-indices)))
- (when (and (not (zerop arg-idx)) ; point is at CAR of form?
- (not (= (point) ; point is at end of form?
- (save-excursion
- (ignore-errors (slime-end-of-list))
- (point)))))
- (let* ((args (slime-parse-sexp-at-point n))
- (arg-specs (mapcar #'slime-make-form-spec-from-string args)))
- (setq current-forms (cons `(,name , at arg-specs) old-forms))))
- (values current-forms current-indices current-points)))))
-
-;;; FIXME: We display "(proclaim (optimize ...))" instead of the
-;;; correct "(proclaim '(optimize ...))".
-(defun slime-parse-extended-operator/proclaim (&rest args)
- (when (looking-at "['`]")
- (forward-char)
- (apply #'slime-parse-extended-operator/declare args)))
-
-(defun slime-parse-extended-operator/declare
- (name user-point current-forms current-indices current-points)
- (when (looking-at "(")
- (goto-char user-point)
- (slime-end-of-symbol)
- ;; Head of CURRENT-FORMS is "declare" (or similiar) at this
- ;; point, but we're interested in what comes next.
- (let* ((decl-indices (rest current-indices))
- (decl-points (rest current-points))
- (decl-pos (1- (first decl-points)))
- (nesting (slime-nesting-until-point decl-pos))
- (declspec-str (concat (slime-incomplete-sexp-at-point nesting)
- (make-string nesting ?\)))))
- (save-match-data ; `(declare ((foo ...))' or `(declare (type (foo ...)))' ?
- (if (or (eql 0 (string-match "\\s-*(\\((\\(\\sw\\|\\s_\\|\\s-\\)*)\\))$"
- declspec-str))
- (eql 0 (string-match "\\s-*(type\\s-*\\((\\(\\sw\\|\\s_\\|\\s-\\)*)\\))$"
- declspec-str)))
- (let* ((typespec-str (match-string 1 declspec-str))
- (typespec (slime-make-form-spec-from-string typespec-str)))
- (setq current-forms (list `(:type-specifier ,typespec)))
- (setq current-indices (list (second decl-indices)))
- (setq current-points (list (second decl-points))))
- (let ((declspec (slime-make-form-spec-from-string declspec-str)))
- (setq current-forms (list `(,name) `(:declaration ,declspec)))
- (setq current-indices (list (first current-indices)
- (first decl-indices)))
- (setq current-points (list (first current-points)
- (first decl-points))))))))
- (values current-forms current-indices current-points))
-
-(defun slime-parse-extended-operator/check-type
- (name user-point current-forms current-indices current-points)
- (let ((arg-idx (first current-indices))
- (typespec (second current-forms))
- (typespec-start (second current-points)))
- (when (and (eql 2 arg-index)
- typespec ; `(check-type ... (foo |' ?
- (if (equalp name "typep") ; `(typep ... '(foo |' ?
- (progn (goto-char (- typespec-start 2))
- (looking-at "['`]"))
- t))
- ;; compound types VALUES and FUNCTION are not allowed in TYPEP
- ;; (and consequently CHECK-TYPE.)
- (unless (member (first typespec) '("values" "function"))
- (setq current-forms `((:type-specifier ,typespec)))
- (setq current-indices (rest current-indices))
- (setq current-points (rest current-points))))
- (values current-forms current-indices current-points)))
-
-(defun slime-parse-extended-operator/the
- (name user-point current-forms current-indices current-points)
- (let ((arg-idx (first current-indices))
- (typespec (second current-forms)))
- (if (and (eql 1 arg-idx) typespec) ; `(the (foo |' ?
- (values `((:type-specifier ,typespec))
- (rest current-indices)
- (rest current-points))
- (values current-forms current-indices current-points))))
-
-
-
-(defun slime-nesting-until-point (target-point)
- "Returns the nesting level between current point and TARGET-POINT.
-If TARGET-POINT could not be reached, 0 is returned. (As a result
-TARGET-POINT should always be placed just before a `?\('.)"
- (save-excursion
- (let ((nesting 0))
- (while (> (point) target-point)
- (backward-up-list)
- (incf nesting))
- (if (= (point) target-point)
- nesting
- 0))))
-
-(defun slime-make-form-spec-from-string (string &optional strip-operator-p)
- "Example: \"(foo (bar 1 (baz :quux)) 'toto)\"
-
- => (\"foo\" (\"bar\" \"1\" (\"baz\" \":quux\")) \"'toto\")"
- (cond ((slime-length= string 0) "") ; ""
- ((equal string "()") '()) ; "()"
- ((eql (char-syntax (aref string 0)) ?\') string) ; "'(foo)", "#(foo)" &c
- ((not (eql (aref string 0) ?\()) string) ; "foo"
- (t ; "(op arg1 arg2 ...)"
- (with-current-buffer (get-buffer-create " *slime-make-form-spec-buffer*")
- ;; Do NEVER ever try to activate `lisp-mode' here with
- ;; `slime-use-autodoc-mode' enabled, as this function is used
- ;; to compute the current autodoc itself.
- (set-syntax-table lisp-mode-syntax-table)
- (erase-buffer)
- (insert string)
- (goto-char (1+ (point-min)))
- (let ((subsexps)
- (end))
- (while (condition-case nil
- (slime-point-moves-p (slime-forward-sexp))
- (scan-error nil) ; can't move any further
- (error t)) ; unknown feature expression etc.
- ;; We first move back for (FOO)'BAR where point is at
- ;; the quote character.
- (setq end (point))
- (push (buffer-substring-no-properties
- (save-excursion (backward-sexp) (point))
- end)
- subsexps))
- (mapcar #'(lambda (s)
- (assert (not (equal s string)))
- (slime-make-form-spec-from-string s))
- (nreverse subsexps)))))))
-
-;;; TODO: With the rewrite of autodoc, this function like pretty much
-;;; everything else in this file, is obsolete.
-
-(defun slime-enclosing-form-specs (&optional max-levels)
- "Return the list of ``raw form specs'' of all the forms
-containing point from right to left.
-
-As a secondary value, return a list of indices: Each index tells
-for each corresponding form spec in what argument position the
-user's point is.
-
-As tertiary value, return the positions of the operators that are
-contained in the returned form specs.
-
-When MAX-LEVELS is non-nil, go up at most this many levels of
-parens.
-
-\(See SWANK::PARSE-FORM-SPEC for more information about what
-exactly constitutes a ``raw form specs'')
-
-Examples:
-
- A return value like the following
-
- (values ((\"quux\") (\"bar\") (\"foo\")) (3 2 1) (p1 p2 p3))
-
- can be interpreted as follows:
-
- The user point is located in the 3rd argument position of a
- form with the operator name \"quux\" (which starts at P1.)
-
- This form is located in the 2nd argument position of a form
- with the operator name \"bar\" (which starts at P2.)
-
- This form again is in the 1st argument position of a form
- with the operator name \"foo\" (which itself begins at P3.)
-
- For instance, the corresponding buffer content could have looked
- like `(foo (bar arg1 (quux 1 2 |' where `|' denotes point.
-"
- (let ((level 1)
- (parse-sexp-lookup-properties nil)
- (initial-point (point))
- (result '()) (arg-indices '()) (points '()))
- ;; The expensive lookup of syntax-class text properties is only
- ;; used for interactive balancing of #<...> in presentations; we
- ;; do not need them in navigating through the nested lists.
- ;; This speeds up this function significantly.
- (ignore-errors
- (save-excursion
- ;; Make sure we get the whole thing at point.
- (if (not (slime-inside-string-p))
- (slime-end-of-symbol)
- (slime-beginning-of-string)
- (forward-sexp))
- (save-restriction
- ;; Don't parse more than 20000 characters before point, so we don't spend
- ;; too much time.
- (narrow-to-region (max (point-min) (- (point) 20000)) (point-max))
- (narrow-to-region (save-excursion (beginning-of-defun) (point))
- (min (1+ (point)) (point-max)))
- (while (or (not max-levels)
- (<= level max-levels))
- (let ((arg-index 0))
- ;; Move to the beginning of the current sexp if not already there.
- (if (or (and (char-after)
- (member (char-syntax (char-after)) '(?\( ?')))
- (member (char-syntax (char-before)) '(?\ ?>)))
- (incf arg-index))
- (ignore-errors (backward-sexp 1))
- (while (and (< arg-index 64)
- (ignore-errors (backward-sexp 1)
- (> (point) (point-min))))
- (incf arg-index))
- (backward-up-list 1)
- (when (member (char-syntax (char-after)) '(?\( ?'))
- (incf level)
- (forward-char 1)
- (let ((name (slime-symbol-at-point)))
- (cond
- (name
- (save-restriction
- (widen) ; to allow looking-ahead/back in extended parsing.
- (multiple-value-bind (new-result new-indices new-points)
- (slime-parse-extended-operator-name
- initial-point
- (cons `(,name) result) ; minimal form spec
- (cons arg-index arg-indices)
- (cons (point) points))
- (setq result new-result)
- (setq arg-indices new-indices)
- (setq points new-points))))
- (t
- (push nil result)
- (push arg-index arg-indices)
- (push (point) points))))
- (backward-up-list 1)))))))
- (values
- (nreverse result)
- (nreverse arg-indices)
- (nreverse points))))
-
(defun slime-parse-form-until (limit form-suffix)
"Parses form from point to `limit'."
;; For performance reasons, this function does not use recursion.
@@ -424,59 +105,9 @@
(ignore-errors (down-list))
(slime-parse-form-until pt suffix))))))
-(defun slime-ensure-list (thing)
- (if (listp thing) thing (list thing)))
-
-(defun slime-beginning-of-string ()
- (let* ((parser-state (slime-current-parser-state))
- (inside-string-p (nth 3 parser-state))
- (string-start-pos (nth 8 parser-state)))
- (if inside-string-p
- (goto-char string-start-pos)
- (error "We're not within a string"))))
-
;;;; Test cases
-(defun slime-check-enclosing-form-specs (wished-form-specs)
- (slime-test-expect
- (format "Enclosing form specs correct in `%s' (at %d)" (buffer-string) (point))
- wished-form-specs
- (first (slime-enclosing-form-specs))))
-
-(def-slime-test enclosing-form-specs.1
- (buffer-sexpr wished-form-specs)
- "Check that we correctly determine enclosing forms."
- '(("(defun *HERE*" (("defun")))
- ("(defun foo *HERE*" (("defun")))
- ("(defun foo (x y) *HERE*" (("defun")))
- ("(defmethod *HERE*" (("defmethod")))
- ("(defmethod foo *HERE*" (("defmethod" "foo")))
- ("(cerror foo *HERE*" (("cerror" "foo")))
- ("(cerror foo bar *HERE*" (("cerror" "foo" "bar")))
- ("(make-instance foo *HERE*" (("make-instance" "foo")))
- ("(apply 'foo *HERE*" (("apply" "'foo")))
- ("(apply #'foo *HERE*" (("apply" "#'foo")))
- ("(declare *HERE*" (("declare")))
- ("(declare (optimize *HERE*" ((:declaration ("optimize")) ("declare")))
- ("(declare (string *HERE*" ((:declaration ("string")) ("declare")))
- ("(declare ((vector *HERE*" ((:type-specifier ("vector"))))
- ("(declare ((vector bit *HERE*" ((:type-specifier ("vector" "bit"))))
- ("(proclaim '(optimize *HERE*" ((:declaration ("optimize")) ("proclaim")))
- ("(the (string *HERE*" ((:type-specifier ("string"))))
- ("(check-type foo (string *HERE*" ((:type-specifier ("string"))))
- ("(typep foo '(string *HERE*" ((:type-specifier ("string")))))
- (slime-check-top-level)
- (with-temp-buffer
- (lisp-mode)
- (insert buffer-sexpr)
- (search-backward "*HERE*")
- (delete-region (match-beginning 0) (match-end 0))
- (slime-check-enclosing-form-specs wished-form-specs)
- (insert ")") (backward-char)
- (slime-check-enclosing-form-specs wished-form-specs)
- ))
-
(defun slime-check-buffer-form (result-form)
(slime-test-expect
(format "Buffer form correct in `%s' (at %d)" (buffer-string) (point))
@@ -518,7 +149,7 @@
(let ((byte-compile-warnings '()))
(mapc #'byte-compile
- '(slime-make-form-spec-from-string
- slime-parse-form-upto-point
+ '(slime-parse-form-upto-point
+ slime-parse-form-until
slime-compare-char-syntax
)))
\ No newline at end of file
--- /project/slime/cvsroot/slime/contrib/slime-sbcl-exts.el 2009/10/30 23:06:26 1.3
+++ /project/slime/cvsroot/slime/contrib/slime-sbcl-exts.el 2009/12/21 16:03:41 1.4
@@ -5,7 +5,6 @@
;; License: GNU GPL (same license as Emacs)
;;
-(require 'slime-autodoc)
(require 'slime-references)
(defun slime-sbcl-bug-at-point ()
@@ -31,12 +30,7 @@
(browse-url (format "http://bugs.launchpad.net/sbcl/+bug/%s"
(substring bug 1))))
-(defun slime-enable-autodoc-for-sb-assem:inst ()
- (push '("INST" . (slime-make-extended-operator-parser/look-ahead 1))
- slime-extended-operator-name-parser-alist))
-
-(defun slime-sbcl-exts-init ()
- (slime-enable-autodoc-for-sb-assem:inst))
+(defun slime-sbcl-exts-init ())
(slime-require :swank-sbcl-exts)
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2009/12/14 15:28:46 1.47
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2009/12/21 16:03:41 1.48
@@ -298,7 +298,7 @@
(print-arglist-recursively arg :index keyword))
(with-highlighting (:index keyword)
(cond ((and init (keywordp keyword))
- (format t "~:@<~A ~S~@:>" arg init))
+ (format t "~:@<~A ~S~@:>" keyword init))
(init
(format t "~:@<(~S ..) ~S~@:>" keyword init))
((not (keywordp keyword))
@@ -1084,7 +1084,8 @@
(*print-readably* nil))
(call/truncated-output-to-string
75 (lambda (s)
- (format s "~A => ~S" sym (symbol-value sym)))))))))
+ (format s "~A => ~S" sym (symbol-value sym)))))
+ :not-available))))
;;; We work on a RAW-FORM, or BUFFER-FORM, which represent the form at
;;; user's point in Emacs. A RAW-FORM looks like
More information about the slime-cvs
mailing list