(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.

3 files changed, 101 insertions, 62 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 9808e043e74..7b24a232f2d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -63,7 +63,9 @@ default toolkit, but you can use --with-x-toolkit=gtk if necessary.
 
 * 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.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 81196b7ec2c..b1299d78b8e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -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.
 
diff --git a/lisp/apropos.el b/lisp/apropos.el
index d453cb89de8..a56cd4218e3 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -190,6 +190,7 @@ term, and the rest of the words are alternative terms.")
 
 (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 @@ term, and the rest of the words are alternative terms.")
 
 (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 @@ term, and the rest of the words are alternative terms.")
 
 (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 @@ term, and the rest of the words are alternative terms.")
 ;; 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 @@ term, and the rest of the words are alternative terms.")
 
 (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 @@ term, and the rest of the words are alternative terms.")
 
 (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 @@ term, and the rest of the words are alternative terms.")
 
 (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 @@ term, and the rest of the words are alternative terms.")
 
 (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 @@ This requires that at least 2 keywords (unless only one was given)."
 
 \\{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 @@ while a list of strings is used as a word list."
                                           (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 @@ Returns list of symbols and values found."
                                                      (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 @@ Will return nil instead."
       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 @@ If non-nil TEXT is a string that will be printed as a heading."
                    (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 @@ If non-nil TEXT is a string that will be printed as a heading."
           (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 @@ If non-nil TEXT is a string that will be printed as a heading."
 
 (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)