X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d365421f859f6c88e3dc4b610c87adaef3cb099c..4e1ede6c01245a650513a72a30eab1246a072a66:/lisp/help.el diff --git a/lisp/help.el b/lisp/help.el index c3dfc518aa..7ebd131f6f 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -151,7 +151,7 @@ Commands: (add-hook 'temp-buffer-setup-hook 'help-mode-setup) (defun help-mode-finish () - (when (eq major-mode 'help-mode) + (when (eq major-mode 'help-mode) ;; View mode's read-only status of existing *Help* buffer is lost ;; by with-output-to-temp-buffer. (toggle-read-only 1) @@ -274,6 +274,10 @@ If FUNCTION is nil, applies `message' to it, thus printing it." ;; Secondly, the buffer has not been displayed yet, ;; so we don't know whether its frame will be selected. nil) + (display-buffer-reuse-frames + (setq help-return-method (cons (selected-window) + 'quit-window)) + nil) ((not (one-window-p t)) (setq help-return-method (cons (selected-window) 'quit-window)) @@ -357,7 +361,8 @@ For minor modes, see following pages.\n\n")) ;; Document a minor mode if it is listed in minor-mode-alist, ;; bound locally in this buffer, non-nil, and has a function ;; definition. - (if (and (symbol-value minor-mode) + (if (and (boundp minor-mode) + (symbol-value minor-mode) (fboundp minor-mode)) (let ((pretty-minor-mode minor-mode)) (if (string-match "-mode$" (symbol-name minor-mode)) @@ -431,12 +436,19 @@ of the key sequence that ran this command." (defun view-emacs-news (&optional arg) "Display info on recent changes to Emacs. -With numeric argument display information on correspondingly older changes." +With numeric argument, display information on correspondingly older changes." (interactive "P") - (let* ((arg (if arg (prefix-numeric-value arg) 0))) - (find-file-read-only - (expand-file-name (concat (make-string arg ?O) "NEWS") - data-directory)))) + (let* ((arg (if arg (prefix-numeric-value arg) 0)) + (file (cond ((eq arg 0) "NEWS") + ((eq arg 1) "ONEWS") + (t + (nth (- arg 2) + (nreverse (directory-files data-directory + nil "^NEWS\\.[0-9]+$" + nil))))))) + (if file + (find-file-read-only (expand-file-name file data-directory)) + (error "No such old news")))) (defun view-emacs-FAQ () "Display the Emacs Frequently Asked Questions (FAQ) file." @@ -525,35 +537,32 @@ C-w Display information on absence of warranty for GNU Emacs." (defun function-called-at-point () "Return a function around point or else called by the list containing point. If that doesn't give a function, return nil." - (let ((stab (syntax-table))) - (set-syntax-table emacs-lisp-mode-syntax-table) - (unwind-protect - (or (condition-case () - (save-excursion - (or (not (zerop (skip-syntax-backward "_w"))) - (eq (char-syntax (following-char)) ?w) - (eq (char-syntax (following-char)) ?_) - (forward-sexp -1)) - (skip-chars-forward "'") - (let ((obj (read (current-buffer)))) - (and (symbolp obj) (fboundp obj) obj))) - (error nil)) - (condition-case () - (save-excursion - (save-restriction - (narrow-to-region (max (point-min) (- (point) 1000)) (point-max)) - ;; Move up to surrounding paren, then after the open. - (backward-up-list 1) - (forward-char 1) - ;; If there is space here, this is probably something - ;; other than a real Lisp function call, so ignore it. - (if (looking-at "[ \t]") - (error "Probably not a Lisp function call")) - (let (obj) - (setq obj (read (current-buffer))) - (and (symbolp obj) (fboundp obj) obj)))) - (error nil))) - (set-syntax-table stab)))) + (with-syntax-table emacs-lisp-mode-syntax-table + (or (condition-case () + (save-excursion + (or (not (zerop (skip-syntax-backward "_w"))) + (eq (char-syntax (following-char)) ?w) + (eq (char-syntax (following-char)) ?_) + (forward-sexp -1)) + (skip-chars-forward "'") + (let ((obj (read (current-buffer)))) + (and (symbolp obj) (fboundp obj) obj))) + (error nil)) + (condition-case () + (save-excursion + (save-restriction + (narrow-to-region (max (point-min) + (- (point) 1000)) (point-max)) + ;; Move up to surrounding paren, then after the open. + (backward-up-list 1) + (forward-char 1) + ;; If there is space here, this is probably something + ;; other than a real Lisp function call, so ignore it. + (if (looking-at "[ \t]") + (error "Probably not a Lisp function call")) + (let ((obj (read (current-buffer)))) + (and (symbolp obj) (fboundp obj) obj)))) + (error nil))))) (defvar symbol-file-load-history-loaded nil "Non-nil means we have loaded the file `fns-VERSION.el' in `exec-directory'. @@ -755,19 +764,16 @@ It can also be nil, if the definition is not associated with any file." "Return the bound variable symbol found around point. Return 0 if there is no such symbol." (condition-case () - (let ((stab (syntax-table))) - (unwind-protect - (save-excursion - (set-syntax-table emacs-lisp-mode-syntax-table) - (or (not (zerop (skip-syntax-backward "_w"))) - (eq (char-syntax (following-char)) ?w) - (eq (char-syntax (following-char)) ?_) - (forward-sexp -1)) - (skip-chars-forward "'") - (let ((obj (read (current-buffer)))) - (or (and (symbolp obj) (boundp obj) obj) - 0))) - (set-syntax-table stab))) + (with-syntax-table emacs-lisp-mode-syntax-table + (save-excursion + (or (not (zerop (skip-syntax-backward "_w"))) + (eq (char-syntax (following-char)) ?w) + (eq (char-syntax (following-char)) ?_) + (forward-sexp -1)) + (skip-chars-forward "'") + (let ((obj (read (current-buffer)))) + (or (and (symbolp obj) (boundp obj) obj) + 0)))) (error 0))) (defun help-xref-on-pp (from to) @@ -784,9 +790,7 @@ Return 0 if there is no such symbol." ((looking-at "\"") (forward-sexp 1)) ((looking-at "#<") (search-forward ">" nil 'move)) ((looking-at "\\(\\(\\sw\\|\\s_\\)+\\)") - (let* ((sym (intern-soft - (buffer-substring (match-beginning 1) - (match-end 1)))) + (let* ((sym (intern-soft (match-string 1))) (fn (cond ((fboundp sym) #'describe-function) ((or (memq sym '(t nil)) (keywordp sym)) @@ -798,10 +802,12 @@ Return 0 if there is no such symbol." (t (forward-char 1)))))) (set-syntax-table ost)))) -(defun describe-variable (variable) +(defun describe-variable (variable &optional buffer) "Display the full documentation of VARIABLE (a symbol). -Returns the documentation as a string, also." - (interactive +Returns the documentation as a string, also. +If VARIABLE has a buffer-local value in BUFFER (default to the current buffer), +it is displayed along with the global value." + (interactive (let ((v (variable-at-point)) (enable-recursive-minibuffers t) val) @@ -813,8 +819,11 @@ Returns the documentation as a string, also." (if (symbolp v) (symbol-name v)))) (list (if (equal val "") v (intern val))))) - (if (symbolp variable) - (let (valvoid) + (unless (bufferp buffer) (setq buffer (current-buffer))) + (if (not (symbolp variable)) + (message "You did not specify a variable") + (let (valvoid) + (with-current-buffer buffer (with-output-to-temp-buffer "*Help*" (prin1 variable) (if (not (boundp variable)) @@ -838,13 +847,16 @@ Returns the documentation as a string, also." (with-current-buffer standard-output (princ "global value is ") (terpri) + ;; Fixme: pp can take an age if you happen to + ;; ask for a very large expression. We should + ;; probably print it raw once and check it's a + ;; sensible size before prettyprinting. -- fx (let ((from (point))) (pp val) (help-xref-on-pp from (point)))))) (terpri))) (terpri) - (save-current-buffer - (set-buffer standard-output) + (with-current-buffer standard-output (if (> (count-lines (point-min) (point-max)) 10) (progn ;; Note that setting the syntax table like below @@ -863,8 +875,9 @@ 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 (list #'describe-variable variable) (interactive-p)) - + (help-setup-xref (list #'describe-variable variable (current-buffer)) + (interactive-p)) + ;; Make a link to customize if this variable can be customized. ;; Note, it is not reliable to test only for a custom-type property ;; because those are only present after the var's definition @@ -878,7 +891,7 @@ Returns the documentation as a string, also." (princ (concat "You can " customize-label " this variable.")) (with-current-buffer "*Help*" (save-excursion - (re-search-backward + (re-search-backward (concat "\\(" customize-label "\\)") nil t) (help-xref-button 1 (lambda (v) (if help-xref-stack @@ -909,8 +922,7 @@ Returns the documentation as a string, also." (save-excursion (set-buffer standard-output) ;; Return the text we displayed. - (buffer-string)))) - (message "You did not specify a variable"))) + (buffer-string))))))) (defun describe-bindings (&optional prefix buffer) "Show a list of all defined keys, and their definitions. @@ -1046,6 +1058,14 @@ Must be previously-defined." The words preceding the quoted symbol can be used in doc strings to distinguish references to variables, functions and symbols.") +(defconst help-xref-mule-regexp nil + "Regexp matching doc string references to MULE-related keywords. + +It is usually nil, and is temporarily bound to an appropriate regexp +when help commands related to multilingual environment (e.g., +`describe-coding-system') are invoked.") + + (defconst help-xref-info-regexp (purecopy "\\<[Ii]nfo[ \t\n]+node[ \t\n]+`\\([^']+\\)'") "Regexp matching doc string references to an Info node.") @@ -1074,6 +1094,11 @@ with `help-follow'. Cross-references have the canonical form `...' and the type of reference may be disambiguated by the preceding word(s) used in `help-xref-symbol-regexp'. +If the variable `help-xref-mule-regexp' is non-nil, find also +cross-reference information related to multilingual environment +\(e.g., coding-systems). This variable is also used to disambiguate +the type of reference as the same way as `help-xref-symbol-regexp'. + A special reference `back' is made to return back through a stack of help buffers. Variable `help-back-label' specifies the text for that." @@ -1101,6 +1126,42 @@ that." (setq data (concat "(emacs)" data)))) (help-xref-button 1 #'info data "mouse-2, RET: read this Info node")))) + ;; Mule related keywords. Do this before trying + ;; `help-xref-symbol-regexp' because some of Mule + ;; keywords have variable or function definitions. + (if help-xref-mule-regexp + (save-excursion + (while (re-search-forward help-xref-mule-regexp nil t) + (let* ((data (match-string 7)) + (sym (intern-soft data))) + (cond + ((match-string 3) ; coding system + (and sym (coding-system-p sym) + (help-xref-button + 7 #'describe-coding-system sym + "mouse-2, RET: describe this coding system"))) + ((match-string 4) ; input method + (and (assoc data input-method-alist) + (help-xref-button + 7 #'describe-input-method data + "mouse-2, RET: describe this input method"))) + ((or (match-string 5) (match-string 6)) ; charset + (and sym (charsetp sym) + (help-xref-button + 7 #'describe-character-set sym + "mouse-2, RET: describe this character set"))) + ((assoc data input-method-alist) + (help-xref-button + 7 #'describe-input-method data + "mouse-2, RET: describe this input method")) + ((and sym (coding-system-p sym)) + (help-xref-button + 7 #'describe-coding-system sym + "mouse-2, RET: describe this coding system")) + ((and sym (charsetp sym)) + (help-xref-button + 7 #'describe-character-set sym + "mouse-2, RET: describe this character set"))))))) ;; Quoted symbols (save-excursion (while (re-search-forward help-xref-symbol-regexp nil t) @@ -1142,7 +1203,7 @@ that." (help-xref-button 7 #'describe-face sym))))))) ;; An obvious case of a key substitution: - (save-excursion + (save-excursion (while (re-search-forward ;; Assume command name is only word characters ;; and dashes to get things like `use M-x foo.'. @@ -1158,7 +1219,7 @@ that." (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" + (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n" nil t) (let ((col (- (match-end 1) (match-beginning 1)))) (while @@ -1173,7 +1234,7 @@ that." (looking-at "\\(\\sw\\|-\\)+$")) (let ((sym (intern-soft (match-string 0)))) (if (fboundp sym) - (help-xref-button + (help-xref-button 0 #'describe-function sym "mouse-2, RET: describe this function")))) (zerop (forward-line))))))))) @@ -1221,6 +1282,19 @@ If optional arg HELP-ECHO is supplied, it is used as a help string." (match-end match-number) 'face help-highlight-face)))) +(defun help-insert-xref-button (string function data &optional help-echo) + "Insert STRING and make a hyperlink from cross-reference text on it. + +FUNCTION is a function to invoke when the button is activated, applied +to DATA. DATA may be a single value or a list. See `help-make-xrefs'. +If optional arg HELP-ECHO is supplied, it is used as a help string." + (let ((pos (point))) + (insert string) + (goto-char pos) + (search-forward string) + (help-xref-button 0 function data help-echo))) + + ;; Additional functions for (re-)creating types of help buffers. (defun help-xref-interned (symbol) @@ -1355,23 +1429,6 @@ For the cross-reference format, see `help-make-xrefs'." ;;; Automatic resizing of temporary buffers. -(defcustom temp-buffer-resize-mode nil - "Non-nil means resize windows displaying temporary buffers. -This makes the window the right height for its contents, but never -more than `temp-buffer-max-height' nor less than `window-min-height'. -This applies to `help', `apropos' and `completion' buffers, and some others. - -Setting this variable directly does not take effect; -use either \\[customize] or the function `temp-buffer-resize-mode'." - :get (lambda (symbol) - (and (memq 'resize-temp-buffer-window temp-buffer-show-hook) t)) - :set (lambda (symbol value) - (temp-buffer-resize-mode (if value 1 -1))) - :initialize 'custom-initialize-default - :type 'boolean - :group 'help - :version "20.4") - (defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2)) "*Maximum height of a window displaying a temporary buffer. This is the maximum height (in text lines) which `resize-temp-buffer-window' @@ -1383,25 +1440,19 @@ positive number." :group 'help :version "20.4") -(defun temp-buffer-resize-mode (arg) - "Toggle the mode which that makes windows smaller for temporary buffers. +(define-minor-mode temp-buffer-resize-mode + "Toggle the mode which makes windows smaller for temporary buffers. With prefix argument ARG, turn the resizing of windows displaying temporary buffers on if ARG is positive or off otherwise. -See the documentation of the variable `temp-buffer-resize-mode' for -more information." - (interactive "P") - (let ((turn-it-on - (if (null arg) - (not (memq 'resize-temp-buffer-window temp-buffer-show-hook)) - (> (prefix-numeric-value arg) 0)))) - (if turn-it-on - (progn - ;; `help-mode-maybe' may add a `back' button and thus increase the - ;; text size, so `resize-temp-buffer-window' must be run *after* it. - (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append) - (setq temp-buffer-resize-mode t)) - (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window) - (setq temp-buffer-resize-mode nil)))) +This makes the window the right height for its contents, but never +more than `temp-buffer-max-height' nor less than `window-min-height'. +This applies to `help', `apropos' and `completion' buffers, and some others." + nil nil nil :global t :group 'help + (if temp-buffer-resize-mode + ;; `help-mode-maybe' may add a `back' button and thus increase the + ;; text size, so `resize-temp-buffer-window' must be run *after* it. + (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append) + (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)))) (defun resize-temp-buffer-window () "Resize the current window to fit its contents. @@ -1426,6 +1477,16 @@ out of view." ;; to this alist. ;; The parens and function name are redundant, but it's messy to add ;; them in `documentation'. + +;; This will find any missing items: +;; (let (l) +;; (mapatoms (lambda (x) +;; (if (and (fboundp x) +;; (subrp (symbol-function x)) +;; (not (numberp (cdr (subr-arity (symbol-function x))))) +;; (not (assq x help-manyarg-func-alist))) +;; (push x l)))) +;; l) (defconst help-manyarg-func-alist (purecopy '((list . "(list &rest OBJECTS)") @@ -1448,6 +1509,7 @@ out of view." (encode-time . "(encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE)") (insert . "(insert &rest ARGS)") + (insert-and-inherit . "(insert-and-inherit &rest ARGS)") (insert-before-markers . "(insert-before-markers &rest ARGS)") (message . "(message STRING &rest ARGUMENTS)") (message-box . "(message-box STRING &rest ARGUMENTS)") @@ -1497,8 +1559,13 @@ out of view." (track-mouse . "(track-mouse BODY ...)") (ml-if . "(ml-if COND THEN ELSE...)") (ml-provide-prefix-argument . "(ml-provide-prefix-argument ARG1 ARG2)") + (ml-prefix-argument-loop . "(ml-prefix-argument-loop ...)") (with-output-to-temp-buffer . "(with-output-to-temp-buffer BUFFNAME BODY ...)") - (save-window-excursion . "(save-window-excursion BODY ...)")))) + (save-window-excursion . "(save-window-excursion BODY ...)") + (find-operation-coding-system + . "(find-operation-coding-system OPERATION ARGUMENTS ...)") + (insert-before-markers-and-inherit + . "(insert-before-markers-and-inherit &rest ARGS)")))) ;;; help.el ends here