bug#60587: Patch for adding links to symbols' help documentation

["H. Dieter Wilhelm" <dieter@duenenhof-wilhelm.de>]

[-- Attachment #1: Type: text/plain, Size: 470 bytes --]

Could you please check the attached patch of info.el?

I'm a bit concerned about the "symbol link" face: I think it's helpful
that they're distinct from the info link face.  On the other hand the
colour is then inconsistent to links as they appear in the help buffers.

The other concern is that the info documentation from freshly installed
packages (in the current Emacs session) are still excluded from the
linking process..

I'm looking forward to your assessments


[-- Attachment #2: 0001-Provide-links-in-Info-from-symbols-to-their-help-doc.patch --]
[-- Type: text/x-diff, Size: 17275 bytes --]

From 57725936981c50cd1234d8c01c86733cc29d791f Mon Sep 17 00:00:00 2001
From: Dieter Wilhelm <dieter@duenenhof-wilhelm.de>
Date: Sun, 15 Jan 2023 13:30:45 +0100
Subject: [PATCH] Provide links in Info from symbols to their help
 documentation

---
 lisp/info.el | 383 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 383 insertions(+)

diff --git a/lisp/info.el b/lisp/info.el
index 035dff66e7..876addd7e1 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -5510,6 +5510,389 @@ info--manual-names
 					     Info-directory-list
 					     (mapcar #'car Info-suffix-list))))))))
 
+\f
+;;; Commentary:
+
+;; The code below provides links of symbols (functions, variables, and
+;; faces) within Emacs' Info viewer to their builtin help
+;; documentation.  This linking is done when symbol names in texinfo
+;; documentation (like the Emacs- and Elisp manual) are:
+
+;; 1. Quoted symbol names like `quoted-symbol' or:
+
+;; 2. Function names which are prefixed by M-x, for example M-x
+;; function-name or are quoted and prefixed, like `M-x function-name'.
+
+;; 3. Function names appearing behind the following forms, which
+;; occur, for example, in the Elisp manual:
+
+;;   -- Special Form: function-name
+;;   -- Command: ...
+;;   -- Function: ...
+;;   -- Macro: ...
+
+;; 4. And variables names behind the following text:
+
+;;   -- User Option: variable-name
+;;   -- Variable: ...
+
+;; In any case all symbol names must be known to Emacs, which means it
+;; is either a built-in, or its Lisp package is loaded for the current
+;; Emacs session, or the symbol is auto-loaded.
+
+;; You can follow the additional links with the usual Info
+;; keybindings.  The customisation variable
+;; `mouse-1-click-follows-link' is influencing the clicking behavior
+;; (and tooltips) of the links, the variable's default is 450 (milli
+;; seconds) setting it to nil means only clicking with mouse-2 is
+;; following the link (hint: Drew Adams).
+
+;; The link color of symbols - referencing their builtin documentation
+;; - is distinct from links which are referencing further Info
+;; documentation.
+
+;; Below code is checking if Info documents are relevant Elisp and
+;; Emacs related files to avoid false positives.  Please see the
+;; customization variable `info-none-emacs-or-elisp-documents'.
+
+;; The code uses mostly mechanisms from Emacs' lisp/help-mode.el file.
+
+\f
+;;; Code:
+
+(require 'button)
+(require 'cl-lib)
+(require 'help-mode)
+(require 'cl-seq)
+(require 'subr-x)
+
+(defcustom info-make-xref-flag t
+  "Non-nil means Emacs creates symbol links in info buffers.
+Please see the function `info-make-xrefs' for further
+information."
+  :type '(choice (const :tag "Create links" t)
+                 (const :tag "Do not link" nil))
+  :version "30.1"
+  :group 'info)
+
+;; Toggle on or off the linking to help documents
+(when info-make-xref-flag
+  (add-hook 'Info-selection-hook 'info-make-xrefs))
+
+(defvar info-emacs-info-dir-content nil
+  "List of file names in Emacs' info directories.
+It is used to check if the current info file `Info-current-file'
+belongs to the Emacs and Elisp context.  This variable will be
+initialised when opening the first info file.")
+
+;; Turn better into a regexp list? Hint: Stefan Monier or switch to
+;; alists with an explanation of file name?
+(defcustom info-none-emacs-or-elisp-documents
+  '("aarm2012" ; Stefan: Ada manual, Elpa archive
+    "arm2012"  ; Stefan: Ada manual
+    "sicp"   ; T.V: Structure and Interpretation of Computer Programs,
+                                        ; Melpa archive
+    )
+  "List of (known) documentation which is not related to GNU Emacs or Elisp.
+As well as documents which should not be searched for linking to
+help documentation, for more details please see
+`info-check-docu-p'.  The list must contain only the base name of
+files, without the file extension \".info\"."
+  :type '(repeat string)
+  :version "30.1"
+  :group 'info)
+
+(defun info-check-docu-p ()
+  "Check if the current info file is relevant to Emacs or Elisp.
+That means `Info-current-file' is either found in Emacs' info/
+directory or in `package-user-dir' and is not included in the
+`info-none-emacs-or-elisp-documents' list."
+  (unless info-emacs-info-dir-content
+    (info-compile-emacs-info-dir-content))
+  (let* ((ifile Info-current-file)
+         (ifi (when ifile
+                (file-name-sans-extension
+                 (file-name-nondirectory ifile))))
+         (pdir (when (boundp 'package-user-dir)
+                 (expand-file-name
+                  package-user-dir)))
+         ;; Check if checking pdir is redundant because Package adds
+         ;; info package folders to Info-directory-list anyway?
+         (ifiles info-emacs-info-dir-content)
+         (ndocu info-none-emacs-or-elisp-documents)
+         (is-info (and ifile
+                       (or (assoc-string (concat ifi ".info") ifiles)
+                           ;; the top info "dir" file
+                           (assoc-string (concat ifi ".info.gz") ifiles)
+                           ;; info files might be archived!
+                           (when pdir (string-match pdir ifile)))
+                       (not (assoc-string ifi ndocu)))))
+    (unless is-info
+      (message "No Emacs related info file: %s." ifile))
+    is-info))
+
+(defvar describe-symbol-backends)      ;from help-mode.el
+(defvar help-xref-following)           ;dito
+
+(defface info-color
+  '((t (:inherit font-lock-doc-face
+                 ;; font-lock-preprocessor-face ; similar to link face (default)
+                 ;; font-lock-builtin-face ; similar (default Emacs)
+                 ;; font-lock-function-name-face ; similar (default)
+                 ;; info-face
+                 )))
+  "Face for the `symbol' reference items in `info' nodes."
+  :group 'info-colors)
+
+;; Button types
+(define-button-type 'info
+  'link t                         ;for Info-next-reference-or-link
+  'follow-link t
+  'face 'info-color
+  'action #'info-button-action)
+
+(define-button-type 'info-function
+  :supertype 'info
+  'info-function 'describe-function
+  'info-echo (purecopy "mouse-2, RET: describe this function"))
+
+(define-button-type 'info-variable
+  :supertype 'info
+  'info-function 'describe-variable
+  'info-echo (purecopy "mouse-2, RET: describe this variable"))
+
+(define-button-type 'info-face
+  :supertype 'info
+  'info-function 'describe-face
+  'info-echo (purecopy "mouse-2, RET: describe this face"))
+
+(define-button-type 'info-symbol
+  :supertype 'info
+  'info-function #'describe-symbol
+  'info-echo (purecopy "mouse-2, RET: describe this symbol"))
+
+(define-button-type 'info-function-def
+  :supertype 'info
+  'info-function (lambda (fun &optional file type)
+                   (or file
+                       (setq file (find-lisp-object-file-name fun type)))
+                   (if (not file)
+                       (message "Unable to find defining file")
+                     (require 'find-func)
+                     (when (eq file 'C-source)
+                       (setq file
+                             (help-C-file-name (indirect-function fun) 'fun)))
+                     ;; Don't use find-function-noselect because it follows
+                     ;; aliases (which fails for built-in functions).
+                     (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")))))
+  'info-echo (purecopy "mouse-2, RET: find function's definition"))
+
+;; Functions
+
+(defun info-compile-emacs-info-dir-content ()
+  "Build a list of file names from Emacs' info directories.
+This function fills `info-emacs-info-dir-content' with files from
+`Info-directory-list'."
+  (setq info-emacs-info-dir-content
+        (mapcar 'file-name-nondirectory ;'file-name-sans-extension
+                (directory-files
+                 (car
+                  ;; search for the main Emacs' info/ directory, when this
+                  ;; function is called Info-directory-list is already
+                  ;; initialised
+                  (cl-member "[^.]emacs" Info-directory-list :test
+                             'string-match-p))
+                 ;; don't list "." and ".."
+                 t  "[^.]$"))))
+
+(defun info-button-action (button)
+  "Call BUTTON's help function."
+  (info-do-xref nil
+                (button-get button 'info-function)
+                (button-get button 'info-args)))
+
+(defun info-do-xref (_pos function args)
+  "Call the help cross-reference function FUNCTION with args ARGS.
+Things are set up properly so that the resulting `help-buffer' has
+a proper [back] button."
+  ;; There is a reference at point.  Follow it.
+  (let ((help-xref-following nil))
+    (apply
+     function (if (eq function 'info)
+                  (append args (list (generate-new-buffer-name "*info*")))args))))
+
+(defun info-button (match-number type &rest args)
+  "Make a hyperlink for cross-reference text previously matched.
+MATCH-NUMBER is the subexpression of interest in the last matched
+regexp.  TYPE is the type of button to use.  Any remaining arguments are
+passed to the button's info-function when it is invoked.
+See `info-make-xrefs' Don't forget ARGS."
+  ;; Don't munge properties we've added, especially in some instances.
+  (unless (button-at (match-beginning match-number))
+    ;; (message "Creating button: %s." args)
+    (make-text-button (match-beginning match-number)
+                      (match-end match-number)
+                      'type type 'info-args args)))
+
+(defvar info-symbol-context
+  '(( variable . "variable\\|option")
+    ( function . "function\\|command\\|call")
+    ( face . "face")
+    ( ignore . "symbol\\|program\\|property")
+    ;; ignore symbols following this context type
+    ( definition . "source \\(?:code \\)?\\(?:of\\|for\\)"))
+  ;; function definitions in files
+  "This list helps to distinguish symbol types.
+Words in info documentation preceding a (quoted) symbol are used
+to distinguish variables, functions, faces and symbols.  The
+context information can also be used to ignore symbols because
+there is no help documentation for them.  The strings of the the
+list are becoming part of `info-symbol-regexp'.")
+
+(defvar info-symbol-regexp
+  ;; use purecopy?
+  (concat
+   "\\("                                ; Context start
+   "\\<\\("                             ; Contex type definition
+   (string-remove-suffix
+    "\\|"
+    (mapconcat
+     (lambda (x) (concat "\\(" (cdr x) "\\)\\|"))
+     info-symbol-context ""))
+   "\\)"          ; Context type definition end
+   "[ \t\n]+"     ; Separators to quoted symbols
+   "\\)?"         ; End of context
+   ;; quoted symbol
+   "['`‘]"	  ; opening quotes
+   ;; Note: Symbol starting with word-syntax character:
+   "\\(\\sw\\(\\sw\\|\\s_\\)+\\|`\\)" ; The symbol itself
+   "['’]"                             ; End quotes
+   )
+  "The regular expression for matching symbols to their help documentation.
+It is comprised of the symbol's context and the (quoted) symbol
+name.  The various groups of context regular expressions are
+matched in `info-make-xrefs' to distinct info buttons.")
+
+(defun info-check-type( type)
+  "Check if TYPE corresponds to the current search result.
+The function is used in `info-make-xrefs'."
+  (let* ((isc info-symbol-context)
+	 (n 3)                           ;embedded within 2 groups
+         (l (+ 3 (length isc))))
+    (while (and (not (eq type (caar isc) ) ) (< n l) )
+      (setq n (1+ n))
+      (setq isc (cdr isc)))
+    (match-string n)))
+
+\f
+;;;###autoload
+(defun info-make-xrefs (&optional buffer)
+  "Parse and hyperlink documentation cross-references in the given BUFFER.
+Find cross-reference information in a buffer and activate such
+cross references for selection with `help-follow'.  The current
+buffer is processed if the BUFFER argument is omitted.
+
+ Cross-references have the canonical (quoted) form `symbol-name'
+and the type of reference may be disambiguated by the preceding
+word(s) as compiled in `info-symbol-regexp'.  For example: Symbol
+names are receiving distinct variable buttons when preceeded by
+the words \"variable\" or \"option\".
+
+Variables are also detected when their names follow below form:
+
+ -- User Option: variable-name
+ -- Variable: ...
+
+Function names are also detected when prefixed by `M-x`, for
+example `M-x function-name` or are quoted and prefixed like `M-x
+function-name`.
+
+Function names are detected, as well, when appearing behind the
+following forms, which occur - for example - in the Elisp manual:
+
+ -- Special Form: function-name
+ -- Command: ...
+ -- Function: ...
+ -- Macro: ...
+
+The linking is similar to mechanisms from lisp/help.el."
+  (interactive "b")
+  (when (info-check-docu-p)
+    (with-current-buffer (or buffer (current-buffer))
+      (save-excursion
+        (goto-char (point-min))
+        (with-silent-modifications      ;hint from Stefan
+          (let ((case-fold-search t)
+                (inhibit-read-only t))
+            (with-syntax-table emacs-lisp-mode-syntax-table
+              ;; Quoted symbols
+              (save-excursion
+                (while (re-search-forward info-symbol-regexp nil t)
+                  (let* ((data (match-string (+ 3 (length info-symbol-context))))
+                         (sym (intern-soft data)))
+                    (if sym
+                        (cond
+                         ((info-check-type 'variable)
+                          (and (or (boundp sym)
+                                   (get sym 'variable-documentation))
+                               (info-button 8 'info-variable sym)))
+                         ((info-check-type 'function)
+                          (and (fboundp sym)
+                               (info-button 8 'info-function sym)))
+                         ((info-check-type 'face)
+                          (and (facep sym)
+                               (info-button 8 'info-face sym)))
+                         ((info-check-type 'ignore))
+                         ((info-check-type 'definition)
+                          (info-button 8 'info-function-def sym))
+                         ;; symbols
+                         ((cl-some (lambda (x) (funcall (nth 1 x) sym))
+                                   describe-symbol-backends)
+                          (info-button 8 'info-symbol sym)))))))
+              ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+              ;; (info "(elisp) Eval")
+              ;; Elisp manual      -- Special Form:
+              ;;                   -- Command:
+              ;;                   -- Function: function-name function
+              ;;                   -- Macro:
+              (save-excursion
+                (while (re-search-forward
+                        "-- \\(Special Form:\\|Command:\\|Function:\\|Macro:\\) "
+                        nil t)
+                  (looking-at "\\(\\sw\\|\\s_\\)+")
+                  (let ((sym (intern-soft (match-string 0))))
+                    (if (fboundp sym)
+                        (info-button 0 'info-function sym)))))
+              ;;              -- User Option:
+              ;;              -- Variable: variable-name
+              (save-excursion
+                (while (re-search-forward
+                        "-- \\(User Option:\\|Variable:\\) "
+                        nil t)
+                  (looking-at "\\(\\sw\\|\\s_\\)+")
+                  (let ((sym (intern-soft (match-string 0))))
+                    (if (boundp sym)
+                        (info-button 0 'info-variable sym)))))
+              ;; M-x prefixed functions
+              (save-excursion
+                (while (re-search-forward
+                        ;; Assume command name is only word and symbol
+                        ;; characters to get things like `use M-x foo->bar'.
+                        ;; Command required to end with word constituent
+                        ;; to avoid `.' at end of a sentence.
+                        ;; "\\<M-x\\s-+\\(\\sw\\(\\sw\\|\\s_\\)*\\sw\\)" nil t)
+                        ;; include M-x and quotes
+                        "['`‘]?M-x\\s-*\n?\\(\\sw\\(\\sw\\|\\s_\\)*\\sw\\)['’]?" nil t)
+                  (let ((sym (intern-soft (match-string 1))))
+                    (if (fboundp sym)
+                        (info-button 1 'info-function sym))))))))))))
+
 (provide 'info)
 
 ;;; info.el ends here
-- 
2.34.1


[-- Attachment #3: Type: text/plain, Size: 56 bytes --]


-- 
Best wishes
H. Dieter Wilhelm
Zwingenberg, Germany