[slime-cvs] CVS slime/contrib
CVS User trittweiler
trittweiler at common-lisp.net
Sun Feb 1 23:57:35 UTC 2009
Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv2556/contrib
Modified Files:
swank-arglists.lisp slime-parse.el slime-autodoc.el ChangeLog
Log Message:
Add DEFMETHOD-style extended arglist display for
DEFINE-COMPILER-MACRO.
(defun foo (x y &key k1 k2))
(define-compiler-macro foo |)
* swank-arglists.lisp ([method] arglist-dispatch): Specialize
on (EQL 'DEFINE-COMPILER-MACRO).
* slime-parse.el (slime-extended-operator-name-parser-alist): Add
entry for DEFINE-COMPILER-MACRO.
(slime-make-extended-operator-parser/look-ahead): Collect up /at
most/ N sexps. Previously `(defmethod |)' would lead to a form
spec of ``("defmethod" ("defmethod"))''.
([test] enclosing-form-specs.1): Test for this.
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2009/02/01 22:50:46 1.26
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2009/02/01 23:57:34 1.27
@@ -1144,6 +1144,28 @@
t))))))
(call-next-method))
+;;; FIXME: This was copied & pasted from DEFMETHOD. Refactoring needed!
+;;;
+(defmethod arglist-dispatch ((operator-type (eql :function)) (operator (eql 'define-compiler-macro))
+ arguments &key (remove-args t))
+ (format t "ARGUMENTS = ~S~%" arguments)
+
+ (when (and (listp arguments)
+ (not (null arguments)) ;have function name
+ (notany #'listp (rest arguments))) ;don't have arglist yet
+ (let* ((fn-name (first arguments))
+ (fn (and (valid-function-name-p fn-name)
+ (fboundp fn-name)
+ (fdefinition fn-name))))
+ (with-available-arglist (arglist) (arglist fn)
+ (return-from arglist-dispatch
+ (values (make-arglist :provided-args (if remove-args
+ nil
+ (list fn-name))
+ :required-args (list arglist)
+ :rest "body" :body-p t)
+ t)))))
+ (call-next-method))
(defmethod arglist-dispatch ((operator-type (eql :function)) (operator (eql 'eval-when))
arguments &key (remove-args t))
--- /project/slime/cvsroot/slime/contrib/slime-parse.el 2008/12/30 17:12:11 1.13
+++ /project/slime/cvsroot/slime/contrib/slime-parse.el 2009/02/01 23:57:35 1.14
@@ -118,6 +118,7 @@
("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)
@@ -125,18 +126,21 @@
(defun slime-make-extended-operator-parser/look-ahead (steps)
"Returns a parser that parses the current operator at point
-plus STEPS-many additional sexps on the right side of the
-operator."
+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)))
- (unless (zerop arg-idx)
+ (when (and (not (zerop arg-idx)) ; point is at CAR of form?
+ (not (= (point) ; point is at end of form?
+ (save-excursion (slime-end-of-list)
+ (point)))))
(let* ((args (slime-ensure-list (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)
- )))
+ (setq current-forms (cons `(,name , at arg-specs) old-forms))))
+ (values current-forms current-indices current-points)
+ ))))
(defun slime-parse-extended-operator/declare
(name user-point current-forms current-indices current-points)
@@ -347,5 +351,23 @@
(goto-char string-start-pos)
(error "We're not within a string"))))
+(def-slime-test enclosing-form-specs.1
+ (buffer-sexpr wished-form-specs)
+ ""
+ '(("(defmethod *HERE*)" ("defmethod"))
+ ("(cerror foo *HERE*)" ("cerror" "foo")))
+ (slime-check-top-level)
+ (with-temp-buffer
+ (let ((tmpbuf (current-buffer)))
+ (lisp-mode)
+ (insert buffer-sexpr)
+ (search-backward "*HERE*")
+ (multiple-value-bind (specs)
+ (slime-enclosing-form-specs)
+ (slime-check "Check enclosing form specs"
+ (equal specs wished-form-specs)))
+ )))
+
+
(provide 'slime-parse)
--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2009/01/01 15:54:30 1.11
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2009/02/01 23:57:35 1.12
@@ -233,7 +233,11 @@
(when slime-autodoc-mode
(setq ad-return-value
(and ad-return-value
+ ;; Display arglist only when the minibuffer is
+ ;; inactive, e.g. not on `C-x C-f'.
(not (active-minibuffer-window))
+ ;; Display arglist only when inferior Lisp will be able
+ ;; to cope with the request.
(slime-background-activities-enabled-p))))
ad-return-value)
--- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/01 22:50:46 1.170
+++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/01 23:57:35 1.171
@@ -1,5 +1,23 @@
2009-02-01 Tobias C. Rittweiler <tcr at freebits.de>
+ Add DEFMETHOD-style extended arglist display for
+ DEFINE-COMPILER-MACRO.
+
+ (defun foo (x y &key k1 k2))
+ (define-compiler-macro foo |)
+
+ * swank-arglists.lisp ([method] arglist-dispatch): Specialize
+ on (EQL 'DEFINE-COMPILER-MACRO).
+
+ * slime-parse.el (slime-extended-operator-name-parser-alist): Add
+ entry for DEFINE-COMPILER-MACRO.
+ (slime-make-extended-operator-parser/look-ahead): Collect up /at
+ most/ N sexps. Previously `(defmethod |)' would lead to a form
+ spec of ``("defmethod" ("defmethod"))''.
+ ([test] enclosing-form-specs.1): Test for this.
+
+2009-02-01 Tobias C. Rittweiler <tcr at freebits.de>
+
* swank-arglists.lisp (parse-form-spec): Moved most part of its
docstring into a comment.
(arglist-for-echo-area): Some minor code reorganization. The
More information about the slime-cvs
mailing list