bug#31094: Code for second solution

[Boruch Baum <boruch_baum@gmx.com>]

[-- Attachment #1: Type: text/plain, Size: 441 bytes --]

Attached is code for the second solution idea that I mrentioned in my
first post. Note that these approaches are complementary and
independent; I would advocate for both being adopted.

Do note that this 'breaks' a feature formerly available. Prior, pressing
return on an entry would display documentation for that entry; Now one
must press `C-h v' / `C-h f' etc.

-- 
hkp://keys.gnupg.net
CA45 09B5 5351 7C11 A9D1  7286 0036 9E45 1595 8BC0

[-- Attachment #2: apropos-print.el --]
[-- Type: text/plain, Size: 5329 bytes --]

(defcustom apropos-value-limited-print nil
"Print only symbol names, not their contents.

When this option is active, one may always view a symbol's
contents by `C-h v' while point is on the symbol's name."
  :type 'boolean)


(defun apropos-print (do-keys spacing &optional text nosubst)
  "Output result of apropos searching into buffer `*Apropos*'.
The value of `apropos-accumulator' is the list of items to output.
Each element should have the format
 (SYMBOL SCORE FN-DOC VAR-DOC [PLIST-DOC WIDGET-DOC FACE-DOC GROUP-DOC]).
The return value is the list that was in `apropos-accumulator', sorted
alphabetically by symbol name; but this function also sets
`apropos-accumulator' to nil before returning.
If DO-KEYS is non-nil, output the key bindings.  If NOSUBST is
nil, substitute \"ASCII quotes\" (i.e., grace accent and
apostrophe) with curly quotes), and if non-nil, leave them alone.
If SPACING is non-nil, it should be a string; separate items with
that string.  If non-nil, TEXT is a string that will be printed
as a heading."
  (if (null apropos-accumulator)
      (message "No apropos matches for `%s'" apropos-pattern)
    (setq apropos-accumulator
	  (sort apropos-accumulator
		(lambda (a b)
		  (if apropos-sort-by-scores
		      (or (> (cadr a) (cadr b))
			  (and (= (cadr a) (cadr b))
			       (string-lessp (car a) (car b))))
		    (string-lessp (car a) (car b))))))
    (with-output-to-temp-buffer "*Apropos*"
      (let ((p apropos-accumulator)
	    (old-buffer (current-buffer))
	    (inhibit-read-only t)
	    (button-end 0)
	    symbol item)
	(set-buffer standard-output)
	(apropos-mode)
	(if text (insert text "\n\n"))
	(dolist (apropos-item p)
	  (when (and (not apropos-value-limited-print) spacing (not (bobp)))
	    (princ spacing))
	  (setq symbol (car apropos-item))
	  ;; Insert dummy score element for backwards compatibility with 21.x
	  ;; apropos-item format.
	  (if (not (numberp (cadr apropos-item)))
	      (setq apropos-item
		    (cons (car apropos-item)
			  (cons nil (cdr apropos-item)))))
	  (when (= (point) button-end) (terpri))
	  (insert-text-button (symbol-name symbol)
			      'type 'apropos-symbol
			      'skip apropos-multi-type
			      'face 'apropos-symbol)
	  (setq button-end (point))
	  (if (and (eq apropos-sort-by-scores 'verbose)
		   (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
                            (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 anybody 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)))
			 (put-text-property 0 (length key)
					    'face 'apropos-keybinding
					    key)
                         key)
                       item ", "))
                   (insert "M-x ... RET")
		   (put-text-property (- (point) 11) (- (point) 8)
				      'face 'apropos-keybinding)
		   (put-text-property (- (point) 3) (point)
				      'face 'apropos-keybinding)))
            (terpri))
          (when (not apropos-value-limited-print)
	    (apropos-print-doc 2
	          	     (if (commandp symbol)
	          		 'apropos-command
	          	       (if (macrop symbol)
	          		   'apropos-macro
	          		 'apropos-function))
	          	     (not nosubst))
	    (apropos-print-doc 3
	          	     (if (custom-variable-p symbol)
	          		 'apropos-user-option
	          	       'apropos-variable)
	          	     (not nosubst))
	    (apropos-print-doc 7 'apropos-group t)
	    (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))))
  (prog1 apropos-accumulator
    (setq apropos-accumulator ())))	; permit gc