;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
(defvar apropos-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-m" 'apropos-follow)
+ (define-key map " " 'scroll-up)
+ (define-key map "\177" 'scroll-down)
(define-key map [mouse-2] 'apropos-mouse-follow)
(define-key map [down-mouse-2] nil)
map)
(lambda (symbol)
(or (fboundp symbol)
(boundp symbol)
+ (facep symbol)
(symbol-plist symbol))))))
(apropos-print
(or do-all apropos-do-all)
(lambda (p)
- (let (symbol doc)
+ (let (symbol doc properties)
(while p
(setcar p (list
(setq symbol (car p))
- (if (fboundp symbol)
- (if (setq doc (documentation symbol t))
- (substring doc 0 (string-match "\n" doc))
- "(not documented)"))
- (if (boundp symbol)
- (if (setq doc (documentation-property
- symbol 'variable-documentation t))
- (substring doc 0
- (string-match "\n" doc))
- "(not documented)"))
- (if (setq doc (symbol-plist symbol))
- (if (eq (/ (length doc) 2) 1)
- (format "1 property (%s)" (car doc))
- (concat (/ (length doc) 2) " properties")))))
+ (when (fboundp symbol)
+ (if (setq doc (documentation symbol t))
+ (substring doc 0 (string-match "\n" doc))
+ "(not documented)"))
+ (when (boundp symbol)
+ (if (setq doc (documentation-property
+ symbol 'variable-documentation t))
+ (substring doc 0 (string-match "\n" doc))
+ "(not documented)"))
+ (when (setq properties (symbol-plist symbol))
+ (setq doc (list (car properties)))
+ (while (setq properties (cdr (cdr properties)))
+ (setq doc (cons (car properties) doc)))
+ (mapconcat #'symbol-name (nreverse doc) " "))
+ (when (get symbol 'widget-type)
+ (if (setq doc (documentation-property
+ symbol 'widget-documentation t))
+ (substring doc 0
+ (string-match "\n" doc))
+ "(not documented)"))
+ (when (facep symbol)
+ (if (setq doc (documentation-property
+ symbol 'face-documentation t))
+ (substring doc 0
+ (string-match "\n" doc))
+ "(not documented)"))
+ (when (get symbol 'custom-group)
+ (if (setq doc (documentation-property
+ symbol 'group-documentation t))
+ (substring doc 0
+ (string-match "\n" doc))
+ "(not documented)"))))
(setq p (cdr p)))))
nil))
(set-buffer standard-output)
(apropos-mode)
(if window-system
- (insert (substitute-command-keys
- "Click \\[apropos-mouse-follow] to get full documentation.\n")))
+ (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)
point1 (point))
(princ symbol) ; print symbol name
(setq point2 (point))
- ;; don't calculate key-bindings unless needed
+ ;; Calculate key-bindings if we want them.
(and do-keys
(commandp symbol)
(indent-to 30 1)
- (insert
- (if (setq item (save-excursion
- (set-buffer old-buffer)
- (where-is-internal symbol)))
+ (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
- (if apropos-keybinding-face
- (lambda (key)
- (setq key (key-description key))
+ (lambda (key)
+ (setq key (key-description key))
+ (if apropos-keybinding-face
(put-text-property 0 (length key)
'face apropos-keybinding-face
- key)
- key)
- 'key-description)
- item ", ")
- "(not bound to any keys)")))
+ 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
"Macro"
"Function"))
do-keys)
- (apropos-print-doc 'describe-variable 2
- "Variable" do-keys)
+ (if (get symbol 'custom-type)
+ (apropos-print-doc 'customize-variable-other-window 2
+ "User Option" do-keys)
+ (apropos-print-doc 'describe-variable 2
+ "Variable" do-keys))
+ (apropos-print-doc 'customize-other-window 6 "Group" do-keys)
+ (apropos-print-doc 'customize-face-other-window 5 "Face" do-keys)
+ (apropos-print-doc 'widget-browse-other-window 4 "Widget" do-keys)
(apropos-print-doc 'apropos-describe-plist 3
"Plist" nil)))))
(prog1 apropos-accumulator