X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ff3453e4d171f566fc372a3edea912afee645813..d18a808f42266d6a1873373e6fef9ca6e74a5226:/lisp/help.el diff --git a/lisp/help.el b/lisp/help.el index 2f28e53796..45d84b8897 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -66,6 +66,7 @@ (define-key help-map "F" 'view-emacs-FAQ) (define-key help-map "i" 'info) +(define-key help-map "4i" 'info-other-window) (define-key help-map "\C-f" 'Info-goto-emacs-command-node) (define-key help-map "\C-k" 'Info-goto-emacs-key-command-node) (define-key help-map "\C-i" 'info-lookup-symbol) @@ -96,6 +97,7 @@ (define-key help-mode-map "\C-c\C-c" 'help-follow) (define-key help-mode-map "\t" 'help-next-ref) (define-key help-mode-map [backtab] 'help-previous-ref) +(define-key help-mode-map [(shift tab)] 'help-previous-ref) ;; Documentation only, since we use minor-mode-overriding-map-alist. (define-key help-mode-map "\r" 'help-follow) @@ -121,11 +123,14 @@ (defvar help-xref-stack nil "A stack of ways by which to return to help buffers after following xrefs. -Used by `help-follow' and `help-xref-go-back'.") +Used by `help-follow' and `help-xref-go-back'. +An element looks like (POSITION FUNCTION ARGS...). +To use the element, do (apply FUNCTION ARGS) then (goto-char POSITION).") (put 'help-xref-stack 'permanent-local t) (defvar help-xref-stack-item nil - "An item for `help-follow' in this buffer to push onto `help-xref-stack'.") + "An item for `help-follow' in this buffer to push onto `help-xref-stack'. +The format is (FUNCTION ARGS...).") (put 'help-xref-stack-item 'permanent-local t) (setq-default help-xref-stack nil help-xref-stack-item nil) @@ -166,14 +171,6 @@ Commands: (interactive) nil) -(defvar help-with-tutorial-alist - '(("German" . "TUTORIAL.de") - ("Korean" . "TUTORIAL.kr") - ("Japanese" . "TUTORIAL.jp") - ("Thai" . "TUTORIAL.th") - ("English" . "TUTORIAL")) - "Alist mapping language names to their translated Emacs tutorial files.") - (defun help-with-tutorial (&optional arg) "Select the Emacs learn-by-doing tutorial. If there is a tutorial version written in the language @@ -181,16 +178,13 @@ of the selected language environment, that version is used. If there's no tutorial in that language, `TUTORIAL' is selected. With arg, you are asked to choose which language." (interactive "P") - (let (lang filename file) - (if arg - (or (setq lang - (let* ((completion-ignore-case t)) - (completing-read "Language: " help-with-tutorial-alist - nil t))) - (error "No tutorial file in language")) - (setq lang current-language-environment)) - (setq filename (or (cdr (assoc lang help-with-tutorial-alist)) - "TUTORIAL")) + (let ((lang (if arg + (read-language-name 'tutorial "Language: " "English") + (if (get-language-info current-language-environment 'tutorial) + current-language-environment + "English"))) + file filename) + (setq filename (get-language-info lang 'tutorial)) (setq file (expand-file-name (concat "~/" filename))) (delete-other-windows) (if (get-file-buffer file) @@ -221,14 +215,6 @@ With arg, you are asked to choose which language." "Print the name of the function KEY invokes. KEY is a string. If INSERT (the prefix arg) is non-nil, insert the message in the buffer." (interactive "kDescribe key briefly: \nP") - ;; If this key seq ends with a down event, discard the - ;; following click or drag event. Otherwise that would - ;; erase the message. - (let ((type (aref key (1- (length key))))) - (if (listp type) (setq type (car type))) - (and (symbolp type) - (memq 'down (event-modifiers type)) - (read-event))) (save-excursion (let ((modifiers (event-modifiers (aref key 0))) (standard-output (if insert (current-buffer) t)) @@ -250,7 +236,7 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer." (if (or (null defn) (integerp defn)) (princ (format "%s is undefined" key-desc)) (princ (format (if insert - "%s (%s)" + "`%s' (`%s')" (if (windowp window) "%s at that spot runs the command %s" "%s runs the command %s")) @@ -312,14 +298,6 @@ If FUNCTION is nil, applies `message' to it, thus printing it." (defun describe-key (key) "Display documentation of the function invoked by KEY. KEY is a string." (interactive "kDescribe key: ") - ;; If this key seq ends with a down event, discard the - ;; following click or drag event. Otherwise that would - ;; erase the message. - (let ((type (aref key (1- (length key))))) - (if (listp type) (setq type (car type))) - (and (symbolp type) - (memq 'down (event-modifiers type)) - (read-event))) (save-excursion (let ((modifiers (event-modifiers (aref key 0))) window position) @@ -343,13 +321,8 @@ If FUNCTION is nil, applies `message' to it, thus printing it." (princ " at that spot")) (princ " runs the command ") (prin1 defn) - (princ "\n") - (let ((doc (documentation defn))) - (if doc - (progn (terpri) - (princ doc) - (help-setup-xref (cons #'describe-key key) (interactive-p))) - (princ "not documented"))) + (princ "\n which is ") + (describe-function-1 defn nil) (print-help-return-message))))))) (defun describe-mode () @@ -392,7 +365,7 @@ followed by the major mode, which is described on the last page.\n\f\n")) (princ mode-name) (princ " mode:\n") (princ (documentation major-mode)) - (help-setup-xref (cons #'help-xref-mode (current-buffer)) (interactive-p)) + (help-setup-xref (list #'help-xref-mode (current-buffer)) (interactive-p)) (print-help-return-message))) ;; So keyboard macro definitions are documented correctly @@ -476,9 +449,9 @@ With numeric argument display information on correspondingly older changes." (goto-char (point-min)) (while (progn (move-to-column 50) (not (eobp))) (search-forward " " nil t) - (insert "\n"))) - (setq help-xref-stack nil - help-xref-stack-item nil) + (insert "\n")) + (setq help-xref-stack nil + help-xref-stack-item nil)) (print-help-return-message))) (defalias 'help 'help-for-help) @@ -591,65 +564,7 @@ C-w Display information on absence of warranty for GNU Emacs." ;; Use " is " instead of a colon so that ;; it is easier to get out the function name using forward-sexp. (princ " is ") - (let* ((def (symbol-function function)) - file-name - (beg (if (commandp def) "an interactive " "a "))) - (princ (cond ((or (stringp def) - (vectorp def)) - "a keyboard macro") - ((subrp def) - (concat beg "built-in function")) - ((byte-code-function-p def) - (concat beg "compiled Lisp function")) - ((symbolp def) - (format "alias for `%s'" def)) - ((eq (car-safe def) 'lambda) - (concat beg "Lisp function")) - ((eq (car-safe def) 'macro) - "a Lisp macro") - ((eq (car-safe def) 'mocklisp) - "a mocklisp function") - ((eq (car-safe def) 'autoload) - (setq file-name (nth 1 def)) - (format "%s autoloaded Lisp %s" - (if (commandp def) "an interactive" "an") - (if (nth 4 def) "macro" "function") - )) - (t ""))) - (or file-name - (setq file-name (describe-function-find-file function))) - (if file-name - (progn - (princ " in `") - ;; We used to add .el to the file name, - ;; but that's completely wrong when the user used load-file. - (princ file-name) - (princ "'"))) - (princ ".") - (terpri) - (let* ((inner-function (if (and (listp def) 'macro) - (cdr def) - def)) - (arglist (cond ((byte-code-function-p inner-function) - (car (append inner-function nil))) - ((eq (car-safe inner-function) 'lambda) - (nth 1 inner-function)) - (t t)))) - (if (listp arglist) - (progn - (princ (cons function - (mapcar (lambda (arg) - (if (memq arg '(&optional &rest)) - arg - (intern (upcase (symbol-name arg))))) - arglist))) - (terpri)))) - (let ((doc (documentation function))) - (if doc - (progn (terpri) - (princ doc) - (help-setup-xref (cons #'describe-function function) (interactive-p))) - (princ "not documented")))) + (describe-function-1 function nil) (print-help-return-message) (save-excursion (set-buffer standard-output) @@ -657,6 +572,87 @@ C-w Display information on absence of warranty for GNU Emacs." (buffer-string))) (message "You didn't specify a function"))) +(defun describe-function-1 (function parens) + (let* ((def (symbol-function function)) + file-name string need-close + (beg (if (commandp def) "an interactive " "a "))) + (setq string + (cond ((or (stringp def) + (vectorp def)) + "a keyboard macro") + ((subrp def) + (concat beg "built-in function")) + ((byte-code-function-p def) + (concat beg "compiled Lisp function")) + ((symbolp def) + (while (symbolp (symbol-function def)) + (setq def (symbol-function def))) + (format "alias for `%s'" def)) + ((eq (car-safe def) 'lambda) + (concat beg "Lisp function")) + ((eq (car-safe def) 'macro) + "a Lisp macro") + ((eq (car-safe def) 'mocklisp) + "a mocklisp function") + ((eq (car-safe def) 'autoload) + (setq file-name (nth 1 def)) + (format "%s autoloaded Lisp %s" + (if (commandp def) "an interactive" "an") + (if (nth 4 def) "macro" "function") + )) + (t ""))) + (when (and parens (not (equal string ""))) + (setq need-close t) + (princ "(")) + (princ string) + (or file-name + (setq file-name (describe-function-find-file function))) + (if file-name + (progn + (princ " in `") + ;; We used to add .el to the file name, + ;; but that's completely wrong when the user used load-file. + (princ file-name) + (princ "'") + ;; Make a hyperlink to the library. + (with-current-buffer "*Help*" + (save-excursion + (re-search-backward "`\\([^`']+\\)'" nil t) + (help-xref-button 1 #'(lambda (arg) + (let ((location + (find-function-noselect arg))) + (pop-to-buffer (car location)) + (goto-char (cdr location)))) + function))))) + (if need-close (princ ")")) + (princ ".") + (terpri) + ;; Handle symbols aliased to other symbols. + (setq def (indirect-function def)) + ;; If definition is a macro, find the function inside it. + (if (eq (car-safe def) 'macro) + (setq def (cdr def))) + (let ((arglist (cond ((byte-code-function-p def) + (car (append def nil))) + ((eq (car-safe def) 'lambda) + (nth 1 def)) + (t t)))) + (if (listp arglist) + (progn + (princ (cons function + (mapcar (lambda (arg) + (if (memq arg '(&optional &rest)) + arg + (intern (upcase (symbol-name arg))))) + arglist))) + (terpri)))) + (let ((doc (documentation function))) + (if doc + (progn (terpri) + (princ doc) + (help-setup-xref (list #'describe-function function) (interactive-p))) + (princ "not documented"))))) + ;; We return 0 if we can't find a variable to return. (defun variable-at-point () (condition-case () @@ -728,7 +724,25 @@ Returns the documentation as a string, also." (terpri) (let ((doc (documentation-property variable 'variable-documentation))) (princ (or doc "not documented as a variable."))) - (help-setup-xref (cons #'describe-variable variable) (interactive-p)) + (help-setup-xref (list #'describe-variable variable) (interactive-p)) + + ;; Make a link to customize if this variable can be customized. + ;; Note, it is not reliable to test for a custom-type property + ;; because those are only present after the var's definition + ;; has been loaded. + (if (user-variable-p variable) + (let ((customize-label "customize")) + (terpri) + (terpri) + (princ (concat "You can " customize-label " this variable.")) + (with-current-buffer "*Help*" + (save-excursion + (re-search-backward + (concat "\\(" customize-label "\\)") nil t) + (help-xref-button 1 #'(lambda (v) + (customize-variable v)) variable) + )))) + (print-help-return-message) (save-excursion (set-buffer standard-output) @@ -736,16 +750,21 @@ Returns the documentation as a string, also." (buffer-string)))) (message "You did not specify a variable"))) -(defun describe-bindings (&optional prefix) +(defun describe-bindings (&optional prefix buffer) "Show a list of all defined keys, and their definitions. We put that list in a buffer, and display the buffer. The optional argument PREFIX, if non-nil, should be a key sequence; -then we display only bindings that start with that prefix." +then we display only bindings that start with that prefix. +The optional argument BUFFER specifies which buffer's bindings +to display (default, the current buffer)." (interactive "P") - (setq help-xref-stack nil - help-xref-stack-item nil) - (describe-bindings-internal nil prefix)) + (or buffer (setq buffer (current-buffer))) + (with-current-buffer buffer + (describe-bindings-internal nil prefix)) + (with-current-buffer "*Help*" + (help-setup-xref (list #'describe-bindings prefix buffer) + (interactive-p)))) (defun where-is (definition &optional insert) "Print message listing key sequences that invoke specified command. @@ -845,7 +864,7 @@ references look like cross-references in info mode." Must be previously-defined." :group 'help :version "20.3" - :type 'symbol) + :type 'face) (defvar help-back-label "[back]" "Label to use by `help-make-xrefs' for the go-back reference.") @@ -868,7 +887,7 @@ distinguish references to variables, functions and symbols.") (defun help-setup-xref (item interactive-p) "Invoked from commands using the \"*Help*\" buffer to install some xref info. -ITEM is a (function . args) pair appropriate for recreating the help +ITEM is a (FUNCTION . ARGS) pair appropriate for recreating the help buffer after following a reference. INTERACTIVE-P is non-nil if the calling command was invoked interactively. In this case the stack of items for help buffer \"back\" buttons is cleared." @@ -940,6 +959,8 @@ that." (help-xref-button 1 #'describe-function sym))))) ;; Look for commands in whole keymap substitutions: (save-excursion + ;; Make sure to find the first keymap. + (goto-char (point-min)) ;; Find a header and the column at which the command ;; name will be found. (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n" @@ -968,7 +989,7 @@ that." (insert "\n\n" help-back-label)) ;; Just to provide the match data: (looking-at (concat "\n\n\\(" (regexp-quote help-back-label) "\\)")) - (help-xref-button 1 #'help-xref-go-back nil))) + (help-xref-button 1 #'help-xref-go-back (current-buffer)))) ;; View mode steals RET from us. (set (make-local-variable 'minor-mode-overriding-map-alist) (list (cons 'view-mode @@ -1011,7 +1032,7 @@ help buffer." (goto-char (point-max)) (insert "\n\n" fdoc)) (goto-char (point-min)) - (help-setup-xref (cons #'help-xref-interned symbol) nil)) + (help-setup-xref (list #'help-xref-interned symbol) nil)) (defun help-xref-mode (buffer) "Do a `describe-mode' for the specified BUFFER." @@ -1024,25 +1045,26 @@ help buffer." (defun help-follow-mouse (click) "Follow the cross-reference that you click on." (interactive "e") - (save-excursion - (let* ((start (event-start click)) - (window (car start)) - (pos (car (cdr start)))) - (set-buffer (window-buffer window)) + (let* ((start (event-start click)) + (window (car start)) + (pos (car (cdr start)))) + (with-current-buffer (window-buffer window) (help-follow pos)))) -(defun help-xref-go-back () - "Go back to the previous help buffer using info on `help-xref-stack'." +(defun help-xref-go-back (buffer) + "Go back to the previous help buffer text using info on `help-xref-stack'." (interactive) - (when help-xref-stack - (setq help-xref-stack (cdr help-xref-stack)) ; due to help-follow - (let* ((item (car help-xref-stack)) - (method (car item)) - (args (cdr item))) - (setq help-xref-stack (cdr help-xref-stack)) - (if (listp args) - (apply method args) - (funcall method args))))) + (let (item position method args) + (with-current-buffer buffer + (when help-xref-stack + (setq help-xref-stack (cdr help-xref-stack)) ; due to help-follow + (setq item (car help-xref-stack) + position (car item) + method (cadr item) + args (cddr item)) + (setq help-xref-stack (cdr help-xref-stack)))) + (apply method args) + (goto-char position))) (defun help-go-back () (interactive) @@ -1053,10 +1075,14 @@ help buffer." For the cross-reference format, see `help-make-xrefs'." (interactive "d") - (let* ((help-data (get-text-property pos 'help-xref)) + (let* ((help-data (or (and (not (= pos (point-max))) + (get-text-property pos 'help-xref)) + (and (not (= pos (point-min))) + (get-text-property (1- pos) 'help-xref)))) (method (car help-data)) (args (cdr help-data))) - (setq help-xref-stack (cons help-xref-stack-item help-xref-stack)) + (setq help-xref-stack (cons (cons (point) help-xref-stack-item) + help-xref-stack)) (setq help-xref-stack-item nil) (when help-data ;; There is a reference at point. Follow it.