[slime-cvs] CVS slime/contrib

[CVS User trittweiler]

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv15269/contrib

Modified Files:
	ChangeLog slime-autodoc.el swank-arglists.lisp 
Log Message:
	* swank-arglists.lisp (read-conversatively-for-autodoc): Make it
	understand sharpquote form, so contextual autodoc will work fo
	`(apply #'foo ...)'.

	* slime-autodoc.el ([test] autodoc.1): New test case, for the
	above and more.
	(slime-check-autodoc-at-point): New helper.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/02/27 21:35:35	1.182
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/02/27 21:38:20	1.183
@@ -1,5 +1,15 @@
 2009-02-27  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* swank-arglists.lisp (read-conversatively-for-autodoc): Make it
+	understand sharpquote form, so contextual autodoc will work fo
+	`(apply #'foo ...)'.
+
+	* slime-autodoc.el ([test] autodoc.1): New test case, for the
+	above and more.
+	(slime-check-autodoc-at-point): New helper.
+
+2009-02-27  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* slime-parse.el (slime-check-enclosing-form-specs): Use
 	`slime-test-expect' rather than `slime-check'.
 	([test] enclosing-form-specs.1): Add two more cases.
--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/02/27 17:37:14	1.13
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/02/27 21:38:20	1.14
@@ -260,4 +260,47 @@
 
 (slime-require :swank-arglists)
 
+;;;; Test cases
+
+(defun slime-check-autodoc-at-point (arglist)
+  (slime-test-expect (format "Autodoc in `%s' (at %d) is as expected" 
+                             (buffer-string) (point)) 
+                     arglist
+                     (slime-eval (second (slime-autodoc-thing-at-point)))
+                     'equal))
+
+(def-slime-test autodoc.1
+    (buffer-sexpr wished-arglist)
+    ""
+    '(("(swank::emacs-connected*HERE*"    "(emacs-connected)")
+      ("(swank::create-socket*HERE*"      "(create-socket host port)")
+      ("(swank::create-socket *HERE*"     "(create-socket ===> host <=== port)")
+      ("(swank::create-socket foo *HERE*" "(create-socket host ===> port <===)")
+
+      ("(swank::symbol-status foo *HERE*" 
+       "(symbol-status symbol &optional ===> (package (symbol-package symbol)) <===)")
+
+      ("(apply 'swank::eval-for-emacs*HERE*"
+       "(apply ===> 'eval-for-emacs <=== &optional form buffer-package id &rest args)")
+
+      ("(apply #'swank::eval-for-emacs*HERE*"
+       "(apply ===> #'eval-for-emacs <=== &optional form buffer-package id &rest args)")
+
+      ("(apply 'swank::eval-for-emacs foo *HERE*"
+       "(apply 'eval-for-emacs &optional form ===> buffer-package <=== id &rest args)")
+
+      ("(apply #'swank::eval-for-emacs foo *HERE*"
+       "(apply #'eval-for-emacs &optional form ===> buffer-package <=== id &rest args)"))
+  (slime-check-top-level)
+  (with-temp-buffer
+    (setq slime-buffer-package "COMMON-LISP-USER")
+    (lisp-mode)
+    (insert buffer-sexpr)
+    (search-backward "*HERE*")
+    (delete-region (match-beginning 0) (match-end 0))
+    (slime-check-autodoc-at-point wished-arglist)
+    (insert ")") (backward-char)
+    (slime-check-autodoc-at-point wished-arglist)
+    ))
+
 (provide 'slime-autodoc)
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/02/02 18:55:36	1.28
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/02/27 21:38:20	1.29
@@ -174,11 +174,20 @@
 ARGLIST-DUMMY is returned instead, which works as a placeholder
 datum for subsequent logics to rely on."
   (let* ((string  (string-left-trim '(#\Space #\Tab #\Newline) string))
-	 (quoted? (eql (aref string 0) #\')))
+         (length  (length string))
+	 (prefix  (cond ((eql (aref string 0) #\') :quote)
+                        ((search "#'" string :end2 (min length 2)) :sharpquote)
+                        (t nil))))
     (multiple-value-bind (symbol found?)
-	(parse-symbol (if quoted? (subseq string 1) string))
+	(parse-symbol (case prefix
+                        (:quote      (subseq string 1))
+                        (:sharpquote (subseq string 2))
+                        (t string)))
       (if found?
-	  (if quoted? `(quote ,symbol) symbol)
+          (case prefix
+            (:quote      `(quote ,symbol))
+            (:sharpquote `(function ,symbol))
+            (t symbol))
 	  (make-arglist-dummy :string-representation string)))))