[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog slime.el swank-backend.lisp swank-ecl.lisp 
Log Message:
* swank-ecl.lisp (describe-symbol-for-emacs): Include bound
symbols even those without documentation.

* slime.el (slime-print-apropos): Do some input validation to
detect bugs on the Lisp side.

* swank-backend.lisp (describe-symbol-for-emacs): Allow NIL where
:NOT-DOCUMENTED was needed.

--- /project/slime/cvsroot/slime/ChangeLog	2013/01/05 08:50:24	1.2380
+++ /project/slime/cvsroot/slime/ChangeLog	2013/01/07 10:12:08	1.2381
@@ -1,3 +1,14 @@
+2013-01-07  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-ecl.lisp (describe-symbol-for-emacs): Include bound
+	symbols even those without documentation.
+
+	* slime.el (slime-print-apropos): Do some input validation to
+	detect bugs on the Lisp side.
+
+	* swank-backend.lisp (describe-symbol-for-emacs): Allow NIL where
+	:NOT-DOCUMENTED was needed.
+
 2013-01-05  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-ccl.lisp (frame-package): Implemented.
--- /project/slime/cvsroot/slime/slime.el	2012/12/16 13:38:07	1.1425
+++ /project/slime/cvsroot/slime/slime.el	2013/01/07 10:12:08	1.1426
@@ -4630,42 +4630,43 @@
         (set-syntax-table lisp-mode-syntax-table)
         (goto-char (point-min)))))
 
+(defvar slime-apropos-namespaces
+  '((:variable "Variable")
+    (:function "Function")
+    (:generic-function "Generic Function")
+    (:macro "Macro")
+    (:special-operator "Special Operator")
+    (:setf "Setf")
+    (:type "Type")
+    (:class "Class")
+    (:alien-type "Alien type")
+    (:alien-struct "Alien struct")
+    (:alien-union "Alien type")
+    (:alien-enum "Alien enum")))
+
 (defun slime-print-apropos (plists)
   (dolist (plist plists)
     (let ((designator (plist-get plist :designator)))
       (assert designator)
       (slime-insert-propertized `(face slime-apropos-symbol) designator))
     (terpri)
-    (loop for (prop namespace)
-          in '((:variable "Variable")
-               (:function "Function")
-               (:generic-function "Generic Function")
-               (:macro "Macro")
-               (:special-operator "Special Operator")
-               (:setf "Setf")
-               (:type "Type")
-               (:class "Class")
-               (:alien-type "Alien type")
-               (:alien-struct "Alien struct")
-               (:alien-union "Alien type")
-               (:alien-enum "Alien enum"))
-          ;; Properties not listed here will not show up in the buffer
-          do
-          (let ((value (plist-get plist prop))
+    (loop for (prop value) on plist by #'cddr
+          unless (eq prop :designator) do
+          (let ((namespace (cadr (or (assq prop slime-apropos-namespaces)
+                                     (error "Unknown property: %S" prop))))
                 (start (point)))
-            (when value
-              (princ "  ")
-              (slime-insert-propertized `(face slime-apropos-label) namespace)
-              (princ ": ")
-              (princ (etypecase value
-                       (string value)
-                       ((member :not-documented) "(not documented)")))
-              (add-text-properties
-               start (point)
-               (list 'type prop 'action 'slime-call-describer
-                     'button t 'apropos-label namespace
-                     'item (plist-get plist :designator)))
-              (terpri))))))
+            (princ "  ")
+            (slime-insert-propertized `(face slime-apropos-label) namespace)
+            (princ ": ")
+            (princ (etypecase value
+                     (string value)
+                     ((member nil :not-documented) "(not documented)")))
+            (add-text-properties
+             start (point)
+             (list 'type prop 'action 'slime-call-describer
+                   'button t 'apropos-label namespace
+                   'item (plist-get plist :designator)))
+            (terpri)))))
 
 (defun slime-call-describer (arg)
   (let* ((pos (if (markerp arg) arg (point)))
--- /project/slime/cvsroot/slime/swank-backend.lisp	2012/12/03 03:43:16	1.221
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2013/01/07 10:12:09	1.222
@@ -840,8 +840,9 @@
   :TYPE :CLASS :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
 
 The value of each property is the corresponding documentation string,
-or :NOT-DOCUMENTED. It is legal to include keys not listed here (but
-slime-print-apropos in Emacs must know about them).
+or NIL (or the obsolete :NOT-DOCUMENTED). It is legal to include keys
+not listed here (but slime-print-apropos in Emacs must know about
+them).
 
 Properties should be included if and only if they are applicable to
 the symbol. For example, only (and all) fbound symbols should include
--- /project/slime/cvsroot/slime/swank-ecl.lisp	2012/12/17 11:33:47	1.79
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2013/01/07 10:12:09	1.80
@@ -329,9 +329,13 @@
 
 (defimplementation describe-symbol-for-emacs (symbol)
   (let ((result '()))
-    (dolist (type '(:VARIABLE :FUNCTION :CLASS))
-      (when-let (doc (describe-definition symbol type))
-        (setf result (list* type doc result))))
+    (flet ((frob (type boundp)
+             (when (funcall boundp symbol)
+               (let ((doc (describe-definition symbol type)))
+                 (setf result (list* type doc result))))))
+      (frob :VARIABLE #'boundp)
+      (frob :FUNCTION #'fboundp)
+      (frob :CLASS (lambda (x) (find-class x nil))))
     result))
 
 (defimplementation describe-definition (name type)