[slime-cvs] CVS slime

CVS User heller heller at common-lisp.net
Mon May 23 11:41:27 UTC 2011


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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-apropos-label-properties): Deleted.  Just
auto-load apropos-mode.
(slime-print-apropos): Use the variable apropos-label-face
which seems to exist in all relevant Emacsen.

--- /project/slime/cvsroot/slime/ChangeLog	2011/05/22 07:18:52	1.2191
+++ /project/slime/cvsroot/slime/ChangeLog	2011/05/23 11:41:27	1.2192
@@ -1,3 +1,10 @@
+2011-05-23  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-apropos-label-properties): Deleted.  Just
+	auto-load apropos-mode.
+	(slime-print-apropos): Use the variable apropos-label-face
+	which seems to exist in all relevant Emacsen.
+
 2011-05-22  Helmut Eller  <heller at common-lisp.net>
 
 	Turn on lexical-binding for slime.el.
--- /project/slime/cvsroot/slime/slime.el	2011/05/22 07:18:52	1.1366
+++ /project/slime/cvsroot/slime/slime.el	2011/05/23 11:41:27	1.1367
@@ -4518,6 +4518,7 @@
                      current-prefix-arg))
   (slime-apropos "" (not internal) package))
 
+(autoload 'apropos-mode "apropos")
 (defun slime-show-apropos (plists string package summary)
   (if (null plists)
       (message "No apropos matches for %S" string)
@@ -4532,55 +4533,42 @@
         (set-syntax-table lisp-mode-syntax-table)
         (goto-char (point-min)))))
 
-(defvar slime-apropos-label-properties
-  (progn
-    (require 'apropos)
-    (cond ((and (boundp 'apropos-label-properties) 
-                (symbol-value 'apropos-label-properties)))
-          ((boundp 'apropos-label-face)
-           (etypecase (symbol-value 'apropos-label-face)
-             (symbol `(face ,(or (symbol-value 'apropos-label-face)
-                                 'italic)
-                            mouse-face highlight))
-             (list (symbol-value 'apropos-label-face)))))))
-
 (defun slime-print-apropos (plists)
   (dolist (plist plists)
     (let ((designator (plist-get plist :designator)))
       (assert designator)
       (slime-insert-propertized `(face ,apropos-symbol-face) designator))
     (terpri)
-    (let ((apropos-label-properties slime-apropos-label-properties))
-      (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))
-		  (start (point)))
-	      (when value
-		(princ "  ") 
-		(slime-insert-propertized apropos-label-properties 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)))))))
+    (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))
+                (start (point)))
+            (when value
+              (princ "  ")
+              (slime-insert-propertized `(face ,apropos-label-face) 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))))))
 
 (defun slime-call-describer (arg)
   (let* ((pos (if (markerp arg) arg (point)))





More information about the slime-cvs mailing list