changeset 95749:7957e6e1f9b6

(apropos-function, apropos-macro, apropos-command) (apropos-variable, apropos-face, apropos-group, apropos-widget) (apropos-plist): Add apropos-short-label property. (apropos-multi-type): New variables. (apropos-command, apropos-value): Set it. (apropos-compact-layout): New custom. (apropos-print, apropos-print-doc): Use it. (apropos-print): Truncate lines.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Tue, 10 Jun 2008 02:44:48 +0000
parents d57fdb8fadbf
children 6c14c564fa23
files etc/NEWS lisp/ChangeLog lisp/apropos.el
diffstat 3 files changed, 101 insertions(+), 62 deletions(-) [+]
line wrap: on
line diff
--- a/etc/NEWS	Tue Jun 10 02:22:48 2008 +0000
+++ b/etc/NEWS	Tue Jun 10 02:44:48 2008 +0000
@@ -63,7 +63,9 @@
 
 * Changes in Emacs 23.1
 
-** `apropos-library' describes the elements defined in a given library.
+** Apropos
+*** `apropos-library' describes the elements defined in a given library.
+*** Set `apropos-compact-layout' is you want a more compact (but wider) layout.
 
 ** scroll-preserve-screen-position also preserves the column position.
 ** Completion.
--- a/lisp/ChangeLog	Tue Jun 10 02:22:48 2008 +0000
+++ b/lisp/ChangeLog	Tue Jun 10 02:44:48 2008 +0000
@@ -1,3 +1,14 @@
+2008-06-10  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* apropos.el (apropos-function, apropos-macro, apropos-command)
+	(apropos-variable, apropos-face, apropos-group, apropos-widget)
+	(apropos-plist): Add apropos-short-label property.
+	(apropos-multi-type): New variables.
+	(apropos-command, apropos-value): Set it.
+	(apropos-compact-layout): New custom.
+	(apropos-print, apropos-print-doc): Use it.
+	(apropos-print): Truncate lines.
+
 2008-06-09  Kenichi Handa  <handa@m17n.org>
 
 	* international/fontset.el (font-encoding-alist):
@@ -149,7 +160,7 @@
 	to `newsticker--plainview-tool-bar-map'.
 	(newsticker--url-keymap): Add mouse-1 binding.
 	(newsticker-plainview): New.
-	(newsticker-mark-all-items-of-feed-as-read): Doc changed.
+	(newsticker-mark-all-items-of-feed-as-read): Change doc.
 	(newsticker--buffer-do-insert-text): Use renamed
 	newsticker--[buffer-]insert-enclosure and
 	newsticker--[buffer-]print-extra-elements.
@@ -173,8 +184,8 @@
 	* window.el (split-height-threshold, split-width-threshold):
 	Add choice nil.
 	(split-window-preferred-function): Allow either nil or a function.
-	(window--splittable-p, window--try-to-split-window): Handle
-	changed option values.
+	(window--splittable-p, window--try-to-split-window):
+	Handle changed option values.
 
 	(window--frame-usable-p): Handle nil argument.
 
