1 ;;; help.el --- help commands for XEmacs.
3 ;; Copyright (C) 1985, 1986, 1992-4, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 2001 Ben Wing.
7 ;; Keywords: help, internal, dumped
9 ;; This file is part of XEmacs.
11 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; XEmacs is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
26 ;;; Synched up with: FSF 19.30.
30 ;; This file is dumped with XEmacs.
32 ;; This code implements XEmacs's on-line help system, the one invoked by
33 ;;`M-x help-for-help'.
35 ;; 06/11/1997 -- Converted to use char-after instead of broken
36 ;; following-char. -slb
40 ;; Get the macro make-help-screen when this is compiled,
41 ;; or run interpreted, but not when the compiled code is loaded.
42 (eval-when-compile (require 'help-macro))
45 "Support for on-line help systems."
48 (defgroup help-appearance nil
49 "Appearance of help buffers."
52 (defvar help-map (let ((map (make-sparse-keymap)))
53 (set-keymap-name map 'help-map)
55 map (gettext "(Type ? for further options)"))
57 "Keymap for characters following the Help key.")
59 ;; global-map definitions moved to keydefs.el
60 (fset 'help-command help-map)
62 (define-key help-map (vector help-char) 'help-for-help)
63 (define-key help-map "?" 'help-for-help)
64 (define-key help-map 'help 'help-for-help)
65 (define-key help-map '(f1) 'help-for-help)
67 (define-key help-map "\C-l" 'describe-copying) ; on \C-c in FSFmacs
68 (define-key help-map "\C-d" 'describe-distribution)
69 (define-key help-map "\C-w" 'describe-no-warranty)
70 (define-key help-map "a" 'hyper-apropos) ; 'command-apropos in FSFmacs
71 (define-key help-map "A" 'command-apropos)
73 (define-key help-map "b" 'describe-bindings)
74 (define-key help-map "B" 'describe-beta)
75 (define-key help-map "\C-p" 'describe-pointer)
77 (define-key help-map "C" 'customize)
78 (define-key help-map "c" 'describe-key-briefly)
79 (define-key help-map "k" 'describe-key)
81 (define-key help-map "d" 'describe-function)
82 (define-key help-map "e" 'describe-last-error)
83 (define-key help-map "f" 'describe-function)
85 (define-key help-map "F" 'xemacs-local-faq)
87 (define-key help-map "i" 'info)
88 (define-key help-map '(control i) 'Info-query)
89 ;; FSFmacs has Info-goto-emacs-command-node on C-f, no binding
91 (define-key help-map '(control c) 'Info-goto-emacs-command-node)
92 (define-key help-map '(control k) 'Info-goto-emacs-key-command-node)
93 (define-key help-map '(control f) 'Info-elisp-ref)
95 (define-key help-map "l" 'view-lossage)
97 (define-key help-map "m" 'describe-mode)
99 (define-key help-map "\C-n" 'view-emacs-news)
100 (define-key help-map "n" 'view-emacs-news)
102 (define-key help-map "p" 'finder-by-keyword)
104 ;; Do this right with an autoload cookie in finder.el.
105 ;;(autoload 'finder-by-keyword "finder"
106 ;; "Find packages matching a given keyword." t)
108 (define-key help-map "s" 'describe-syntax)
110 (define-key help-map "t" 'help-with-tutorial)
112 (define-key help-map "w" 'where-is)
114 (define-key help-map "v" 'describe-variable)
116 (if (fboundp 'view-last-error)
117 (define-key help-map "e" 'view-last-error))
120 (define-key help-map "q" 'help-quit)
122 ;#### This stuff was an attempt to have font locking and hyperlinks in the
123 ;help buffer, but it doesn't really work. Some of this stuff comes from
124 ;FSF Emacs; but the FSF Emacs implementation is rather broken, as usual.
125 ;What needs to happen is this:
127 ; -- we probably need a "hyperlink mode" from which help-mode is derived.
128 ; -- this means we probably need multiple inheritance of modes!
129 ; Thankfully this is not hard to implement; we already have the
130 ; ability for a keymap to have multiple parents. However, we'd
131 ; have to define any multiply-inherited-from modes using a standard
132 ; `define-mode' construction instead of manually doing it, because
133 ; we don't want each guy calling `kill-all-local-variables' and
134 ; messing up the previous one.
135 ; -- we need to scan the buffer ourselves (not from font-lock, because
136 ; the user might not have font-lock enabled) and highlight only
137 ; those words that are *documented* functions and variables (and
138 ; probably excluding words without dashes in them unless enclosed
139 ; in quotes, so that common words like "list" and "point" don't
141 ; -- we should *not* use font-lock keywords like below. Instead we
142 ; should add the font-lock stuff ourselves during the scanning phase,
143 ; if font-lock is enabled in this buffer.
145 ;(defun help-follow-reference (event extent user-data)
146 ; (let ((symbol (intern-soft (extent-string extent))))
147 ; (cond ((and symbol (fboundp symbol))
148 ; (describe-function symbol))
149 ; ((and symbol (boundp symbol))
150 ; (describe-variable symbol))
153 ;(defvar help-font-lock-keywords
154 ; (let ((name-char "[-+a-zA-Z0-9_*]") (sym-char "[-+a-zA-Z0-9_:*]"))
157 ; ;; The symbol itself.
158 ; (list (concat "\\`\\(" name-char "+\\)\\(:\\)?")
159 ; '(1 (if (match-beginning 2)
160 ; 'font-lock-function-name-face
161 ; 'font-lock-variable-name-face)
164 ; ;; Words inside `' which tend to be symbol names.
165 ; (list (concat "`\\(" sym-char sym-char "+\\)'")
167 ; 'font-lock-reference-face
168 ; (add-list-mode-item (match-beginning 1)
171 ; 'help-follow-reference))
174 ; ;; CLisp `:' keywords as references.
175 ; (list (concat "\\<:" sym-char "+\\>") 0 'font-lock-reference-face t)))
176 ; "Default expressions to highlight in Help mode.")
178 ;(put 'help-mode 'font-lock-defaults '(help-font-lock-keywords))
180 (define-derived-mode help-mode view-major-mode "Help"
181 "Major mode for viewing help text.
182 Entry to this mode runs the normal hook `help-mode-hook'.
187 (define-key help-mode-map "q" 'help-mode-quit)
188 (define-key help-mode-map "Q" 'help-mode-bury)
189 (define-key help-mode-map "f" 'find-function-at-point)
190 (define-key help-mode-map "d" 'describe-function-at-point)
191 (define-key help-mode-map "v" 'describe-variable-at-point)
192 (define-key help-mode-map "i" 'Info-elisp-ref)
193 (define-key help-mode-map "c" 'customize-variable)
194 (define-key help-mode-map [tab] 'help-next-symbol)
195 (define-key help-mode-map [(shift tab)] 'help-prev-symbol)
196 (define-key help-mode-map "n" 'help-next-section)
197 (define-key help-mode-map "p" 'help-prev-section)
199 (defun describe-function-at-point ()
200 "Describe directly the function at point in the other window."
202 (let ((symb (function-at-point)))
204 (describe-function symb))))
206 (defun describe-variable-at-point ()
207 "Describe directly the variable at point in the other window."
209 (let ((symb (variable-at-point)))
211 (describe-variable symb))))
213 (defun help-next-symbol ()
214 "Move point to the next quoted symbol."
216 (search-forward "`" nil t))
218 (defun help-prev-symbol ()
219 "Move point to the previous quoted symbol."
221 (search-backward "'" nil t))
223 (defun help-next-section ()
224 "Move point to the next quoted symbol."
226 (search-forward-regexp "^\\w+:" nil t))
228 (defun help-prev-section ()
229 "Move point to the previous quoted symbol."
231 (search-backward-regexp "^\\w+:" nil t))
233 (defun help-mode-bury ()
234 "Bury the help buffer, possibly restoring the previous window configuration."
238 (defun help-mode-quit (&optional bury)
239 "Exit from help mode, possibly restoring the previous window configuration.
240 If the optional argument BURY is non-nil, the help buffer is buried,
241 otherwise it is killed."
243 (let ((buf (current-buffer)))
244 (cond (help-window-config
245 (set-window-configuration help-window-config))
246 ((not (one-window-p))
256 ;; This is a grody hack of the same genotype as `advertised-undo'; if the
257 ;; bindings of Backspace and C-h are the same, we want the menubar to claim
258 ;; that `info' is invoked with `C-h i', not `BS i'.
260 (defun deprecated-help-command ()
262 (if (eq 'help-command (key-binding "\C-h"))
263 (setq unread-command-event (character-to-event ?\C-h))
266 ;;(define-key global-map 'backspace 'deprecated-help-command)
268 ;; help-with-tutorial moved to help-nomule.el and mule-help.el.
270 ;; used by describe-key, describe-key-briefly, insert-key-binding, etc.
271 (defun key-or-menu-binding (key &optional menu-flag)
272 "Return the command invoked by KEY.
273 Like `key-binding', but handles menu events and toolbar presses correctly.
274 KEY is any value returned by `next-command-event'.
275 MENU-FLAG is a symbol that should be set to t if KEY is a menu event,
278 (and menu-flag (set menu-flag nil))
279 ;; If the key typed was really a menu selection, grab the form out
280 ;; of the event object and intuit the function that would be called,
281 ;; and describe that instead.
282 (if (and (vectorp key) (= 1 (length key))
283 (or (misc-user-event-p (aref key 0))
284 (eq (car-safe (aref key 0)) 'menu-selection)))
285 (let ((event (aref key 0)))
286 (setq defn (if (eventp event)
287 (list (event-function event) (event-object event))
289 (and menu-flag (set menu-flag t))
290 (when (eq (car defn) 'eval)
291 (setq defn (car (cdr defn))))
292 (when (eq (car-safe defn) 'call-interactively)
293 (setq defn (car (cdr defn))))
294 (when (and (consp defn) (null (cdr defn)))
295 (setq defn (car defn))))
297 (setq defn (key-binding key)))
298 ;; kludge: if a toolbar button was pressed on, try to find the
299 ;; binding of the toolbar button.
300 (if (and (eq defn 'press-toolbar-button)
302 (button-press-event-p (aref key (1- (length key)))))
303 ;; wait for the button release. We're on shaky ground here ...
304 (let ((event (next-command-event))
306 (if (and (button-release-event-p event)
307 (event-over-toolbar-p event)
308 (eq 'release-and-activate-toolbar-button
309 (key-binding (vector event)))
310 (setq button (event-toolbar-button event)))
311 (toolbar-button-callback button)
312 ;; if anything went wrong, try returning the binding of
313 ;; the button-up event, of the original binding
314 (or (key-or-menu-binding (vector event))
320 (defun describe-key-briefly (key &optional insert)
321 "Print the name of the function KEY invokes. KEY is a string.
322 If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
323 (interactive "kDescribe key briefly: \nP")
324 (let ((standard-output (if insert (current-buffer) t))
326 (setq defn (key-or-menu-binding key 'menup))
327 (if (or (null defn) (integerp defn))
328 (princ (format "%s is undefined" (key-description key)))
329 ;; If it's a keyboard macro which trivially invokes another command,
330 ;; document that instead.
331 (if (or (stringp defn) (vectorp defn))
332 (setq defn (or (key-binding defn)
334 (let ((last-event (and (vectorp key)
335 (aref key (1- (length key))))))
336 (princ (format (cond (insert
338 ((or (button-press-event-p last-event)
339 (button-release-event-p last-event))
340 (gettext "%s at that spot runs the command %s"))
342 (gettext "%s runs the command %s")))
343 ;; This used to say 'This menu item' but it
344 ;; could also be a scrollbar event. We can't
345 ;; distinguish at the moment.
347 (if insert "item" "This item")
348 (key-description key))
349 (if (symbolp defn) defn (prin1-to-string defn))))))))
351 ;; #### this is a horrible piece of shit function that should
352 ;; not exist. In FSF 19.30 this function has gotten three times
353 ;; as long and has tons and tons of dumb shit checking
354 ;; special-display-buffer-names and such crap. I absolutely
355 ;; refuse to insert that Ebolification here. I wanted to delete
356 ;; this function entirely but Mly bitched.
358 ;; If your user-land code calls this function, rewrite it to
359 ;; call with-displaying-help-buffer.
361 (defun print-help-return-message (&optional function)
362 "Display or return message saying how to restore windows after help command.
363 Computes a message and applies the optional argument FUNCTION to it.
364 If FUNCTION is nil, applies `message' to it, thus printing it."
365 (and (not (get-buffer-window standard-output))
367 (or function 'message)
369 (substitute-command-keys
372 (gettext "Type \\[delete-other-windows] to remove help window.")
373 (gettext "Type \\[switch-to-buffer] RET to remove help window."))
374 (gettext "Type \\[switch-to-buffer-other-window] RET to restore the other window.")))
375 (substitute-command-keys
376 (gettext " \\[scroll-other-window] to scroll the help."))))))
378 (defcustom help-selects-help-window t
379 "*If nil, use the \"old Emacs\" behavior for Help buffers.
380 This just displays the buffer in another window, rather than selecting
383 :group 'help-appearance)
385 (defcustom help-max-help-buffers 10
386 "*Maximum help buffers to allow before they start getting killed.
387 If this is a positive integer, before a help buffer is displayed
388 by `with-displaying-help-buffer', any excess help buffers which
389 are not being displayed are first killed. Otherwise, if it is
390 zero or nil, only one help buffer, \"*Help*\" is ever used."
391 :type '(choice integer (const :tag "None" nil))
392 :group 'help-appearance)
394 (defvar help-buffer-list nil
395 "List of help buffers used by `help-register-and-maybe-prune-excess'")
397 (defun help-register-and-maybe-prune-excess (newbuf)
398 "Register use of a help buffer and possibly kill any excess ones."
399 ;; remove new buffer from list
400 (setq help-buffer-list (remove newbuf help-buffer-list))
401 ;; maybe kill excess help buffers
402 (if (and (integerp help-max-help-buffers)
403 (> (length help-buffer-list) help-max-help-buffers))
404 (let ((keep-list nil)
405 (num-kill (- (length help-buffer-list)
406 help-max-help-buffers)))
407 (while help-buffer-list
408 (let ((buf (car help-buffer-list)))
409 (if (and (or (equal buf newbuf) (get-buffer buf))
410 (string-match "^*Help" buf)
411 (save-excursion (set-buffer buf)
412 (eq major-mode 'help-mode)))
413 (if (and (>= num-kill (length help-buffer-list))
414 (not (get-buffer-window buf t t)))
416 (setq keep-list (cons buf keep-list)))))
417 (setq help-buffer-list (cdr help-buffer-list)))
418 (setq help-buffer-list (nreverse keep-list))))
420 (setq help-buffer-list (cons newbuf help-buffer-list)))
422 (defvar help-buffer-prefix-string "Help"
423 "Initial string to use in constructing help buffer names.
424 You should never set this directory, only let-bind it.")
426 (defun help-buffer-name (name)
427 "Return a name for a Help buffer using string NAME for context."
428 (if (and (integerp help-max-help-buffers)
429 (> help-max-help-buffers 0)
431 (if help-buffer-prefix-string
432 (format "*%s: %s*" help-buffer-prefix-string name)
433 (format "*%s*" name))
434 (format "*%s*" help-buffer-prefix-string)))
436 ;; Use this function for displaying help when C-h something is pressed
437 ;; or in similar situations. Do *not* use it when you are displaying
438 ;; a help message and then prompting for input in the minibuffer --
439 ;; this macro usually selects the help buffer, which is not what you
440 ;; want in those situations.
442 ;; #### Should really be a macro to eliminate the requirement of
443 ;; caller to code a lambda form in THUNK -- mrb
445 ;; #### BEFORE you rush to make this a macro, think about backward
446 ;; compatibility. The right way would be to create a macro with
447 ;; another name (which is a shame, because w-d-h-b is a perfect name
448 ;; for a macro) that uses with-displaying-help-buffer internally.
450 (defcustom mode-for-help 'help-mode
451 "*Mode that help buffers are put into.")
453 (defvar help-sticky-window nil
454 ;; Window into which help buffers will be displayed, rather than
455 ;; always searching for a new one. This is INTERNAL and liable to
456 ;; change its interface and/or name at any moment. It should be
460 (defvar help-window-config nil)
462 (make-variable-buffer-local 'help-window-config)
463 (put 'help-window-config 'permanent-local t)
465 (defun with-displaying-help-buffer (thunk &optional name)
466 "Form which makes a help buffer with given NAME and evaluates BODY there.
467 The actual name of the buffer is generated by the function `help-buffer-name'."
468 (let* ((winconfig (current-window-configuration))
469 (was-one-window (one-window-p))
470 (buffer-name (help-buffer-name name))
472 (not (and (windows-of-buffer buffer-name) ;shortcut
473 (memq (selected-frame)
474 (mapcar 'window-frame
475 (windows-of-buffer buffer-name)))))))
476 (help-register-and-maybe-prune-excess buffer-name)
477 ;; if help-sticky-window is bogus or deleted, get rid of it.
478 (if (and help-sticky-window (or (not (windowp help-sticky-window))
479 (not (window-live-p help-sticky-window))))
480 (setq help-sticky-window nil))
482 (let ((temp-buffer-show-function
483 (if help-sticky-window
485 (set-window-buffer help-sticky-window buffer))
486 temp-buffer-show-function)))
487 (with-output-to-temp-buffer buffer-name
488 (prog1 (funcall thunk)
490 (set-buffer standard-output)
491 (funcall mode-for-help)))))
492 (let ((helpwin (get-buffer-window buffer-name)))
494 ;; If the *Help* buffer is already displayed on this
495 ;; frame, don't override the previous configuration
496 (when help-not-visible
497 (with-current-buffer (window-buffer helpwin)
498 (setq help-window-config winconfig)))
499 (when help-selects-help-window
500 (select-window helpwin))
501 (cond ((eq helpwin (selected-window))
502 (display-message 'command
503 (substitute-command-keys "Type \\[help-mode-quit] to remove help window, \\[scroll-up] to scroll the help.")))
505 (display-message 'command
506 (substitute-command-keys "Type \\[delete-other-windows] to remove help window, \\[scroll-other-window] to scroll the help.")))
508 (display-message 'command
509 (substitute-command-keys "Type \\[switch-to-buffer-other-window] to restore the other window, \\[scroll-other-window] to scroll the help.")))))))))
511 (defun describe-key (key)
512 "Display documentation of the function invoked by KEY.
513 KEY is a string, or vector of events.
514 When called interactively, KEY may also be a menu selection."
515 (interactive "kDescribe key: ")
516 (let ((defn (key-or-menu-binding key))
517 (key-string (key-description key)))
518 (if (or (null defn) (integerp defn))
519 (message "%s is undefined" key-string)
520 (with-displaying-help-buffer
525 (princ (format "`%s'" defn))
528 (cond ((or (stringp defn) (vectorp defn))
529 (let ((cmd (key-binding defn)))
531 (princ "a keyboard macro")
533 (princ "a keyboard macro which runs the command ")
536 (if (documentation cmd) (princ (documentation cmd)))))))
537 ((and (consp defn) (not (eq 'lambda (car-safe defn))))
538 (let ((describe-function-show-arglist nil))
539 (describe-function-1 (car defn))))
541 (describe-function-1 defn))
542 ((documentation defn)
543 (princ (documentation defn)))
545 (princ "not documented"))))
546 (format "key `%s'" key-string)))))
548 (defun describe-mode ()
549 "Display documentation of current major mode and minor modes.
550 For this to work correctly for a minor mode, the mode's indicator variable
551 \(listed in `minor-mode-alist') must also be a function whose documentation
552 describes the minor mode."
554 (with-displaying-help-buffer
556 ;; XEmacs change: print the major-mode documentation before
560 (princ (documentation major-mode))
561 (princ "\n\n----\n\n")
562 (let ((minor-modes minor-mode-alist))
564 (let* ((minor-mode (car (car minor-modes)))
565 (indicator (car (cdr (car minor-modes)))))
566 ;; Document a minor mode if it is listed in minor-mode-alist,
567 ;; bound locally in this buffer, non-nil, and has a function
569 (if (and (boundp minor-mode)
570 (symbol-value minor-mode)
571 (fboundp minor-mode))
572 (let ((pretty-minor-mode minor-mode))
573 (if (string-match "-mode\\'" (symbol-name minor-mode))
574 (setq pretty-minor-mode
576 (substring (symbol-name minor-mode)
577 0 (match-beginning 0)))))
578 (while (and (consp indicator) (extentp (car indicator)))
579 (setq indicator (cdr indicator)))
580 (while (and indicator (symbolp indicator))
581 (setq indicator (symbol-value indicator)))
582 (princ (format "%s minor mode (indicator%s):\n"
583 pretty-minor-mode indicator))
584 (princ (documentation minor-mode))
585 (princ "\n\n----\n\n"))))
586 (setq minor-modes (cdr minor-modes)))))
587 (format "%s mode" mode-name)))
589 ;; So keyboard macro definitions are documented correctly
590 (fset 'defining-kbd-macro (symbol-function 'start-kbd-macro))
592 ;; view a read-only file intelligently
593 (defun Help-find-file (file)
594 (if (fboundp 'view-file)
596 (find-file-read-only file)
597 (goto-char (point-min))))
599 (defun describe-distribution ()
600 "Display info on how to obtain the latest version of XEmacs."
602 (Help-find-file (locate-data-file "DISTRIB")))
604 (defun describe-beta ()
605 "Display info on how to deal with Beta versions of XEmacs."
607 (Help-find-file (locate-data-file "BETA")))
609 (defun describe-copying ()
610 "Display info on how you may redistribute copies of XEmacs."
612 (Help-find-file (locate-data-file "COPYING")))
614 (defun describe-pointer ()
615 "Show a list of all defined mouse buttons, and their definitions."
617 (describe-bindings nil t))
619 (defun describe-project ()
620 "Display info on the GNU project."
622 (Help-find-file (locate-data-file "GNU")))
624 (defun describe-no-warranty ()
625 "Display info on all the kinds of warranty XEmacs does NOT have."
628 (let (case-fold-search)
629 (search-forward "NO WARRANTY")
632 (defun describe-bindings (&optional prefix mouse-only-p)
633 "Show a list of all defined keys, and their definitions.
634 The list is put in a buffer, which is displayed.
635 If optional first argument PREFIX is supplied, only commands
636 which start with that sequence of keys are described.
637 If optional second argument MOUSE-ONLY-P (prefix arg, interactively)
638 is non-nil then only the mouse bindings are displayed."
639 (interactive (list nil current-prefix-arg))
640 (with-displaying-help-buffer
642 (describe-bindings-1 prefix mouse-only-p))
643 (format "bindings for %s" major-mode)))
645 (defun describe-bindings-1 (&optional prefix mouse-only-p)
646 (let ((heading (if mouse-only-p
647 (gettext "button binding\n------ -------\n")
648 (gettext "key binding\n--- -------\n")))
649 (buffer (current-buffer))
650 (minor minor-mode-map-alist)
651 (extent-maps (mapcar-extents
653 nil (current-buffer) (point) (point) nil 'keymap))
654 (local (current-local-map))
656 (set-buffer standard-output)
658 (insert "Bindings for Text Region:\n"
660 (describe-bindings-internal
661 (car extent-maps) nil shadow prefix mouse-only-p)
663 (setq shadow (cons (car extent-maps) shadow)
664 extent-maps (cdr extent-maps)))
666 (let ((sym (car (car minor)))
667 (map (cdr (car minor))))
668 (if (symbol-value-in-buffer sym buffer nil)
670 (insert (format "Minor Mode Bindings for `%s':\n"
673 (describe-bindings-internal map nil shadow prefix mouse-only-p)
675 (setq shadow (cons map shadow))))
676 (setq minor (cdr minor))))
679 (insert "Local Bindings:\n" heading)
680 (describe-bindings-internal local nil shadow prefix mouse-only-p)
682 (setq shadow (cons local shadow))))
683 (insert "Global Bindings:\n" heading)
684 (describe-bindings-internal (current-global-map)
685 nil shadow prefix mouse-only-p)
686 (when (and prefix function-key-map (not mouse-only-p))
687 (insert "\nFunction key map translations:\n" heading)
688 (describe-bindings-internal function-key-map nil nil
689 prefix mouse-only-p))
693 (defun describe-prefix-bindings ()
694 "Describe the bindings of the prefix used to reach this command.
695 The prefix described consists of all but the last event
696 of the key sequence that ran this command."
698 (let* ((key (this-command-keys))
699 (prefix (make-vector (1- (length key)) nil))
702 (while (< i (length prefix))
703 (aset prefix i (aref key i))
705 (with-displaying-help-buffer
707 (princ "Key bindings starting with ")
708 (princ (key-description prefix))
710 (describe-bindings-1 prefix nil))
711 (format "%s prefix" (key-description prefix)))))
713 ;; Make C-h after a prefix, when not specifically bound,
714 ;; run describe-prefix-bindings.
715 (setq prefix-help-command 'describe-prefix-bindings)
717 (defun describe-installation ()
718 "Display a buffer showing information about this XEmacs was compiled."
720 (if (and (boundp 'Installation-string)
721 (stringp Installation-string))
722 (with-displaying-help-buffer
725 (if (fboundp 'decode-coding-string)
726 (decode-coding-string Installation-string 'automatic-conversion)
727 Installation-string)))
729 (error "No Installation information available.")))
731 (defun view-emacs-news ()
732 "Display info on recent changes to XEmacs."
734 (Help-find-file (locate-data-file "NEWS")))
736 (defun xemacs-www-page ()
737 "Go to the XEmacs World Wide Web page."
739 (if (fboundp 'browse-url)
740 (browse-url "http://www.xemacs.org/")
741 (error "xemacs-www-page requires browse-url")))
743 (defun xemacs-www-faq ()
744 "View the latest and greatest XEmacs FAQ using the World Wide Web."
746 (if (fboundp 'browse-url)
747 (browse-url "http://www.xemacs.org/faq/index.html")
748 (error "xemacs-www-faq requires browse-url")))
750 (defun xemacs-local-faq ()
751 "View the local copy of the XEmacs FAQ.
752 If you have access to the World Wide Web, you should use `xemacs-www-faq'
753 instead, to ensure that you get the most up-to-date information."
755 (save-window-excursion
757 (Info-find-node "xemacs-faq" "Top"))
758 (switch-to-buffer "*info*"))
760 (defun view-sample-init-el ()
761 "Display the sample init.el file."
763 (Help-find-file (locate-data-file "sample.init.el")))
765 (defcustom view-lossage-key-count 100
766 "*Number of keys `view-lossage' shows.
767 The maximum number of available keys is governed by `recent-keys-ring-size'."
771 (defcustom view-lossage-message-count 100
772 "*Number of minibuffer messages `view-lossage' shows."
776 (defun print-recent-messages (n)
777 "Print N most recent messages to standard-output, most recent first.
778 If N is nil, all messages will be printed."
780 (let ((buffer (get-buffer-create " *Message-Log*"))
782 (goto-char (point-max buffer) buffer)
783 (set-buffer standard-output)
784 (while (and (not (bobp buffer))
785 (or (null n) (>= (decf n) 0)))
786 (setq oldpoint (point buffer))
787 (setq extent (extent-at oldpoint buffer
788 'message-multiline nil 'before))
789 ;; If the message was multiline, move all the way to the
792 (goto-char (extent-start-position extent) buffer)
793 (forward-line -1 buffer))
794 (insert-buffer-substring buffer (point buffer) oldpoint)))))
796 (defun view-lossage ()
797 "Display recent input keystrokes and recent minibuffer messages.
798 The number of keys shown is controlled by `view-lossage-key-count'.
799 The number of messages shown is controlled by `view-lossage-message-count'."
801 (with-displaying-help-buffer
803 (princ (key-description (recent-keys view-lossage-key-count)))
805 (set-buffer standard-output)
806 (goto-char (point-min))
807 (insert "Recent keystrokes:\n\n")
808 (while (progn (move-to-column 50) (not (eobp)))
809 (search-forward " " nil t)
811 ;; XEmacs addition: copy the messages from " *Message-Log*",
812 ;; reversing their order and handling multiline messages
814 (princ "\n\n\nRecent minibuffer messages (most recent first):\n\n")
815 (print-recent-messages view-lossage-message-count))
818 (define-function 'help 'help-for-help)
820 (make-help-screen help-for-help
821 "A B C F I K L M N P S T V W C-c C-d C-f C-i C-k C-n C-w; ? for more help:"
823 \(Use SPC or DEL to scroll through this text. Type \\<help-map>\\[help-quit] to exit the Help command.)
825 \\[hyper-apropos] Type a substring; it shows a hypertext list of
826 functions and variables that contain that substring.
827 See also the `apropos' command.
828 \\[command-apropos] Type a substring; it shows a list of commands
829 (interactively callable functions) that contain that substring.
830 \\[describe-bindings] Table of all key bindings.
831 \\[describe-key-briefly] Type a command key sequence;
832 it displays the function name that sequence runs.
833 \\[customize] Customize Emacs options.
834 \\[Info-goto-emacs-command-node] Type a function name; it displays the Info node for that command.
835 \\[describe-function] Type a function name; it shows its documentation.
836 \\[Info-elisp-ref] Type a function name; it jumps to the full documentation
837 in the XEmacs Lisp Programmer's Manual.
838 \\[xemacs-local-faq] Local copy of the XEmacs FAQ.
839 \\[info] Info documentation reader.
840 \\[Info-query] Type an Info file name; it displays it in Info reader.
841 \\[describe-key] Type a command key sequence;
842 it displays the documentation for the command bound to that key.
843 \\[Info-goto-emacs-key-command-node] Type a command key sequence;
844 it displays the Info node for the command bound to that key.
845 \\[view-lossage] Recent input keystrokes and minibuffer messages.
846 \\[describe-mode] Documentation of current major and minor modes.
847 \\[view-emacs-news] News of recent XEmacs changes.
848 \\[finder-by-keyword] Type a topic keyword; it finds matching packages.
849 \\[describe-pointer] Table of all mouse-button bindings.
850 \\[describe-syntax] Contents of syntax table with explanations.
851 \\[help-with-tutorial] XEmacs learn-by-doing tutorial.
852 \\[describe-variable] Type a variable name; it displays its documentation and value.
853 \\[where-is] Type a command name; it displays which keystrokes invoke that command.
854 \\[describe-distribution] XEmacs ordering information.
855 \\[describe-no-warranty] Information on absence of warranty for XEmacs.
856 \\[describe-copying] XEmacs copying permission (General Public License)."
859 (defmacro with-syntax-table (syntab &rest body)
860 "Evaluate BODY with the SYNTAB as the current syntax table."
861 `(let ((stab (syntax-table)))
864 (set-syntax-table (copy-syntax-table ,syntab))
866 (set-syntax-table stab))))
867 (put 'with-syntax-table 'lisp-indent-function 1)
868 (put 'with-syntax-table 'edebug-form-spec '(form body))
870 (defun function-called-at-point ()
871 "Return the function which is called by the list containing point.
872 If that gives no function, return the function whose name is around point.
873 If that doesn't give a function, return nil."
877 (narrow-to-region (max (point-min) (- (point) 1000))
882 (setq obj (read (current-buffer)))
883 (and (symbolp obj) (fboundp obj) obj)))))
885 (with-syntax-table emacs-lisp-mode-syntax-table
887 (or (not (zerop (skip-syntax-backward "_w")))
888 (eq (char-syntax (char-after (point))) ?w)
889 (eq (char-syntax (char-after (point))) ?_)
891 (skip-chars-forward "`'")
892 (let ((obj (read (current-buffer))))
893 (and (symbolp obj) (fboundp obj) obj)))))))
895 (defun function-at-point ()
896 "Return the function whose name is around point.
897 If that gives no function, return the function which is called by the
898 list containing point. If that doesn't give a function, return nil."
900 (with-syntax-table emacs-lisp-mode-syntax-table
902 (or (not (zerop (skip-syntax-backward "_w")))
903 (eq (char-syntax (char-after (point))) ?w)
904 (eq (char-syntax (char-after (point))) ?_)
906 (skip-chars-forward "`'")
907 (let ((obj (read (current-buffer))))
908 (and (symbolp obj) (fboundp obj) obj)))))
912 (narrow-to-region (max (point-min) (- (point) 1000))
917 (setq obj (read (current-buffer)))
918 (and (symbolp obj) (fboundp obj) obj)))))))
920 (defun function-at-event (event)
921 "Return the function whose name is around the position of EVENT.
922 EVENT should be a mouse event. When calling from a popup or context menu,
923 use `last-popup-menu-event' to find out where the mouse was clicked.
924 \(You cannot use (interactive \"e\"), unfortunately. This returns a
927 If the event contains no position, or the position is not over text, or
928 there is no function around that point, nil is returned."
929 (if (and event (event-buffer event) (event-point event))
931 (set-buffer (event-buffer event))
932 (goto-char (event-point event))
933 (function-at-point))))
935 ;; Default to nil for the non-hackers? Not until we find a way to
936 ;; distinguish hackers from non-hackers automatically!
937 (defcustom describe-function-show-arglist t
938 "*If non-nil, describe-function will show its arglist,
939 unless the function is autoloaded."
941 :group 'help-appearance)
943 (defun describe-symbol-find-file (symbol)
944 (loop for (file . load-data) in load-history
945 do (when (memq symbol load-data)
948 (define-obsolete-function-alias
949 'describe-function-find-file
950 'describe-symbol-find-file)
952 (defun describe-function (function)
953 "Display the full documentation of FUNCTION (a symbol).
954 When run interactively, it defaults to any function found by
955 `function-at-point'."
957 (let* ((fn (function-at-point))
958 (val (let ((enable-recursive-minibuffers t))
961 (format (gettext "Describe function (default %s): ")
963 (gettext "Describe function: "))
964 obarray 'fboundp t nil 'function-history
966 (list (intern val))))
967 (with-displaying-help-buffer
969 (describe-function-1 function)
970 ;; Return the text we displayed.
971 (buffer-string nil nil standard-output))
972 (format "function `%s'" function)))
974 (defun function-obsolete-p (function)
975 "Return non-nil if FUNCTION is obsolete."
976 (not (null (get function 'byte-obsolete-info))))
978 (defun function-obsoleteness-doc (function)
979 "If FUNCTION is obsolete, return a string describing this."
980 (let ((obsolete (get function 'byte-obsolete-info)))
982 (format "Obsolete; %s"
983 (if (stringp (car obsolete))
985 (format "use `%s' instead." (car obsolete)))))))
987 (defun function-compatible-p (function)
988 "Return non-nil if FUNCTION is present for Emacs compatibility."
989 (not (null (get function 'byte-compatible-info))))
991 (defun function-compatibility-doc (function)
992 "If FUNCTION is Emacs compatible, return a string describing this."
993 (let ((compatible (get function 'byte-compatible-info)))
995 (format "Emacs Compatible; %s"
996 (if (stringp (car compatible))
998 (format "use `%s' instead." (car compatible)))))))
1000 ;Here are all the possibilities below spelled out, for the benefit
1001 ;of the I18N3 snarfer.
1003 ;(gettext "a built-in function")
1004 ;(gettext "an interactive built-in function")
1005 ;(gettext "a built-in macro")
1006 ;(gettext "an interactive built-in macro")
1007 ;(gettext "a compiled Lisp function")
1008 ;(gettext "an interactive compiled Lisp function")
1009 ;(gettext "a compiled Lisp macro")
1010 ;(gettext "an interactive compiled Lisp macro")
1011 ;(gettext "a Lisp function")
1012 ;(gettext "an interactive Lisp function")
1013 ;(gettext "a Lisp macro")
1014 ;(gettext "an interactive Lisp macro")
1015 ;(gettext "a mocklisp function")
1016 ;(gettext "an interactive mocklisp function")
1017 ;(gettext "a mocklisp macro")
1018 ;(gettext "an interactive mocklisp macro")
1019 ;(gettext "an autoloaded Lisp function")
1020 ;(gettext "an interactive autoloaded Lisp function")
1021 ;(gettext "an autoloaded Lisp macro")
1022 ;(gettext "an interactive autoloaded Lisp macro")
1024 ;; taken out of `describe-function-1'
1025 (defun function-arglist (function)
1026 "Return a string giving the argument list of FUNCTION.
1029 (function-arglist 'function-arglist)
1030 => (function-arglist FUNCTION)
1032 This function is used by `describe-function-1' to list function
1033 arguments in the standard Lisp style."
1034 (let* ((fnc (indirect-function function))
1035 (fndef (if (eq (car-safe fnc) 'macro)
1039 (cond ((compiled-function-p fndef)
1040 (compiled-function-arglist fndef))
1041 ((eq (car-safe fndef) 'lambda)
1044 (let* ((doc (documentation function))
1045 (args (and (string-match
1046 "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'"
1048 (match-string 1 doc))))
1049 ;; If there are no arguments documented for the
1050 ;; subr, rather don't print anything.
1051 (cond ((null args) t)
1052 ((equal args "") nil)
1055 (cond ((listp arglist)
1057 (cons function (mapcar (lambda (arg)
1058 (if (memq arg '(&optional &rest))
1060 (intern (upcase (symbol-name arg)))))
1064 (format "(%s %s)" function arglist)))))
1066 (defun function-documentation (function &optional strip-arglist)
1067 "Return a string giving the documentation for FUNCTION, if any.
1068 If the optional argument STRIP-ARGLIST is non-nil, remove the arglist
1069 part of the documentation of internal subroutines."
1070 (let ((doc (condition-case nil
1071 (or (documentation function)
1072 (gettext "not documented"))
1073 (void-function ""))))
1074 (if (and strip-arglist
1075 (string-match "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'" doc))
1076 (setq doc (substring doc 0 (match-beginning 0))))
1079 ;; replacement for `princ' that puts the text in the specified face,
1081 (defun Help-princ-face (object face)
1082 (cond ((bufferp standard-output)
1083 (let ((opoint (point standard-output)))
1085 (put-nonduplicable-text-property opoint (point standard-output)
1086 'face face standard-output)))
1087 ((markerp standard-output)
1088 (let ((buf (marker-buffer standard-output))
1089 (pos (marker-position standard-output)))
1091 (put-nonduplicable-text-property
1092 pos (marker-position standard-output) 'face face buf)))
1095 ;; replacement for `prin1' that puts the text in the specified face,
1097 (defun Help-prin1-face (object face)
1098 (cond ((bufferp standard-output)
1099 (let ((opoint (point standard-output)))
1101 (put-nonduplicable-text-property opoint (point standard-output)
1102 'face face standard-output)))
1103 ((markerp standard-output)
1104 (let ((buf (marker-buffer standard-output))
1105 (pos (marker-position standard-output)))
1107 (put-nonduplicable-text-property
1108 pos (marker-position standard-output) 'face face buf)))
1111 (defvar help-symbol-regexp
1112 (let ((sym-char "[+a-zA-Z0-9_:*]")
1113 (sym-char-no-dash "[-+a-zA-Z0-9_:*]"))
1115 ;; a symbol with a - in it.
1116 "\\<\\(" sym-char-no-dash "+\\(-" sym-char-no-dash "+\\)+\\)\\>"
1118 "`\\(" sym-char "+\\)'"
1121 (defun help-symbol-run-function-1 (ev ex fun)
1122 (let ((help-sticky-window
1123 ;; if we were called from a help buffer, make sure the new help
1124 ;; goes in the same window.
1125 (if (and (event-buffer ev)
1126 (symbol-value-in-buffer 'help-window-config
1129 help-sticky-window)))
1130 (funcall fun (extent-property ex 'help-symbol))))
1132 (defun help-symbol-run-function (fun)
1133 (let ((ex (extent-at-event last-popup-menu-event 'help-symbol)))
1135 (help-symbol-run-function-1 last-popup-menu-event ex fun))))
1137 (defvar help-symbol-function-context-menu
1138 '(["View %_Documentation" (help-symbol-run-function 'describe-function)]
1139 ["Find %_Function Source" (help-symbol-run-function 'find-function)]
1140 ["Find %_Tag" (help-symbol-run-function 'find-tag)]
1143 (defvar help-symbol-variable-context-menu
1144 '(["View %_Documentation" (help-symbol-run-function 'describe-variable)]
1145 ["Find %_Variable Source" (help-symbol-run-function 'find-variable)]
1146 ["Find %_Tag" (help-symbol-run-function 'find-tag)]
1149 (defvar help-symbol-function-and-variable-context-menu
1150 '(["View Function %_Documentation" (help-symbol-run-function
1151 'describe-function)]
1152 ["View Variable D%_ocumentation" (help-symbol-run-function
1153 'describe-variable)]
1154 ["Find %_Function Source" (help-symbol-run-function 'find-function)]
1155 ["Find %_Variable Source" (help-symbol-run-function 'find-variable)]
1156 ["Find %_Tag" (help-symbol-run-function 'find-tag)]
1159 (defun frob-help-extents (buffer)
1160 ;; Look through BUFFER, starting at the buffer's point and continuing
1161 ;; till end of file, and find documented functions and variables.
1162 ;; any such symbol found is tagged with an extent, that sets up these
1164 ;; 1. mouse-face is 'highlight (so the extent gets highlighted on mouse over)
1165 ;; 2. help-symbol is the name of the symbol.
1166 ;; 3. face is 'hyper-apropos-hyperlink.
1167 ;; 4. context-menu is a list of context menu items, specific to whether
1168 ;; the symbol is a function, variable, or both.
1169 ;; 5. activate-function will cause the function or variable to be described,
1170 ;; replacing the existing help contents.
1174 (while (re-search-forward help-symbol-regexp nil t)
1175 (setq b (or (match-beginning 2) (match-beginning 4)))
1176 (setq e (or (match-end 2) (match-end 4)))
1177 (setq name (buffer-substring b e))
1178 (let* ((sym (intern-soft name))
1179 (var (and sym (boundp sym)
1180 (documentation-property sym
1181 'variable-documentation t)))
1182 (fun (and sym (fboundp sym)
1183 (documentation sym t))))
1185 (let ((ex (make-extent b e)))
1186 (set-extent-property ex 'mouse-face 'highlight)
1187 (set-extent-property ex 'help-symbol sym)
1188 (set-extent-property ex 'face 'hyper-apropos-hyperlink)
1189 (set-extent-property
1191 (cond ((and var fun)
1192 help-symbol-function-and-variable-context-menu)
1193 (var help-symbol-variable-context-menu)
1194 (fun help-symbol-function-context-menu)))
1195 (set-extent-property
1196 ex 'activate-function
1199 (help-symbol-run-function-1 ev ex 'describe-function))
1201 (help-symbol-run-function-1 ev ex 'describe-variable))))
1202 ))))))) ;; 11 parentheses!
1204 (defun describe-function-1 (function &optional nodoc)
1205 "This function does the work for `describe-function'."
1207 ;; (Help-princ-face function 'font-lock-function-name-face) overkill
1210 (let* ((def function)
1211 aliases file-name autoload-file kbd-macro-p fndef macrop)
1212 (while (and (symbolp def) (fboundp def))
1213 (when (not (eq def function))
1216 ;; I18N3 Need gettext due to concat
1219 "\n which is an alias for `%s', "
1221 (format "an alias for `%s', " (symbol-name def)))))
1222 (setq def (symbol-function def)))
1223 (if (and (fboundp 'compiled-function-annotation)
1224 (compiled-function-p def))
1225 (setq file-name (compiled-function-annotation def)))
1226 (if (eq 'macro (car-safe def))
1227 (setq fndef (cdr def)
1228 file-name (and (compiled-function-p (cdr def))
1229 (fboundp 'compiled-function-annotation)
1230 (compiled-function-annotation (cdr def)))
1233 (if aliases (princ aliases))
1234 (let ((int #'(lambda (string an-p macro-p)
1237 (cond ((commandp def)
1242 (if macro-p " macro" " function")))
1244 (cond ((or (stringp def) (vectorp def))
1245 (princ "a keyboard macro.")
1246 (setq kbd-macro-p t))
1248 (funcall int "built-in" nil macrop))
1249 ((compiled-function-p fndef)
1250 (funcall int "compiled Lisp" nil macrop))
1251 ((eq (car-safe fndef) 'lambda)
1252 (funcall int "Lisp" nil macrop))
1253 ((eq (car-safe fndef) 'mocklisp)
1254 (funcall int "mocklisp" nil macrop))
1255 ((eq (car-safe def) 'autoload)
1256 (setq autoload-file (elt def 1))
1257 (funcall int "autoloaded Lisp" t (elt def 4)))
1258 ((and (symbolp def) (not (fboundp def)))
1259 (princ "a symbol with a void (unbound) function definition."))
1264 (princ (format " -- autoloads from \"%s\"\n" autoload-file)))
1266 (setq file-name (describe-symbol-find-file function)))
1268 (princ (format " -- loaded from \"%s\"\n" file-name)))
1270 (if describe-function-show-arglist
1271 (let ((arglist (function-arglist function)))
1273 (require 'hyper-apropos)
1274 (Help-princ-face arglist 'hyper-apropos-documentation)
1278 (princ "These characters are executed:\n\n\t")
1279 (princ (key-description def))
1280 (cond ((setq def (key-binding def))
1281 (princ (format "\n\nwhich executes the command `%s'.\n\n"
1283 (describe-function-1 def))))
1286 ;; tell the user about obsoleteness.
1287 ;; If the function is obsolete and is aliased, don't
1288 ;; even bother to report the documentation, as a further
1289 ;; encouragement to use the new function.
1290 (let ((obsolete (function-obsoleteness-doc function))
1291 (compatible (function-compatibility-doc function)))
1300 (unless (and obsolete aliases)
1301 (let ((doc (function-documentation function t)))
1302 (princ "Documentation:\n")
1303 (let ((oldp (point standard-output))
1306 (setq newp (point standard-output))
1307 (goto-char oldp standard-output)
1308 (frob-help-extents standard-output)
1309 (goto-char newp standard-output))
1310 (unless (or (equal doc "")
1311 (eq ?\n (aref doc (1- (length doc)))))
1315 ;;; [Obnoxious, whining people who complain very LOUDLY on Usenet
1316 ;;; are binding this to keys.]
1317 (defun describe-function-arglist (function)
1318 (interactive (list (or (function-at-point)
1319 (error "no function call at point"))))
1321 (message (function-arglist function)))
1323 (defun variable-at-point ()
1325 (with-syntax-table emacs-lisp-mode-syntax-table
1327 (or (not (zerop (skip-syntax-backward "_w")))
1328 (eq (char-syntax (char-after (point))) ?w)
1329 (eq (char-syntax (char-after (point))) ?_)
1331 (skip-chars-forward "'")
1332 (let ((obj (read (current-buffer))))
1333 (and (symbolp obj) (boundp obj) obj))))))
1335 (defun variable-at-event (event)
1336 "Return the variable whose name is around the position of EVENT.
1337 EVENT should be a mouse event. When calling from a popup or context menu,
1338 use `last-popup-menu-event' to find out where the mouse was clicked.
1339 \(You cannot use (interactive \"e\"), unfortunately. This returns a
1342 If the event contains no position, or the position is not over text, or
1343 there is no variable around that point, nil is returned."
1344 (if (and event (event-buffer event) (event-point event))
1346 (set-buffer (event-buffer event))
1347 (goto-char (event-point event))
1348 (variable-at-point))))
1350 (defun variable-obsolete-p (variable)
1351 "Return non-nil if VARIABLE is obsolete."
1352 (not (null (get variable 'byte-obsolete-variable))))
1354 (defun variable-obsoleteness-doc (variable)
1355 "If VARIABLE is obsolete, return a string describing this."
1356 (let ((obsolete (get variable 'byte-obsolete-variable)))
1358 (format "Obsolete; %s"
1359 (if (stringp obsolete)
1361 (format "use `%s' instead." obsolete))))))
1363 (defun variable-compatible-p (variable)
1364 "Return non-nil if VARIABLE is Emacs compatible."
1365 (not (null (get variable 'byte-compatible-variable))))
1367 (defun variable-compatibility-doc (variable)
1368 "If VARIABLE is Emacs compatible, return a string describing this."
1369 (let ((compatible (get variable 'byte-compatible-variable)))
1371 (format "Emacs Compatible; %s"
1372 (if (stringp compatible)
1374 (format "use `%s' instead." compatible))))))
1376 (defun built-in-variable-doc (variable)
1377 "Return a string describing whether VARIABLE is built-in."
1378 (let ((type (built-in-variable-type variable)))
1380 (integer "a built-in integer variable")
1381 (const-integer "a built-in constant integer variable")
1382 (boolean "a built-in boolean variable")
1383 (const-boolean "a built-in constant boolean variable")
1384 (object "a simple built-in variable")
1385 (const-object "a simple built-in constant variable")
1386 (const-specifier "a built-in constant specifier variable")
1387 (current-buffer "a built-in buffer-local variable")
1388 (const-current-buffer "a built-in constant buffer-local variable")
1389 (default-buffer "a built-in default buffer-local variable")
1390 (selected-console "a built-in console-local variable")
1391 (const-selected-console "a built-in constant console-local variable")
1392 (default-console "a built-in default console-local variable")
1394 (if type "an unknown type of built-in variable?"
1395 "a variable declared in Lisp")))))
1397 (defun describe-variable (variable)
1398 "Display the full documentation of VARIABLE (a symbol)."
1400 (let* ((v (variable-at-point))
1401 (val (let ((enable-recursive-minibuffers t))
1404 (format "Describe variable (default %s): " v)
1405 (gettext "Describe variable: "))
1406 obarray 'boundp t nil 'variable-history
1408 (list (intern val))))
1409 (with-displaying-help-buffer
1411 (let ((origvar variable)
1413 (let ((print-escape-newlines t))
1415 ;; (Help-princ-face (symbol-name variable)
1416 ;; 'font-lock-variable-name-face) overkill
1417 (princ (symbol-name variable))
1419 (while (variable-alias variable)
1420 (let ((newvar (variable-alias variable)))
1422 ;; I18N3 Need gettext due to concat
1425 (format "\n which is an alias for `%s',"
1426 (symbol-name newvar))))
1428 (format "an alias for `%s',"
1429 (symbol-name newvar))))
1430 (setq variable newvar)))
1432 (princ (format "%s" aliases)))
1433 (princ (built-in-variable-doc variable))
1435 (let ((file-name (describe-symbol-find-file variable)))
1437 (princ (format " -- loaded from \"%s\"\n" file-name))))
1439 (require 'hyper-apropos)
1440 (if (not (boundp variable))
1441 (Help-princ-face "void\n" 'hyper-apropos-documentation)
1442 (Help-prin1-face (symbol-value variable)
1443 'hyper-apropos-documentation)
1446 (cond ((local-variable-p variable (current-buffer))
1447 (let* ((void (cons nil nil))
1448 (def (condition-case nil
1449 (default-value variable)
1451 (princ "This value is specific to the current buffer.\n")
1452 (if (local-variable-p variable nil)
1453 (princ "(Its value is local to each buffer.)\n"))
1455 (if (if (eq def void)
1457 (not (eq (symbol-value variable) def)))
1458 ;; #### I18N3 doesn't localize properly!
1459 (progn (princ "Default-value: ")
1465 ((local-variable-p variable (current-buffer) t)
1466 (princ "Setting it would make its value buffer-local.\n\n"))))
1467 (princ "Documentation:")
1469 (let ((doc (documentation-property variable 'variable-documentation))
1470 (obsolete (variable-obsoleteness-doc origvar))
1471 (compatible (variable-compatibility-doc origvar)))
1480 ;; don't bother to print anything if variable is obsolete and aliased.
1481 (when (or (not obsolete) (not aliases))
1483 ;; note: documentation-property calls substitute-command-keys.
1484 (let ((oldp (point standard-output))
1487 (setq newp (point standard-output))
1488 (goto-char oldp standard-output)
1489 (frob-help-extents standard-output)
1490 (goto-char newp standard-output))
1491 (princ "not documented as a variable."))))
1493 (format "variable `%s'" variable)))
1495 (defun sorted-key-descriptions (keys &optional separator)
1496 "Sort and separate the key descriptions for KEYS.
1497 The sorting is done by length (shortest bindings first), and the bindings
1498 are separated with SEPARATOR (\", \" by default)."
1499 (mapconcat 'key-description
1500 (sort keys #'(lambda (x y)
1501 (< (length x) (length y))))
1502 (or separator ", ")))
1504 (defun where-is (definition &optional insert)
1505 "Print message listing key sequences that invoke specified command.
1506 Argument is a command definition, usually a symbol with a function definition.
1507 When run interactively, it defaults to any function found by
1508 `function-at-point'.
1509 If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
1511 (let ((fn (function-at-point))
1512 (enable-recursive-minibuffers t)
1514 (setq val (read-command
1515 (if fn (format "Where is command (default %s): " fn)
1516 "Where is command: ")
1517 (and fn (symbol-name fn))))
1518 (list (if (equal (symbol-name val) "")
1520 current-prefix-arg)))
1521 (let ((keys (where-is-internal definition)))
1524 (princ (format "%s (%s)" (sorted-key-descriptions keys)
1525 definition) (current-buffer))
1526 (message "%s is on %s" definition (sorted-key-descriptions keys)))
1528 (princ (format (if (commandp definition) "M-x %s RET"
1529 "M-: (%s ...)") definition) (current-buffer))
1530 (message "%s is not on any keys" definition))))
1533 ;; `locate-library' moved to "packages.el"
1536 ;; Functions ported from C into Lisp in XEmacs
1538 (defun describe-syntax ()
1539 "Describe the syntax specifications in the syntax table.
1540 The descriptions are inserted in a buffer, which is then displayed."
1542 (with-displaying-help-buffer
1544 ;; defined in syntax.el
1545 (describe-syntax-table (syntax-table) standard-output))
1546 (format "syntax-table for %s" major-mode)))
1548 (defun list-processes ()
1549 "Display a list of all processes.
1550 \(Any processes listed as Exited or Signaled are actually eliminated
1551 after the listing is made.)"
1553 (with-output-to-temp-buffer "*Process List*"
1554 (set-buffer standard-output)
1555 (buffer-disable-undo standard-output)
1556 (make-local-variable 'truncate-lines)
1557 (setq truncate-lines t)
1558 ;; 00000000001111111111222222222233333333334444444444
1559 ;; 01234567890123456789012345678901234567890123456789
1560 ;; rewritten for I18N3. This one should stay rewritten
1561 ;; so that the dashes will line up properly.
1562 (princ "Proc Status Buffer Tty Command\n---- ------ ------ --- -------\n")
1563 (let ((tail (process-list)))
1565 (let* ((p (car tail))
1566 (pid (process-id p))
1567 (s (process-status p)))
1568 (setq tail (cdr tail))
1569 (princ (format "%-13s" (process-name p)))
1571 (if (and (eq s 'exit) (/= (process-exit-status p) 0))
1572 (princ (format " %d" (process-exit-status p))))
1573 (if (memq s '(signal exit closed))
1574 ;; Do delete-exited-processes' work
1576 (indent-to 22 1) ;####
1577 (let ((b (process-buffer p)))
1580 ((not (buffer-name b))
1583 (princ (buffer-name b)))))
1584 (indent-to 37 1) ;####
1585 (let ((tn (process-tty-name p)))
1589 (princ (format "%s" tn)))))
1590 (indent-to 49 1) ;####
1591 (if (not (integerp pid))
1593 (princ "network stream connection ")
1597 (let ((cmd (process-command p)))
1600 (setq cmd (cdr cmd))
1601 (if cmd (princ " ")))))
1604 ;; Stop gap for 21.0 until we do help-char etc properly.
1605 (defun help-keymap-with-help-key (keymap form)
1606 "Return a copy of KEYMAP with an help-key binding according to help-char
1607 invoking FORM like help-form. An existing binding is not overridden.
1608 If FORM is nil then no binding is made."
1609 (let ((map (copy-keymap keymap))
1610 (key (if (characterp help-char)
1611 (vector (character-to-event help-char))
1613 (when (and form key (not (lookup-key map key)))
1615 `(lambda () (interactive) (help-print-help-form ,form))))
1618 (defun help-print-help-form (form)
1619 (let ((string (eval form)))
1620 (if (stringp string)
1621 (with-displaying-help-buffer
1624 ;;; help.el ends here