X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/325c5543035b411ae79839dda47bbbbde838d36b..1a5d0c15185986e645e8fb8080a2338d8f17d562:/lisp/help-mode.el diff --git a/lisp/help-mode.el b/lisp/help-mode.el index d6679e9e4d..e008698618 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -1,6 +1,6 @@ ;;; help-mode.el --- `help-mode' used by *Help* buffers -;; Copyright (C) 1985-1986, 1993-1994, 1998-2015 Free Software +;; Copyright (C) 1985-1986, 1993-1994, 1998-2016 Free Software ;; Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org @@ -30,6 +30,7 @@ ;;; Code: (require 'button) +(require 'cl-lib) (eval-when-compile (require 'easymenu)) (defvar help-mode-map @@ -106,7 +107,7 @@ The format is (FUNCTION ARGS...).") (defun help-button-action (button) "Call BUTTON's help function." - (help-do-xref (button-start button) + (help-do-xref nil (button-get button 'help-function) (button-get button 'help-args))) @@ -148,7 +149,7 @@ The format is (FUNCTION ARGS...).") (define-button-type 'help-symbol :supertype 'help-xref - 'help-function #'help-xref-interned + 'help-function #'describe-symbol 'help-echo (purecopy "mouse-2, RET: describe this symbol")) (define-button-type 'help-back @@ -201,6 +202,7 @@ The format is (FUNCTION ARGS...).") (let ((location (find-function-search-for-symbol fun type file))) (pop-to-buffer (car location)) + (run-hooks 'find-function-after-hook) (if (cdr location) (goto-char (cdr location)) (message "Unable to find location in file")))) @@ -216,7 +218,8 @@ The format is (FUNCTION ARGS...).") (goto-char (point-min)) (if (re-search-forward (format "^[ \t]*(\\(cl-\\)?define-compiler-macro[ \t]+%s" - (regexp-quote (symbol-name fun))) nil t) + (regexp-quote (symbol-name fun))) + nil t) (forward-line 0) (message "Unable to find location in file"))) (message "Unable to find file"))) @@ -229,6 +232,7 @@ The format is (FUNCTION ARGS...).") (setq file (help-C-file-name var 'var))) (let ((location (find-variable-noselect var file))) (pop-to-buffer (car location)) + (run-hooks 'find-function-after-hook) (if (cdr location) (goto-char (cdr location)) (message "Unable to find location in file")))) @@ -292,11 +296,13 @@ Commands: ;;;###autoload (defun help-mode-setup () + "Enter Help Mode in the current buffer." (help-mode) (setq buffer-read-only nil)) ;;;###autoload (defun help-mode-finish () + "Finalize Help Mode setup in current buffer." (when (derived-mode-p 'help-mode) (setq buffer-read-only t) (help-make-xrefs (current-buffer)))) @@ -322,7 +328,7 @@ Commands: "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)" "[ \t\n]+\\)?" ;; Note starting with word-syntax character: - "`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'")) + "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\)['’]")) "Regexp matching doc string references to symbols. The words preceding the quoted symbol can be used in doc strings to @@ -337,11 +343,12 @@ when help commands related to multilingual environment (e.g., (defconst help-xref-info-regexp - (purecopy "\\<[Ii]nfo[ \t\n]+\\(node\\|anchor\\)[ \t\n]+`\\([^']+\\)'") + (purecopy + "\\<[Ii]nfo[ \t\n]+\\(node\\|anchor\\)[ \t\n]+['`‘]\\([^'’]+\\)['’]") "Regexp matching doc string references to an Info node.") (defconst help-xref-url-regexp - (purecopy "\\<[Uu][Rr][Ll][ \t\n]+`\\([^']+\\)'") + (purecopy "\\<[Uu][Rr][Ll][ \t\n]+['`‘]\\([^'’]+\\)['’]") "Regexp matching doc string references to a URL.") ;;;###autoload @@ -384,6 +391,15 @@ it does not already exist." (error "Current buffer is not in Help mode")) (current-buffer)))) +(defvar describe-symbol-backends + `((nil ,#'fboundp ,(lambda (s _b _f) (describe-function s))) + ("face" ,#'facep ,(lambda (s _b _f) (describe-face s))) + (nil + ,(lambda (symbol) + (or (and (boundp symbol) (not (keywordp symbol))) + (get symbol 'variable-documentation))) + ,#'describe-variable))) + ;;;###autoload (defun help-make-xrefs (&optional buffer) "Parse and hyperlink documentation cross-references in the given BUFFER. @@ -486,28 +502,9 @@ that." ;; (pop-to-buffer (car location)) ;; (goto-char (cdr location)))) (help-xref-button 8 'help-function-def sym)) - ((and - (facep sym) - (save-match-data (looking-at "[ \t\n]+face\\W"))) - (help-xref-button 8 'help-face sym)) - ((and (or (boundp sym) - (get sym 'variable-documentation)) - (fboundp sym)) - ;; We can't intuit whether to use the - ;; variable or function doc -- supply both. - (help-xref-button 8 'help-symbol sym)) - ((and - (or (boundp sym) - (get sym 'variable-documentation)) - (or - (documentation-property - sym 'variable-documentation) - (documentation-property - (indirect-variable sym) - 'variable-documentation))) - (help-xref-button 8 'help-variable sym)) - ((fboundp sym) - (help-xref-button 8 'help-function sym))))))) + ((cl-some (lambda (x) (funcall (nth 1 x) sym)) + describe-symbol-backends) + (help-xref-button 8 'help-symbol sym))))))) ;; An obvious case of a key substitution: (save-excursion (while (re-search-forward @@ -623,58 +620,7 @@ See `help-make-xrefs'." ;; Additional functions for (re-)creating types of help buffers. ;;;###autoload -(defun help-xref-interned (symbol &optional buffer frame) - "Follow a hyperlink which appeared to be an arbitrary interned SYMBOL. -Both variable, function and face documentation are extracted into a single -help buffer. If SYMBOL is a variable, include buffer-local value for optional -BUFFER or FRAME." - (with-current-buffer (help-buffer) - ;; Push the previous item on the stack before clobbering the output buffer. - (help-setup-xref nil nil) - (let ((facedoc (when (facep symbol) - ;; Don't record the current entry in the stack. - (setq help-xref-stack-item nil) - (describe-face symbol))) - (fdoc (when (fboundp symbol) - ;; Don't record the current entry in the stack. - (setq help-xref-stack-item nil) - (describe-function symbol))) - (sdoc (when (or (boundp symbol) - (get symbol 'variable-documentation)) - ;; Don't record the current entry in the stack. - (setq help-xref-stack-item nil) - (describe-variable symbol buffer frame)))) - (cond - (sdoc - ;; We now have a help buffer on the variable. - ;; Insert the function and face text before it. - (when (or fdoc facedoc) - (goto-char (point-min)) - (let ((inhibit-read-only t)) - (when fdoc - (insert fdoc "\n\n") - (when facedoc - (insert (make-string 30 ?-) "\n\n" (symbol-name symbol) - " is also a " "face." "\n\n"))) - (when facedoc - (insert facedoc "\n\n")) - (insert (make-string 30 ?-) "\n\n" (symbol-name symbol) - " is also a " "variable." "\n\n")) - ;; Don't record the `describe-variable' item in the stack. - (setq help-xref-stack-item nil) - (help-setup-xref (list #'help-xref-interned symbol) nil))) - (fdoc - ;; We now have a help buffer on the function. - ;; Insert face text before it. - (when facedoc - (goto-char (point-max)) - (let ((inhibit-read-only t)) - (insert "\n\n" (make-string 30 ?-) "\n\n" (symbol-name symbol) - " is also a " "face." "\n\n" facedoc)) - ;; Don't record the `describe-function' item in the stack. - (setq help-xref-stack-item nil) - (help-setup-xref (list #'help-xref-interned symbol) nil)))) - (goto-char (point-min))))) +(define-obsolete-function-alias 'help-xref-interned 'describe-symbol "25.1") ;; Navigation/hyperlinking with xrefs @@ -727,7 +673,7 @@ BUFFER or FRAME." (user-error "No previous help buffer"))) (defun help-go-forward () - "Go back to next topic in this help buffer." + "Go to the next topic in this help buffer." (interactive) (if help-xref-forward-stack (help-xref-go-forward (current-buffer)) @@ -773,7 +719,7 @@ Show all docs for that symbol as either a variable, function or face." (when (or (boundp sym) (get sym 'variable-documentation) (fboundp sym) (facep sym)) - (help-do-xref pos #'help-xref-interned (list sym))))) + (help-do-xref pos #'describe-symbol (list sym))))) (defun help-mode-revert-buffer (_ignore-auto noconfirm) (when (or noconfirm (yes-or-no-p "Revert help buffer? "))