RE: adding manual cross-ref links to *Help*

["Drew Adams" <drew.adams@oracle.com>]

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

> Adding cross-reference links is easier to do with Help buffer 
> templates that improves `Info-virtual-files'.  I'll submit a
> patch here soon.

Thanks.  It's fine if you implement the same features in a different way.  I
welcome the feature, however it's done.  I requested it at least as far back as
2006.  I finally got around to adding it to my own code, thanks to the virtual
indexing code that you added to Emacs.

I hope you will give users as much control over whether and when the indexes of
the manuals are searched, for this.

But your explanation is a bit vague.  What is this about Help buffer templates?
And what is not easy about just adding a line like this to each `describe-*'
command:

(Info-make-manuals-xref function) ; Link to manuals.

Yes, my overall patch is larger than that.  It could be much smaller if your
virtual indexing code allowed for links to more than one manual at a time.
Likewise, if index-entry matching could optionally use an exact match.  Those
two enhancements would I think be welcome in any case.

Anyway, my patch is attached, in case someone decides to go for it.

[-- Attachment #2: help-fns-2011-06-13.patch --]
[-- Type: application/octet-stream, Size: 2665 bytes --]

diff -c -w help-fns.el help-fns-patched-2011-06-13.el
*** help-fns.el	Mon Jun 13 09:36:56 2011
--- help-fns-patched-2011-06-13.el	Mon Jun 13 11:20:32 2011
***************
*** 212,217 ****
--- 212,242 ----
    :group 'help
    :version "23.2")
  
+ (defcustom help-cross-reference-manuals '(("emacs" "elisp"))
+   "*Manuals to search, for a `*Help*' buffer link to the manuals.
+ A cons.
+ 
+  The car is a list of manuals to search, or the symbol `all', to
+   search all.  If nil, then do not create a cross-reference link.
+ 
+  The cdr is a boolean:
+ 
+   Non-`nil' means search the manuals, then create a cross-ref link:
+         create it only if some search hits are found.
+ 
+   `nil' means create a cross-ref link without searching manuals
+         first (but only if there are some manuals to search)."
+   :set #'(lambda (sym defs)
+            (custom-set-default sym defs)
+            (setq Info-indexed-nodes  ()))
+   :type '(cons
+           (choice :tag "Which Manuals"
+            (repeat :tag "Specific Manuals (files)" string)
+            (const  :tag "All Manuals" all))
+           (boolean :tag "Search Before Creating Button?"))
+   :group 'help
+   :version "24.1")
+ 
  (defun help-highlight-arg (arg)
    "Highlight ARG as an argument name for a *Help* buffer.
  Return ARG in face `help-argument-name'; ARG is also downcased
***************
*** 586,593 ****
  			    (use (format ";\nuse `%s' instead." use))
  			    (t "."))
  		      "\n"))
! 	    (insert "\n"
! 		    (or doc "Not documented."))))))))
  
  \f
  ;; Variables
--- 611,619 ----
  			    (use (format ";\nuse `%s' instead." use))
  			    (t "."))
  		      "\n"))
! 	    (insert "\n")
!             (when doc (Info-make-manuals-xref function)) ; Link to manuals.
!             (insert (or doc "Not documented."))))))))
  
  \f
  ;; Variables
***************
*** 880,889 ****
  		  (princ output))))
  
  	    (with-current-buffer standard-output
  	      ;; Return the text we displayed.
  	      (buffer-string))))))))
  
