[slime-cvs] CVS slime

[trittweiler]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv28231

Modified Files:
	swank-ecl.lisp ChangeLog 
Log Message:

Improve ECL's arglist support somewhat.

* swank-ecl.lisp (grovel-docstring-for-arglist): New function.
  (arglist): Use it. Now also try to find an arglist for special
  operators, and macros.


--- /project/slime/cvsroot/slime/swank-ecl.lisp	2008/09/18 10:08:34	1.31
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2008/09/26 23:14:10	1.32
@@ -170,31 +170,45 @@
 
 ;;;; Documentation
 
+(defun grovel-docstring-for-arglist (name type)
+  (flet ((compute-arglist-offset (docstring)
+           (when docstring
+             (let ((pos1 (search "Args: " docstring)))
+               (if pos1
+                   (+ pos1 6)
+                   (let ((pos2 (search "Syntax: " docstring)))
+                     (when pos2
+                       (+ pos2 8))))))))
+    (let* ((docstring (si::get-documentation name type))
+           (pos (compute-arglist-offset docstring)))
+      (if pos
+          (multiple-value-bind (arglist errorp)
+              (ignore-errors
+                (values (read-from-string docstring t nil :start pos)))
+            (if errorp :not-available (cdr arglist)))
+          :not-available ))))
+
 (defimplementation arglist (name)
-  (or (functionp name) (setf name (symbol-function name)))
-  (if (functionp name)
-      (typecase name 
-        (generic-function
-         (clos::generic-function-lambda-list name))
-        (compiled-function
-         ; most of the compiled functions have an Args: line in their docs
-         (with-input-from-string (s (or
-                                     (si::get-documentation
-                                      (si:compiled-function-name name) 'function)
-                                     ""))
-           (do ((line (read-line s nil) (read-line s nil)))
-               ((not line) :not-available)
-             (ignore-errors
-               (if (string= (subseq line 0 6) "Args: ")
-                   (return-from nil
-                     (read-from-string (subseq line 6))))))))
-         ;
-        (function
-         (let ((fle (function-lambda-expression name)))
-           (case (car fle)
-             (si:lambda-block (caddr fle))
-             (t               :not-available)))))
-      :not-available))
+  (cond ((special-operator-p name)
+         (grovel-docstring-for-arglist name 'function))
+        ((macro-function name)
+         (grovel-docstring-for-arglist name 'function))
+        ((or (functionp name) (fboundp name))
+         (multiple-value-bind (name fndef)
+             (if (functionp name)
+                 (values (function-name name) name)
+                 (values name (fdefinition name)))
+           (typecase fndef
+             (generic-function
+              (clos::generic-function-lambda-list fndef))
+             (compiled-function
+              (grovel-docstring-for-arglist name 'function))
+             (function
+              (let ((fle (function-lambda-expression fndef)))
+                (case (car fle)
+                  (si:lambda-block (caddr fle))
+                  (t               :not-available)))))))
+        (t :not-available)))
 
 (defimplementation function-name (f)
   (si:compiled-function-name f))
--- /project/slime/cvsroot/slime/ChangeLog	2008/09/26 12:24:54	1.1544
+++ /project/slime/cvsroot/slime/ChangeLog	2008/09/26 23:14:10	1.1545
@@ -1,4 +1,12 @@
-2008-09-25  Tobias C. Rittweiler  <tcr at freebits.de>
+2008-09-27  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	Improve ECL's arglist support somewhat.
+
+	* swank-ecl.lisp (grovel-docstring-for-arglist): New function.
+	(arglist): Use it. Now also try to find an arglist for special
+	operators, and macros.
+
+2008-09-26  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime.el (slime-cycle-connections): Do not make the new
 	connection buffer-local if we're currently in a REPL buffer.