[slime-cvs] CVS update: slime/swank-cmucl.lisp

[Helmut Eller]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv29343

Modified Files:
	swank-cmucl.lisp 
Log Message:
(debug-function-arglist): Reconstruct the arglist from the the
debug-arguments. (Not complete yet.)
(arglist): Use it.
Date: Sat Mar 27 16:20:22 2004
Author: heller

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.90 slime/swank-cmucl.lisp:1.91
--- slime/swank-cmucl.lisp:1.90	Fri Mar 26 04:21:05 2004
+++ slime/swank-cmucl.lisp	Sat Mar 27 16:20:22 2004
@@ -62,7 +62,7 @@
   (ext:close-socket (socket-fd socket)))
 
 (defimplementation accept-connection (socket)
-  #+MP (mp:process-wait-until-fd-usable socket :input)
+  #+mp (mp:process-wait-until-fd-usable socket :input)
   (make-socket-io-stream (ext:accept-tcp-connection socket)))
 
 (defvar *sigio-handlers* '()
@@ -840,6 +840,21 @@
     (:alien-enum
      (describe (ext:info :alien-type :enum symbol)))))
 
+(defun debug-function-arglist (dfun)
+  (let ((args (di::debug-function-lambda-list dfun))
+        (result '())
+        (key nil))
+    (dolist (arg args)
+      (etypecase arg
+        (di::debug-variable 
+         (push (di::debug-variable-name arg) result))
+        (cons
+         (ecase (car arg)
+           ((:keyword (push (second arg) result))
+           (:optional (push (di::debug-variable-name (second arg)) result))
+           ))))
+    (nreverse result))))
+
 (defimplementation arglist (symbol)
   (let* ((fun (or (macro-function symbol)
                   (symbol-function symbol)))
@@ -854,7 +869,7 @@
                 ;; interpreted-debug-function
                 (t (let ((df (di::function-debug-function fun)))
                      (if df 
-                         (di::debug-function-lambda-list df)
+                         (debug-function-arglist df)
                          "(<arglist-unavailable>)"))))))
     (check-type arglist (or list string))
     arglist))
@@ -1301,7 +1316,7 @@
 
 ;;;; Multiprocessing
 
-#+MP
+#+mp
 (progn
   (defimplementation startup-multiprocessing ()
     ;; Threads magic: this never returns! But top-level becomes