Function: apropos-print

apropos-print is a byte-compiled function defined in apropos.el.gz.

Signature

(apropos-print DO-KEYS SPACING &optional TEXT NOSUBST)

Documentation

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.

Source Code

;; Defined in /usr/src/emacs/lisp/apropos.el.gz
(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)
            (first t)
	    symbol item)
	(set-buffer standard-output)
	(apropos-mode)
        (apropos--preamble text)
	(dolist (apropos-item p)
	  (if (and spacing (not first))
	      (princ spacing)
            (setq first nil))
	  (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
			      'outline-level 1)
	  (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))
	  (apropos-print-doc apropos-item
			     2
			     (if (commandp symbol)
				 'apropos-command
			       (if (macrop symbol)
				   'apropos-macro
				 'apropos-function))
			     (not nosubst))
	  (apropos-print-doc apropos-item
			     3
			     (if (custom-variable-p symbol)
				 'apropos-user-option
			       'apropos-variable)
			     (not nosubst))
          ;; Insert an excerpt of variable values.
          (when (boundp symbol)
            (insert "  Value: ")
            (let* ((print-escape-newlines t)
                   (value (prin1-to-string (symbol-value symbol)))
                   (truncated (truncate-string-to-width
                               value (- (window-width) 20) nil nil t)))
              (insert truncated)
              (unless (equal value truncated)
                (buttonize-region (1- (point)) (point)
                                  (lambda (_)
                                    (message "Value: %s" value))))
              (insert "\n")))
	  (apropos-print-doc apropos-item 7 'apropos-group t)
	  (apropos-print-doc apropos-item 6 'apropos-face t)
	  (apropos-print-doc apropos-item 5 'apropos-widget t)
	  (apropos-print-doc apropos-item 4 'apropos-plist nil))
        (setq-local truncate-partial-width-windows t)
        (setq-local truncate-lines t)))
    (when help-window-select
      (select-window (get-buffer-window "*Apropos*"))))
  (prog1 apropos-accumulator
    (setq apropos-accumulator ())))	; permit gc