--- a/lisp/apropos.el	Tue Jun 10 02:22:48 2008 +0000
+++ b/lisp/apropos.el	Tue Jun 10 02:44:48 2008 +0000
@@ -190,6 +190,7 @@
 
 (define-button-type 'apropos-function
   'apropos-label "Function"
+  'apropos-short-label "f"
   'help-echo "mouse-2, RET: Display more help on this function"
   'follow-link t
   'action (lambda (button)
@@ -197,6 +198,7 @@
 
 (define-button-type 'apropos-macro
   'apropos-label "Macro"
+  'apropos-short-label "m"
   'help-echo "mouse-2, RET: Display more help on this macro"
   'follow-link t
   'action (lambda (button)
@@ -204,6 +206,7 @@
 
 (define-button-type 'apropos-command
   'apropos-label "Command"
+  'apropos-short-label "c"
   'help-echo "mouse-2, RET: Display more help on this command"
   'follow-link t
   'action (lambda (button)
@@ -216,6 +219,7 @@
 ;; Likewise for `customize-face-other-window'.
 (define-button-type 'apropos-variable
   'apropos-label "Variable"
+  'apropos-short-label "v"
   'help-echo "mouse-2, RET: Display more help on this variable"
   'follow-link t
   'action (lambda (button)
@@ -223,6 +227,7 @@
 
 (define-button-type 'apropos-face
   'apropos-label "Face"
+  'apropos-short-label "F"
   'help-echo "mouse-2, RET: Display more help on this face"
   'follow-link t
   'action (lambda (button)
@@ -230,6 +235,7 @@
 
 (define-button-type 'apropos-group
   'apropos-label "Group"
+  'apropos-short-label "g"
   'help-echo "mouse-2, RET: Display more help on this group"
   'follow-link t
   'action (lambda (button)
@@ -238,6 +244,7 @@
 
 (define-button-type 'apropos-widget
   'apropos-label "Widget"
+  'apropos-short-label "w"
   'help-echo "mouse-2, RET: Display more help on this widget"
   'follow-link t
   'action (lambda (button)
@@ -245,6 +252,7 @@
 
 (define-button-type 'apropos-plist
   'apropos-label "Plist"
+  'apropos-short-label "p"
   'help-echo "mouse-2, RET: Display more help on this plist"
   'follow-link t
   'action (lambda (button)
@@ -408,6 +416,10 @@
 
 \\{apropos-mode-map}")
 
+(defvar apropos-multi-type t
+  "If non-nil, this apropos query concerns multiple types.
+This is used to decide whether to print the result's type or not.")
+
 ;;;###autoload
 (defun apropos-variable (pattern &optional do-all)
   "Show user variables that match PATTERN.
@@ -493,7 +505,8 @@
 					  (string-match "\n" doc)))))))
 	(setcar (cdr (car p)) score)
 	(setq p (cdr p))))
-    (and (apropos-print t nil nil t)
+    (and (let ((apropos-multi-type do-all))
+           (apropos-print t nil nil t))
 	 message
 	 (message "%s" message))))
 
@@ -683,7 +696,8 @@
 						     (apropos-score-str p))
 						  f v p)
 					    apropos-accumulator))))))
-  (apropos-print nil "\n----------------\n"))
+   (let ((apropos-multi-type do-all))
+     (apropos-print nil "\n----------------\n")))
 
 
 ;;;###autoload
@@ -910,6 +924,9 @@
       nil
     function))
 
+(defcustom apropos-compact-layout nil
+  "If non-nil, use a single line per binding."
+  :type 'boolean)
 
 (defun apropos-print (do-keys spacing &optional text nosubst)
   "Output result of apropos searching into buffer `*Apropos*'.
@@ -971,51 +988,52 @@
 		   (cadr apropos-item))
 	      (insert " (" (number-to-string (cadr apropos-item)) ") "))
 	  ;; Calculate key-bindings if we want them.
-          (and do-keys
-               (commandp symbol)
-               (not (eq symbol 'self-insert-command))
-               (indent-to 30 1)
-               (if (let ((keys
-                          (with-current-buffer old-buffer
-                            (where-is-internal symbol)))
-                         filtered)
-                     ;; Copy over the list of key sequences,
-                     ;; omitting any that contain a buffer or a frame.
-                     ;; FIXME: Why omit keys that contain buffers and
-                     ;; frames?  This looks like a bad workaround rather
-                     ;; than a proper fix.  Does anybod know what problem
-                     ;; this is trying to address?  --Stef
-                     (dolist (key keys)
-                       (let ((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
-                             (push key filtered))))
-                     (setq item filtered))
-                   ;; Convert the remaining keys to a string and insert.
-                   (insert
-                    (mapconcat
-                     (lambda (key)
-                       (setq key (condition-case ()
-                                     (key-description key)
-                                   (error)))
-                       (if apropos-keybinding-face
-                           (put-text-property 0 (length key)
-                                              'face apropos-keybinding-face
-                                              key))
-                       key)
-                     item ", "))
-                 (insert "M-x ... RET")
-                 (when apropos-keybinding-face
-                   (put-text-property (- (point) 11) (- (point) 8)
-                                      'face apropos-keybinding-face)
-                   (put-text-property (- (point) 3) (point)
-                                      'face apropos-keybinding-face))))
-          (terpri)
+          (unless apropos-compact-layout
+            (and do-keys
+                 (commandp symbol)
+                 (not (eq symbol 'self-insert-command))
+                 (indent-to 30 1)
+                 (if (let ((keys
+                            (with-current-buffer old-buffer
+                              (where-is-internal symbol)))
+                           filtered)
+                       ;; Copy over the list of key sequences,
+                       ;; omitting any that contain a buffer or a frame.
+                       ;; FIXME: Why omit keys that contain buffers and
+                       ;; frames?  This looks like a bad workaround rather
+                       ;; than a proper fix.  Does anybod know what problem
+                       ;; this is trying to address?  --Stef
+                       (dolist (key keys)
+                         (let ((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
+                               (push key filtered))))
+                       (setq item filtered))
+                     ;; Convert the remaining keys to a string and insert.
+                     (insert
+                      (mapconcat
+                       (lambda (key)
+                         (setq key (condition-case ()
+                                       (key-description key)
+                                     (error)))
+                         (if apropos-keybinding-face
+                             (put-text-property 0 (length key)
+                                                'face apropos-keybinding-face
+                                                key))
+                         key)
+                       item ", "))
+                   (insert "M-x ... RET")
+                   (when apropos-keybinding-face
+                     (put-text-property (- (point) 11) (- (point) 8)
+                                        'face apropos-keybinding-face)
+                     (put-text-property (- (point) 3) (point)
+                                        'face apropos-keybinding-face))))
+            (terpri))
 	  (apropos-print-doc 2
 			     (if (commandp symbol)
 				 'apropos-command
@@ -1028,6 +1046,8 @@
 	  (apropos-print-doc 6 'apropos-face t)
 	  (apropos-print-doc 5 'apropos-widget t)
 	  (apropos-print-doc 4 'apropos-plist nil))
+        (set (make-local-variable 'truncate-partial-width-windows) t)
+        (set (make-local-variable 'truncate-lines) t)
 	(setq buffer-read-only t))))
   (prog1 apropos-accumulator
     (setq apropos-accumulator ())))	; permit gc
@@ -1045,19 +1065,25 @@
 
 (defun apropos-print-doc (i type do-keys)
   (when (stringp (setq i (nth i apropos-item)))
-    (insert "  ")
-    (insert-text-button (button-type-get type 'apropos-label)
-                        'type type
-                        ;; Can't use the default button face, since
-                        ;; user may have changed the variable!
-                        ;; Just say `no' to variables containing faces!
-                        'face apropos-label-face
-                        'apropos-symbol (car apropos-item))
-    (insert ": ")
-    (insert (if do-keys (substitute-command-keys i) i))
+    (if apropos-compact-layout
+        (insert (propertize "\t" 'display '(space :align-to 32)) " ")
+      (insert "  "))
+    ;; If the query is only for a single type, there's
+    ;; no point writing it over and over again.
+    (when apropos-multi-type
+      (insert-text-button
+       (if apropos-compact-layout
+           (button-type-get type 'apropos-label)
+         (format "<%s>" (button-type-get type 'apropos-short-label)))
+       'type type
+       ;; Can't use the default button face, since user may have changed the
+       ;; variable!  Just say `no' to variables containing faces!
+       'face apropos-label-face
+       'apropos-symbol (car apropos-item))
+      (insert (if apropos-compact-layout " " ": ")))
+	(insert (if do-keys (substitute-command-keys i) i))
     (or (bolp) (terpri))))
 
-
 (defun apropos-follow ()
   "Invokes any button at point, otherwise invokes the nearest label button."
   (interactive)