- 
  ;;;###autoload
  (defun describe-syntax (&optional buffer)
    "Describe the syntax specifications in the syntax table of BUFFER.
--- 906,915 ----
  		  (princ output))))
  
  	    (with-current-buffer standard-output
+               (unless valvoid (Info-make-manuals-xref variable)) ; Link to manuals.
  	      ;; Return the text we displayed.
  	      (buffer-string))))))))
  
  ;;;###autoload
  (defun describe-syntax (&optional buffer)
    "Describe the syntax specifications in the syntax table of BUFFER.

Diff finished.  Mon Jun 13 11:46:48 2011

[-- Attachment #3: info-2011-06-13.patch --]
[-- Type: application/octet-stream, Size: 10070 bytes --]

diff -c -w info.el info-patched-2011-06-13.el
*** info.el	Mon Jun 13 09:44:32 2011
--- info-patched-2011-06-13.el	Mon Jun 13 13:54:26 2011
***************
*** 2151,2156 ****
--- 2151,2329 ----
    (Info-next-reference)
    (Info-next-reference))
  \f
+ (defvar Info-indexed-file "*Indexed*"
+   "Info file for virtual manual from `Info-index-entries-across-manuals'.")
+ 
+ (defvar Info-indexed-nodes ()
+   "Alist of cached nodes with matching index entries.
+ Each element is (NODENAME STRING MATCHES), where:
+  NODENAME is the name of the node that is indexed,
+  STRING is the search string passed to `Info-index-occurrences',
+  MATCHES is a list of index matches found by `Info-index-occurrences'.
+ 
+ This has the same structure as `Info-apropos-nodes', but the search
+ was made by `Info-index-occurrences', not by `Info-apropos-matches',
+ so that matches are exact.")
+ 
+ (defun Info-indexed-find-file (filename &optional _noerror)
+   "Index-search implementation of `Info-find-file'."
+   filename)
+ 
+ (defun Info-indexed-find-node (_filename nodename &optional _no-going-back)
+   "Index-search implementation of `Info-find-node-2'."
+   (let* ((nodeinfo  (assoc nodename Info-indexed-nodes))
+          (matches   (nth 2 nodeinfo)))
+     (when matches
+       (insert (format "\n\^_\nFile: %s,  Node: %s,  Up: Top\n\n" Info-indexed-file nodename))
+       (insert "Index Matches\n")
+       (insert "*************\n\n")
+       (insert "Index entries that match `" (nth 1 nodeinfo) "':\n\n")
+       (insert "\0\b[index\0\b]\n")
+       (if (eq matches t)
+           (insert "No matches found.\n")
+         (insert "* Menu:\n\n")
+         (dolist (entry  matches)
+           (insert (format "* %-38s (%s)%s.%s\n"  (format "%s [%s]:" (nth 1 entry) (nth 0 entry))
+                           (nth 0 entry)  (nth 2 entry)
+                           (if (nth 3 entry) (format " (line %s)" (nth 3 entry)) ""))))))))
+ 
+ (add-to-list 'Info-virtual-files '("\\`\\*Indexed\\*\\'"
+                                    (find-file . Info-indexed-find-file)
+                                    (find-node . Info-indexed-find-node)))
+ 
+ (defun Info-make-manuals-xref (symbol)
+   "Create a cross-ref link for index entries for SYMBOL in manuals.
+ `help-cross-reference-manuals' controls which manual(s) are searched.
+ Do nothing if its car is `nil' (no manuals to search).
+ If its cdr is `nil' then create the link without first searching any
+ manuals.  Otherwise, create the link only if there are search hits in
+ the manuals."
+   (when (car help-cross-reference-manuals) ; Create no link if no manuals to search.
+     (let ((manuals       (car help-cross-reference-manuals))
+           (search-now-p  (cdr help-cross-reference-manuals))
+           (symb-name     (if (stringp symbol) symbol (symbol-name symbol))))
+       (when (or (not search-now-p)
+                 (save-current-buffer (Info-any-index-occurrences-p symb-name manuals)))
+         (let ((buffer-read-only  nil))
+           (insert (format "\n\nFor more information %s the "
+                           (if (cdr help-cross-reference-manuals) "see" "check")))
+           (help-insert-xref-button "manuals" 'help-info-manual-lookup symb-name manuals)
+           (insert ".\n\n"))))))
+ 
+ (define-button-type 'help-info-manual-lookup
+     :supertype 'help-xref
+     'help-function #'(lambda (string &optional manuals)
+                        (Info-index-entries-across-manuals string manuals))
+     'help-echo "mouse-2, RET: Look it up in the manuals")
+ 
+ (defun Info-index-entries-across-manuals (string &optional manuals)
+   "Look up STRING in indexes of Info MANUALS on your system.
+ Looks for exact matches: STRING is expected to be an index entry.
+ Build an Info menu of the possible matches.
+ MANUALS has the form of `help-cross-reference-manuals'."
+   (let ((nodes  Info-indexed-nodes)
+         nodename)
+     (while (and nodes (not (equal string (nth 1 (car nodes)))))
+       (setq nodes  (cdr nodes)))
+     (if nodes
+         (Info-find-node Info-indexed-file (car (car nodes)))
+       (setq nodename  (format "Index for `%s'" string))
+       (push (list nodename string (Info-index-occurrences string manuals)) Info-indexed-nodes)
+       (Info-find-node Info-indexed-file nodename))))
+ 
+ ;; Similar to `Info-apropos-matches', but using exact matches. 
+ (defun Info-index-occurrences (index-entry &optional manuals)
+   "Collect occurrences of INDEX-ENTRY in MANUALS.
+ MANUALS has the form of `help-cross-reference-manuals'.
+ Return a list of the form ((FILE INDEX-ENTRY NODE LINE)), where:
+  FILE is the name of an Info file,
+  NODE is an Info node name,
+  LINE is the line number of the INDEX-ENTRY occurrence in that node."
+   (unless (string= index-entry "")
+     ;; Unlike `Info-apropos-matches', we match only the exact string as an index entry.
+     (let ((pattern  (format "\n\\* +\\([^\n]*%s\\):[ \t]+\\([^\n]+\\)\
+ \\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?"
+                             (regexp-quote index-entry)))
+           matches index-nodes node)
+       (message "Searching indexes of %s..." (if (eq manuals 'all)
+                                                 "all manuals"
+                                               (concat "manuals "
+                                                       (mapconcat #'identity manuals ", "))))
+       (condition-case nil
+           (with-temp-buffer
+             (Info-mode)
+             (Info-directory)
+             (goto-char (point-min))
+             (re-search-forward "\\* Menu: *\n" nil t)
+             (when (eq manuals 'all)
+               (setq manuals  ())
+               (let (manual)
+                 (while (re-search-forward "\\*.*: *(\\([^)]+\\))" nil t)
+                   ;; `add-to-list' ensures no dups in `manuals', so the `dolist' runs faster.
+                   (setq manual  (match-string 1))
+                   (set-text-properties 0 (length manual) nil manual)
+                   (add-to-list 'manuals manual))))
+             (dolist (manual  manuals)
+               (message "Searching indexes of manual `%s'..." manual)
+               (when (setq index-nodes  (Info-index-nodes (Info-find-file manual)))
+                 (Info-find-node manual (car index-nodes))
+                 (while (progn (goto-char (point-min))
+                               (while (re-search-forward pattern nil t)
+                                 (setq matches  (cons (list manual
+                                                            (match-string-no-properties 1)
+                                                            (match-string-no-properties 2)
+                                                            (match-string-no-properties 3))
+                                                      matches)))
+                               (setq index-nodes  (cdr index-nodes)
+                                     node         (car index-nodes)))
+                   (Info-goto-node node)))))
+         (error nil))
+       matches)))
+ 
+ ;; Like `Info-index-occurrences', but just return non-nil as soon as we know there is a match.
+ (defun Info-any-index-occurrences-p (index-entry &optional manuals)
+   "Return non-nil if there are any occurrences of INDEX-ENTRY in MANUALS.
+ MANUALS has the form of `help-cross-reference-manuals'."
+   (and (not (string= index-entry ""))
+        ;; Unlike `Info-apropos-matches', we match only the exact string as an index entry.
+        (let ((pattern  (format "\n\\* +\\([^\n]*%s\\):[ \t]+\\([^\n]+\\)\
+ \\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?"
+                                (regexp-quote index-entry)))
+              (any?     nil)
+              index-nodes node)
+          (message "Searching indexes of %s..." (if (eq manuals 'all)
+                                                    "all manuals"
+                                                  (concat "manuals "
+                                                          (mapconcat #'identity manuals ", "))))
+          (condition-case nil
+              (with-temp-buffer
+                (Info-mode)
+                (Info-directory)
+                (goto-char (point-min))
+                (re-search-forward "\\* Menu: *\n" nil t)
+                (when (eq manuals 'all)
+                  (setq manuals  ())
+                  (let (manual)
+                    (while (re-search-forward "\\*.*: *(\\([^)]+\\))" nil t)
+                      ;; `add-to-list' ensures no dups in `manuals', so the `dolist' runs faster.
+                      (setq manual  (match-string 1))
+                      (set-text-properties 0 (length manual) nil manual)
+                      (add-to-list 'manuals manual))))
+                (setq any?  (catch 'Info-any-index-occurrences-p
+                              (dolist (manual  manuals)
+                                (message "Searching indexes of manual `%s'..." manual)
+                                (when (setq index-nodes  (Info-index-nodes (Info-find-file manual)))
+                                  (Info-find-node manual (car index-nodes))
+                                  (while (progn (goto-char (point-min))
+                                                (when (re-search-forward pattern nil t)
+                                                  (throw 'Info-any-index-occurrences-p t))
+                                                (setq index-nodes  (cdr index-nodes)
+                                                      node         (car index-nodes)))
+                                    (Info-goto-node node))))
+                              nil)))
+            (error nil))
+          any?)))
+ \f
  (add-to-list 'Info-virtual-nodes
  	     '("\\`\\*TOC\\*\\'"
  	       (find-node . Info-toc-find-node)

Diff finished.  Mon Jun 13 13:54:47 2011