]> code.delx.au - gnu-emacs/blobdiff - lisp/help-mode.el
CC Mode: correct incorrect invocation of parse-partial-sexp.
[gnu-emacs] / lisp / help-mode.el
index d6679e9e4deb59a0b764a5f14c13b5a990c0f92c..e008698618c73a5acbdbb180d5d62b5485a77c46 100644 (file)
@@ -1,6 +1,6 @@
 ;;; help-mode.el --- `help-mode' used by *Help* buffers
 
 ;;; 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
 ;; Foundation, Inc.
 
 ;; Maintainer: emacs-devel@gnu.org
@@ -30,6 +30,7 @@
 ;;; Code:
 
 (require 'button)
 ;;; Code:
 
 (require 'button)
+(require 'cl-lib)
 (eval-when-compile (require 'easymenu))
 
 (defvar help-mode-map
 (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."
 
 (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)))
 
                (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
 
 (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
   '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))
                   (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"))))
                     (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"
                         (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")))
                             (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))
                     (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"))))
                     (if (cdr location)
                       (goto-char (cdr location))
                       (message "Unable to find location in file"))))
@@ -292,11 +296,13 @@ Commands:
 
 ;;;###autoload
 (defun help-mode-setup ()
 
 ;;;###autoload
 (defun help-mode-setup ()
+  "Enter Help Mode in the current buffer."
   (help-mode)
   (setq buffer-read-only nil))
 
 ;;;###autoload
 (defun help-mode-finish ()
   (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))))
   (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:
                    "\\(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
   "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
 
 
 (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
   "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
   "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))))
 
        (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.
 ;;;###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))
                             ;;       (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
                 ;; 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
 ;; 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")
 
 \f
 ;; Navigation/hyperlinking with xrefs
 
 \f
 ;; Navigation/hyperlinking with xrefs
@@ -727,7 +673,7 @@ BUFFER or FRAME."
     (user-error "No previous help buffer")))
 
 (defun help-go-forward ()
     (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))
   (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))
     (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? "))
 
 (defun help-mode-revert-buffer (_ignore-auto noconfirm)
   (when (or noconfirm (yes-or-no-p "Revert help buffer? "))