- symbol item tem point1 point2)
- (save-excursion
- (set-buffer standard-output)
- (if window-system
- (insert (substitute-command-keys
- "Click \\<apropos-local-map>\\[apropos-mouse-follow] to get full documentation.\n")))
- (insert (substitute-command-keys
- "In this buffer, type \\<apropos-local-map>\\[apropos-follow] to get full documentation.\n\n"))
- (while (consp p)
- (or (not spacing) (bobp) (terpri))
- (setq item (car p)
- symbol (car item)
- p (cdr p)
- point1 (point))
- (princ symbol) ;print symbol name
- (setq point2 (point))
- ;; don't calculate key-bindings unless needed
- (and do-keys
- (commandp symbol)
- (indent-to 30 1)
- (princ (if (setq tem (save-excursion
- (set-buffer old-buffer)
- (where-is-internal symbol)))
- (mapconcat 'key-description tem ", ")
- "(not bound to any keys)")))
- (terpri)
- ;; only now so we don't propagate text attributes all over
- (put-text-property point1 (1+ point1) 'item
- (if (or (nth 1 item) (nth 2 item) (nth 3 item))
- (car item)
- item))
- (if apropos-use-faces
- (put-text-property point1 point2 'face 'bold))
- (apropos-print-documentation 'describe-function (nth 1 item)
- (if (commandp symbol)
- "Command: "
- "Function: ")
- do-keys)
- (apropos-print-documentation 'describe-variable (nth 2 item)
- "Variable: " do-keys)
- (apropos-print-documentation 'apropos-describe-plist (nth 3 item)
- "Plist: " nil))
- (put-text-property 1 (point) 'local-map apropos-local-map)))))
- apropos-result)
-
-
-(defun apropos-print-documentation (action tem str do-keys)
- (if tem
+ symbol item point1 point2)
+ (set-buffer standard-output)
+ (apropos-mode)
+ (if window-system
+ (insert "If you move the mouse over text that changes color,\n"
+ (substitute-command-keys
+ "you can click \\[apropos-mouse-follow] to get more information.\n")))
+ (insert (substitute-command-keys
+ "In this buffer, type \\[apropos-follow] to get full documentation.\n\n"))
+ (while (consp p)
+ (or (not spacing) (bobp) (terpri))
+ (setq apropos-item (car p)
+ symbol (car apropos-item)
+ p (cdr p)
+ point1 (point))
+ (princ symbol) ; print symbol name
+ (setq point2 (point))
+ ;; Calculate key-bindings if we want them.
+ (and do-keys
+ (commandp symbol)
+ (indent-to 30 1)
+ (if (let ((keys
+ (save-excursion
+ (set-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)
+ loser)
+ (while (< i (length key))
+ (if (or (framep (aref key i))
+ (bufferp (aref key i)))
+ (setq loser t))
+ (setq i (1+ i)))
+ (or loser
+ (setq filtered (cons key filtered))))
+ (setq keys (cdr keys)))
+ (setq item filtered))
+ ;; Convert the remaining keys to a string and insert.
+ (insert
+ (mapconcat
+ (lambda (key)
+ (setq key (key-description key))
+ (if apropos-keybinding-face
+ (put-text-property 0 (length key)
+ 'face apropos-keybinding-face
+ key))
+ key)
+ item ", "))
+ (insert "M-x")
+ (put-text-property (- (point) 3) (point)
+ 'face apropos-keybinding-face)
+ (insert " " (symbol-name symbol) " ")
+ (insert "RET")
+ (put-text-property (- (point) 3) (point)
+ 'face apropos-keybinding-face)))
+ (terpri)
+ ;; only now so we don't propagate text attributes all over
+ (put-text-property point1 point2 'item
+ (if (eval `(or ,@(cdr apropos-item)))
+ (car apropos-item)
+ apropos-item))
+ (if apropos-symbol-face
+ (put-text-property point1 point2 'face apropos-symbol-face))
+ (apropos-print-doc 'describe-function 1
+ (if (commandp symbol)
+ "Command"
+ (if (apropos-macrop symbol)
+ "Macro"
+ "Function"))
+ t)
+ (if (get symbol 'custom-type)
+ (apropos-print-doc 'customize-variable-other-window 2
+ "User Option" t)
+ (apropos-print-doc 'describe-variable 2
+ "Variable" t))
+ (apropos-print-doc 'customize-group-other-window 6 "Group" t)
+ (apropos-print-doc 'customize-face-other-window 5 "Face" t)
+ (apropos-print-doc 'widget-browse-other-window 4 "Widget" t)
+ (apropos-print-doc 'apropos-describe-plist 3
+ "Plist" nil)))))
+ (prog1 apropos-accumulator
+ (setq apropos-accumulator ()))) ; permit gc
+
+
+(defun apropos-macrop (symbol)
+ "T if SYMBOL is a Lisp macro."
+ (and (fboundp symbol)
+ (consp (setq symbol
+ (symbol-function symbol)))
+ (or (eq (car symbol) 'macro)
+ (if (eq (car symbol) 'autoload)
+ (memq (nth 4 symbol)
+ '(macro t))))))
+
+
+(defun apropos-print-doc (action i str do-keys)
+ (if (stringp (setq i (nth i apropos-item)))