diff lisp/apropos.el @ 284:558f606b08ae r21-0b40

Import from CVS: tag r21-0b40
author cvs
date Mon, 13 Aug 2007 10:34:13 +0200
parents 7df0dd720c89
children 4711e16a8e49
line wrap: on
line diff
--- a/lisp/apropos.el	Mon Aug 13 10:33:19 2007 +0200
+++ b/lisp/apropos.el	Mon Aug 13 10:34:13 2007 +0200
@@ -241,7 +241,7 @@
 		    (if (setq doc (symbol-plist symbol))
 			(if (eq (/ (length doc) 2) 1)
 			    (format "1 property (%s)" (car doc))
-			  (concat (/ (length doc) 2) " properties")))
+			  (format "%d properties" (/ (length doc) 2))))
 		    (if (get symbol 'widget-type)
 			(if (setq doc (documentation-property
 				       symbol 'widget-documentation t))
@@ -501,96 +501,98 @@
 	 (setq apropos-label-face `(face ,apropos-label-face
 					 mouse-face highlight)))
     (let ((help-buffer-prefix-string "Apropos"))
-      (with-displaying-help-buffer apropos-regexp
-	(with-current-buffer standard-output
-	(run-hooks 'apropos-mode-hook)
-	(let ((p apropos-accumulator)
-	      (old-buffer (current-buffer))
-	      symbol item point1 point2)
-	  ;; XEmacs change from (if window-system
-	  (if (device-on-window-system-p)
-	      (progn
-		(princ "If you move the mouse over text that changes color,\n")
-		(princ (substitute-command-keys
-			"you can click \\[apropos-mouse-follow] to get more information.\n"))))
-	  (princ (substitute-command-keys
-		  "Type \\[apropos-follow] in this buffer to get full documentation.\n\n"))
-	  (while (consp p)
-	    (or (not spacing) (bobp) (terpri))
-	    (setq apropos-item (car p)
-		  symbol (car apropos-item)
-		  p (cdr p)
-		  point1 (point))
-	    (princ symbol)		        ; print symbol name
-	    (setq point2 (point))
-	    ;; Calculate key-bindings if we want them.
-	    (and do-keys
-		 (commandp symbol)
-		 (indent-to 30 1)
-		 (if (let ((keys
-			    (save-excursion
-			      (set-buffer old-buffer)
-			      (where-is-internal symbol)))
-			   filtered)
-		       ;; Copy over the list of key sequences,
-		       ;; omitting any that contain a buffer or a frame.
-		       (while keys
-			 (let ((key (car keys))
-			       (i 0)
-			       loser)
-			   (while (< i (length key))
-			     (if (or (framep (aref key i))
-				     (bufferp (aref key i)))
-				 (setq loser t))
-			     (setq i (1+ i)))
-			   (or loser
-			       (setq filtered (cons key filtered))))
-			 (setq keys (cdr keys)))
-		       (setq item filtered))
-		     ;; Convert the remaining keys to a string and insert.
-		     (princ
-		      (mapconcat
-		       (lambda (key)
-			 (setq key (key-description key))
-			 (if apropos-keybinding-face
-			     (put-text-property 0 (length key)
-						'face apropos-keybinding-face
-						key))
-			 key)
-		       item ", "))
-		   (princ "Type ")
-		   (princ "M-x")
-		   (put-text-property (- (point) 3) (point)
-				      'face apropos-keybinding-face)
-		   (princ (format " %s " (symbol-name symbol)))
-		   (princ "RET")
-		   (put-text-property (- (point) 3) (point)
-				      'face apropos-keybinding-face)))
-	    (terpri)
-	    ;; only now so we don't propagate text attributes all over
-	    (put-text-property point1 point2 'item
-			       (if (eval `(or ,@(cdr apropos-item)))
-				   (car apropos-item)
-				 apropos-item))
-	    (if apropos-symbol-face
-		(put-text-property point1 point2 'face apropos-symbol-face))
-	    (apropos-print-doc 'describe-function 1
-			       (if (commandp symbol)
-				   "Command"
-				 (if (apropos-macrop symbol)
-				     "Macro"
-				   "Function"))
-			       do-keys)
-	    (if (get symbol 'custom-type)
-		(apropos-print-doc 'customize-variable-other-window 2
-				   "User Option" do-keys)
-	      (apropos-print-doc 'describe-variable 2
-				 "Variable" do-keys))
-	      (apropos-print-doc 'customize-other-window 6 "Group" do-keys)
-	      (apropos-print-doc 'customize-face-other-window 5 "Face" do-keys)
-	      (apropos-print-doc 'widget-browse-other-window 4 "Widget" do-keys)
-	      (apropos-print-doc 'apropos-describe-plist 3
-				 "Plist" nil))))))
+      (with-displaying-help-buffer
+       (lambda ()
+	 (with-current-buffer standard-output
+	   (run-hooks 'apropos-mode-hook)
+	   (let ((p apropos-accumulator)
+		 (old-buffer (current-buffer))
+		 symbol item point1 point2)
+	     ;; XEmacs change from (if window-system
+	     (if (device-on-window-system-p)
+		 (progn
+		   (princ "If you move the mouse over text that changes color,\n")
+		   (princ (substitute-command-keys
+			   "you can click \\[apropos-mouse-follow] to get more information.\n"))))
+	     (princ (substitute-command-keys
+		     "Type \\[apropos-follow] in this buffer to get full documentation.\n\n"))
+	     (while (consp p)
+	       (or (not spacing) (bobp) (terpri))
+	       (setq apropos-item (car p)
+		     symbol (car apropos-item)
+		     p (cdr p)
+		     point1 (point))
+	       (princ symbol)		; print symbol name
+	       (setq point2 (point))
+	       ;; Calculate key-bindings if we want them.
+	       (and do-keys
+		    (commandp symbol)
+		    (indent-to 30 1)
+		    (if (let ((keys
+			       (save-excursion
+				 (set-buffer old-buffer)
+				 (where-is-internal symbol)))
+			      filtered)
+			  ;; Copy over the list of key sequences,
+			  ;; omitting any that contain a buffer or a frame.
+			  (while keys
+			    (let ((key (car keys))
+				  (i 0)
+				  loser)
+			      (while (< i (length key))
+				(if (or (framep (aref key i))
+					(bufferp (aref key i)))
+				    (setq loser t))
+				(setq i (1+ i)))
+			      (or loser
+				  (setq filtered (cons key filtered))))
+			    (setq keys (cdr keys)))
+			  (setq item filtered))
+			;; Convert the remaining keys to a string and insert.
+			(princ
+			 (mapconcat
+			  (lambda (key)
+			    (setq key (key-description key))
+			    (if apropos-keybinding-face
+				(put-text-property 0 (length key)
+						   'face apropos-keybinding-face
+						   key))
+			    key)
+			  item ", "))
+		      (princ "Type ")
+		      (princ "M-x")
+		      (put-text-property (- (point) 3) (point)
+					 'face apropos-keybinding-face)
+		      (princ (format " %s " (symbol-name symbol)))
+		      (princ "RET")
+		      (put-text-property (- (point) 3) (point)
+					 'face apropos-keybinding-face)))
+	       (terpri)
+	       ;; only now so we don't propagate text attributes all over
+	       (put-text-property point1 point2 'item
+				  (if (eval `(or ,@(cdr apropos-item)))
+				      (car apropos-item)
+				    apropos-item))
+	       (if apropos-symbol-face
+		   (put-text-property point1 point2 'face apropos-symbol-face))
+	       (apropos-print-doc 'describe-function 1
+				  (if (commandp symbol)
+				      "Command"
+				    (if (apropos-macrop symbol)
+					"Macro"
+				      "Function"))
+				  do-keys)
+	       (if (get symbol 'custom-type)
+		   (apropos-print-doc 'customize-variable-other-window 2
+				      "User Option" do-keys)
+		 (apropos-print-doc 'describe-variable 2
+				    "Variable" do-keys))
+	       (apropos-print-doc 'customize-other-window 6 "Group" do-keys)
+	       (apropos-print-doc 'customize-face-other-window 5 "Face" do-keys)
+	       (apropos-print-doc 'widget-browse-other-window 4 "Widget" do-keys)
+	       (apropos-print-doc 'apropos-describe-plist 3
+				  "Plist" nil)))))
+       apropos-regexp))
     (prog1 apropos-accumulator
       (setq apropos-accumulator ()))))	; permit gc
 
@@ -668,18 +670,20 @@
 (defun apropos-describe-plist (symbol)
   "Display a pretty listing of SYMBOL's plist."
   (let ((help-buffer-prefix-string "Apropos-plist"))
-    (with-displaying-help-buffer (symbol-name symbol)
-      (run-hooks 'apropos-mode-hook)
-      (princ "Symbol ")
-      (prin1 symbol)
-      (princ "'s plist is\n (")
-      (with-current-buffer standard-output
-	(if apropos-symbol-face
-	    (put-text-property 8 (- (point) 14) 'face apropos-symbol-face)))
-      (princ (apropos-format-plist symbol "\n  "))
-      (princ ")")
-      (terpri)
-      (print-help-return-message))))
+    (with-displaying-help-buffer
+     (lambda ()
+       (run-hooks 'apropos-mode-hook)
+       (princ "Symbol ")
+       (prin1 symbol)
+       (princ "'s plist is\n (")
+       (with-current-buffer standard-output
+	 (if apropos-symbol-face
+	     (put-text-property 8 (- (point) 14) 'face apropos-symbol-face)))
+       (princ (apropos-format-plist symbol "\n  "))
+       (princ ")")
+       (terpri)
+       (print-help-return-message))
+     (symbol-name symbol))))
 
 (provide 'apropos) ; XEmacs