[slime-cvs] CVS slime/contrib

[CVS User trittweiler]

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

Modified Files:
	ChangeLog swank-arglists.lisp 
Log Message:
	* swank-backend.lisp (valid-function-name-p): New interface.
	(compiler-macroexpand-1): Use it to guard against type errors
	from COMPILER-MACRO-FUNCTION.

	* swank-arglist.lisp (function-exists-p): Renamed from
	FUNCTION-EXISTS-P. Uses new SWANK-BACKEND:VALID-FUNCTION-NAME-P
	underneath.
	(valid-operator-name-p): Unused, hence deleted.
	(boundp-and-interesting): Renamed from INTERESTING-VARIABLE-P.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2010/09/17 20:32:55	1.419
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2010/09/18 09:34:06	1.420
@@ -1,3 +1,11 @@
+2010-09-18  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank-arglist.lisp (function-exists-p): Renamed from
+	FUNCTION-EXISTS-P. Uses new SWANK-BACKEND:VALID-FUNCTION-NAME-P
+	underneath.
+	(valid-operator-name-p): Unused, hence deleted.
+	(boundp-and-interesting): Renamed from INTERESTING-VARIABLE-P.
+
 2010-09-17  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-sprof.lisp (filter-swank-nodes): Filter other swank
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2010/09/16 19:19:26	1.69
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2010/09/18 09:34:06	1.70
@@ -51,26 +51,11 @@
       (special-operator-p symbol)
       (member symbol '(declare declaim))))
 
-(defun valid-operator-name-p (string)
-  "Is STRING the name of a function, macro, or special-operator?"
-  (let ((symbol (parse-symbol string)))
-    (valid-operator-symbol-p symbol)))
-
-(defun valid-function-name-p (form)
-  (and (match form
-         ((#'symbolp _)         t)
-         (('setf (#'symbolp _)) t)
-         (_                     nil))
+(defun function-exists-p (form)
+  (and (valid-function-name-p form)
        (fboundp form)
        t))
 
-(defun interesting-variable-p (symbol)
-  (and symbol
-       (symbolp symbol)
-       (boundp symbol)
-       (not (memq symbol '(cl:t cl:nil)))
-       (not (keywordp symbol))))
-
 (defmacro multiple-value-or (&rest forms)
   (if (null forms)
       nil
@@ -980,7 +965,7 @@
 
 (defmethod arglist-dispatch ((operator (eql 'defmethod)) arguments)
   (match (cons operator arguments)
-    (('defmethod (#'valid-function-name-p gf-name) . rest)
+    (('defmethod (#'function-exists-p gf-name) . rest)
      (let ((gf (fdefinition gf-name)))
        (when (typep gf 'generic-function)
          (with-available-arglist (arglist) (decode-arglist (arglist gf))
@@ -996,7 +981,7 @@
 
 (defmethod arglist-dispatch ((operator (eql 'define-compiler-macro)) arguments)
   (match (cons operator arguments)
-    (('define-compiler-macro (#'valid-function-name-p gf-name) . _)
+    (('define-compiler-macro (#'function-exists-p gf-name) . _)
      (let ((gf (fdefinition gf-name)))
        (with-available-arglist (arglist) (decode-arglist (arglist gf))
          (return-from arglist-dispatch
@@ -1112,7 +1097,7 @@
     (with-buffer-syntax ()
       (multiple-value-bind (form arglist obj-at-cursor form-path)
           (find-subform-with-arglist (parse-raw-form raw-form))
-        (cond ((interesting-variable-p obj-at-cursor)
+        (cond ((boundp-and-interesting obj-at-cursor)
                (print-variable-to-string obj-at-cursor))
               (t
                (with-available-arglist (arglist) arglist
@@ -1124,6 +1109,13 @@
                                                         form
                                                         arglist)))))))))
 
+(defun boundp-and-interesting (symbol)
+  (and symbol
+       (symbolp symbol)
+       (boundp symbol)
+       (not (memq symbol '(cl:t cl:nil)))
+       (not (keywordp symbol))))
+
 (defun print-variable-to-string (symbol)
   "Return a short description of VARIABLE-NAME, or NIL."
   (let ((*print-pretty* t) (*print-level* 4)