Re: window groups

[Stefan Monnier]

> That was one thing that has annoyed me since switching from XEmacs.  I also
> miss the compact disiplay of hyper-apropos bound to C-h a in XEmacs.  Here
> is an example as was recently asked for:
<as well as>
> The key virtue is columnar layout which is visually easier to parse and
> faster to navigate.  My final sample shows that gnu emacs does not eschew
> long lines.

The patch below adds an apropos-compact-layout customization to get
something similar to what XEmacs provides.  Check it out,


        Stefan



--- apropos.el.~1.127.~ 2008-05-06 23:35:06.000000000 -0400
+++ apropos.el  2008-06-07 22:31:01.000000000 -0400
@@ -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)
@@ -402,6 +410,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.
@@ -487,7 +499,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))))
 
@@ -617,7 +658,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
@@ -844,6 +886,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*'.
@@ -885,12 +930,10 @@
                (substitute-command-keys
                 "and type \\[apropos-follow] to get full documentation.\n\n"))
        (if text (insert text "\n\n"))
-       (while (consp p)
+       (dolist (apropos-item p)
          (when (and spacing (not (bobp)))
            (princ spacing))
-         (setq apropos-item (car p)
-               symbol (car apropos-item)
-               p (cdr p))
+         (setq symbol (car apropos-item))
          ;; Insert dummy score element for backwards compatibility with 21.x
          ;; apropos-item format.
          (if (not (numberp (cadr apropos-item)))
@@ -905,22 +948,25 @@
                              'face apropos-symbol-face)
          (if (and (eq apropos-sort-by-scores 'verbose)
                   (cadr apropos-item))
-             (insert " (" (number-to-string (cadr apropos-item)) ") "))
+             (insert " (" (number-to-string (cadr apropos-item)) ")"))
          ;; Calculate key-bindings if we want them.
+          (unless apropos-compact-layout
          (and do-keys
               (commandp symbol)
               (not (eq symbol 'self-insert-command))
               (indent-to 30 1)
               (if (let ((keys
-                         (save-excursion
-                           (set-buffer old-buffer)
+                            (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.
-                    (while keys
-                      (let ((key (car keys))
-                            (i 0)
+                       ;; 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))
@@ -928,8 +974,7 @@
                               (setq loser t))
                           (setq i (1+ i)))
                         (or loser
-                            (setq filtered (cons key filtered))))
-                      (setq keys (cdr keys)))
+                               (push key filtered))))
                     (setq item filtered))
                   ;; Convert the remaining keys to a string and insert.
                   (insert
@@ -950,7 +995,7 @@
                                      'face apropos-keybinding-face)
                   (put-text-property (- (point) 3) (point)
                                      'face apropos-keybinding-face))))
-         (terpri)
+            (terpri))
          (apropos-print-doc 2
                             (if (commandp symbol)
                                 'apropos-command
@@ -963,11 +1008,12 @@
          (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
 
-
 (defun apropos-macrop (symbol)
   "Return t if SYMBOL is a Lisp macro."
   (and (fboundp symbol)
@@ -980,20 +1026,26 @@
 
 
 (defun apropos-print-doc (i type do-keys)
-  (if (stringp (setq i (nth i apropos-item)))
-      (progn
-       (insert "  ")
-       (insert-text-button (button-type-get type 'apropos-label)
+  (when (stringp (setq i (nth i apropos-item)))
+    (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 (button-type-get type
+                                           (if apropos-compact-layout
+                                               'apropos-short-label
+                                             '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 apropos-compact-layout " " ": ")))
        (insert (if do-keys (substitute-command-keys i) i))
-       (or (bolp) (terpri)))))
-
+    (or (bolp) (terpri))))
 
 (defun apropos-follow ()
   "Invokes any button at point, otherwise invokes the nearest label button."