ChangeLog fixes
[bpt/emacs.git] / lisp / info.el
CommitLineData
baa7f3de 1;; info.el --- info package for Emacs
e5167999 2
ba318903 3;; Copyright (C) 1985-1986, 1992-2014 Free Software Foundation, Inc.
3a801d0c 4
e5167999 5;; Maintainer: FSF
fd7fa35a 6;; Keywords: help
e5167999 7
a384cab3
JB
8;; This file is part of GNU Emacs.
9
eb3fa2cf 10;; GNU Emacs is free software: you can redistribute it and/or modify
a384cab3 11;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
a384cab3
JB
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
eb3fa2cf 21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
a384cab3 22
e5167999
ER
23;;; Commentary:
24
185cff95 25;; Note that nowadays we expect Info files to be made using makeinfo.
921e5fe6
TTN
26;; In particular we make these assumptions:
27;; - a menu item MAY contain colons but not colon-space ": "
28;; - a menu item ending with ": " (but not ":: ") is an index entry
29;; - a node name MAY NOT contain a colon
505b68d5
TTN
30;; This distinction is to support indexing of computer programming
31;; language terms that may contain ":" but not ": ".
e5167999
ER
32
33;;; Code:
34
ded3e3d8 35(defgroup info nil
fc039bdc 36 "Info subsystem."
ded3e3d8
RS
37 :group 'help
38 :group 'docs)
39
40
a384cab3 41(defvar Info-history nil
185cff95 42 "Stack of Info nodes user has visited.
db90d225 43Each element of the stack is a list (FILENAME NODENAME BUFFERPOS).")
a384cab3 44
424b9d3e 45(defvar Info-history-forward nil
185cff95 46 "Stack of Info nodes user has visited with `Info-history-back' command.
db90d225 47Each element of the stack is a list (FILENAME NODENAME BUFFERPOS).")
424b9d3e 48
8a7757f6 49(defvar Info-history-list nil
185cff95 50 "List of all Info nodes user has visited.
db90d225 51Each element of the list is a list (FILENAME NODENAME).")
8a7757f6 52
3820edeb
JL
53(defcustom Info-history-skip-intermediate-nodes t
54 "Non-nil means don't record intermediate Info nodes to the history.
55Intermediate Info nodes are nodes visited by Info internally in the process of
56searching the node to display. Intermediate nodes are not presented
57to the user."
58 :type 'boolean
59 :group 'info
60 :version "24.1")
61
67f445d7 62(defvar Info-enable-active-nodes nil
a384cab3
JB
63 "Non-nil allows Info to execute Lisp code associated with nodes.
64The Lisp code is executed when the node is selected.")
67f445d7 65(put 'Info-enable-active-nodes 'risky-local-variable t)
a384cab3 66
93480d70 67(defface info-node
508bce68
SM
68 '((((class color) (background light)) :foreground "brown" :weight bold :slant italic)
69 (((class color) (background dark)) :foreground "white" :weight bold :slant italic)
70 (t :weight bold :slant italic))
93480d70
RS
71 "Face for Info node names."
72 :group 'info)
73
185cff95
JL
74(defface info-title-1
75 '((((type tty pc) (class color) (background light))
76 :foreground "green" :weight bold)
77 (((type tty pc) (class color) (background dark))
78 :foreground "yellow" :weight bold)
79 (t :height 1.2 :inherit info-title-2))
80 "Face for info titles at level 1."
81 :group 'info)
c4f6e489 82(define-obsolete-face-alias 'Info-title-1-face 'info-title-1 "22.1")
185cff95
JL
83
84(defface info-title-2
85 '((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
86 (t :height 1.2 :inherit info-title-3))
87 "Face for info titles at level 2."
88 :group 'info)
c4f6e489 89(define-obsolete-face-alias 'Info-title-2-face 'info-title-2 "22.1")
185cff95
JL
90
91(defface info-title-3
92 '((((type tty pc) (class color)) :weight bold)
93 (t :height 1.2 :inherit info-title-4))
94 "Face for info titles at level 3."
95 :group 'info)
c4f6e489 96(define-obsolete-face-alias 'Info-title-3-face 'info-title-3 "22.1")
185cff95
JL
97
98(defface info-title-4
99 '((((type tty pc) (class color)) :weight bold)
100 (t :weight bold :inherit variable-pitch))
101 "Face for info titles at level 4."
102 :group 'info)
c4f6e489 103(define-obsolete-face-alias 'Info-title-4-face 'info-title-4 "22.1")
185cff95
JL
104
105(defface info-menu-header
106 '((((type tty pc))
107 :underline t
108 :weight bold)
109 (t
110 :inherit variable-pitch
111 :weight bold))
112 "Face for headers in Info menus."
113 :group 'info)
114
115(defface info-menu-star
508bce68
SM
116 '((((class color)) :foreground "red1")
117 (t :underline t))
ccfb7415 118 "Face for every third `*' in an Info menu."
93480d70 119 :group 'info)
c33d614d 120(define-obsolete-face-alias 'info-menu-5 'info-menu-star "22.1")
93480d70
RS
121
122(defface info-xref
de8ad208
JL
123 '((t :inherit link))
124 "Face for unvisited Info cross-references."
93480d70
RS
125 :group 'info)
126
8a7757f6 127(defface info-xref-visited
fd5b25da 128 '((t :inherit (link-visited info-xref)))
8a7757f6 129 "Face for visited Info cross-references."
de8ad208 130 :version "22.1"
8a7757f6
JL
131 :group 'info)
132
133(defcustom Info-fontify-visited-nodes t
9201cc28 134 "Non-nil to fontify references to visited nodes in `info-xref-visited' face."
bf247b6e 135 :version "22.1"
8a7757f6
JL
136 :type 'boolean
137 :group 'info)
138
7a7821c2 139(defcustom Info-fontify-maximum-menu-size 100000
9201cc28 140 "Maximum size of menu to fontify if `font-lock-mode' is non-nil.
3d0fc0b7 141Set to nil to disable node fontification."
ded3e3d8
RS
142 :type 'integer
143 :group 'info)
bdf62a4d 144
50ac70af 145(defcustom Info-use-header-line t
9201cc28 146 "Non-nil means to put the beginning-of-node links in an Emacs header-line.
50ac70af
MB
147A header-line does not scroll with the rest of the buffer."
148 :type 'boolean
149 :group 'info)
150
151(defface info-header-xref
508bce68 152 '((t :inherit info-xref))
50ac70af
MB
153 "Face for Info cross-references in a node header."
154 :group 'info)
155
156(defface info-header-node
508bce68 157 '((t :inherit info-node))
50ac70af
MB
158 "Face for Info nodes in a node header."
159 :group 'info)
160
e38e6780
JL
161(defface info-index-match
162 '((t :inherit match))
163 "Face used to highlight matches in an index entry."
164 :group 'info
165 :version "24.4")
166
1ba6038a
GM
167;; This is a defcustom largely so that we can get the benefit
168;; of custom-initialize-delay. Perhaps it would work to make it a
169;; defvar and explicitly give it a standard-value property, and
170;; call custom-initialize-delay on it.
171;; The progn forces the autoloader to include the whole thing, not
172;; just an abbreviated version.
173;;;###autoload
174(progn
175(defcustom Info-default-directory-list
176 (let* ((config-dir
177 (file-name-as-directory
178 ;; Self-contained NS build with info/ in the app-bundle.
179 (or (and (featurep 'ns)
180 (let ((dir (expand-file-name "../info" data-directory)))
181 (if (file-directory-p dir) dir)))
182 configure-info-directory)))
183 (prefixes
184 ;; Directory trees in which to look for info subdirectories
185 (prune-directory-list '("/usr/local/" "/usr/" "/opt/" "/")))
186 (suffixes
187 ;; Subdirectories in each directory tree that may contain info
188 ;; directories. Most of these are rather outdated.
189 ;; It ought to be fine to stop checking the "emacs" ones now,
190 ;; since this is Emacs and we have not installed info files
191 ;; into such directories for a looong time...
192 '("share/" "" "gnu/" "gnu/lib/" "gnu/lib/emacs/"
193 "emacs/" "lib/" "lib/emacs/"))
194 (standard-info-dirs
195 (apply #'nconc
196 (mapcar (lambda (pfx)
197 (let ((dirs
198 (mapcar (lambda (sfx)
199 (concat pfx sfx "info/"))
200 suffixes)))
201 (prune-directory-list dirs)))
202 prefixes)))
203 ;; If $(prefix)/share/info is not one of the standard info
204 ;; directories, they are probably installing an experimental
205 ;; version of Emacs, so make sure that experimental version's Info
206 ;; files override the ones in standard directories.
207 (dirs
208 (if (member config-dir standard-info-dirs)
209 ;; FIXME? What is the point of adding it again at the end
210 ;; when it is already present earlier in the list?
211 (nconc standard-info-dirs (list config-dir))
212 (cons config-dir standard-info-dirs))))
213 (if (not (eq system-type 'windows-nt))
214 dirs
215 ;; Include the info directory near where Emacs executable was installed.
216 (let* ((instdir (file-name-directory invocation-directory))
217 (dir1 (expand-file-name "../info/" instdir))
218 (dir2 (expand-file-name "../../../info/" instdir)))
219 (cond ((file-exists-p dir1) (append dirs (list dir1)))
220 ((file-exists-p dir2) (append dirs (list dir2)))
221 (t dirs)))))
222
223 "Default list of directories to search for Info documentation files.
224They are searched in the order they are given in the list.
225Therefore, the directory of Info files that come with Emacs
226normally should come last (so that local files override standard ones),
227unless Emacs is installed into a non-standard directory. In the latter
228case, the directory of Info files that come with Emacs should be
229first in this list.
230
231Once Info is started, the list of directories to search
232comes from the variable `Info-directory-list'.
233This variable `Info-default-directory-list' is used as the default
234for initializing `Info-directory-list' when Info is started, unless
235the environment variable INFOPATH is set.
236
237Although this is a customizable variable, that is mainly for technical
238reasons. Normally, you should either set INFOPATH or customize
239`Info-additional-directory-list', rather than changing this variable."
240 :initialize 'custom-initialize-delay
241 :type '(repeat directory)
242 :group 'info))
243
7d3766a8 244(defvar Info-directory-list nil
a384cab3 245 "List of directories to search for Info documentation files.
fc4d14c5 246If nil, meaning not yet initialized, Info uses the environment
44c327f9 247variable INFOPATH to initialize it, or `Info-default-directory-list'
dde7f979 248if there is no INFOPATH variable in the environment, or the
6194c800 249concatenation of the two if INFOPATH ends with a `path-separator'.
778911b9
EZ
250
251When `Info-directory-list' is initialized from the value of
4dddb0b7
EZ
252`Info-default-directory-list', and Emacs is installed in one of the
253standard directories, the directory of Info files that come with Emacs
254is put last (so that local Info files override standard ones).
255
256When `Info-directory-list' is initialized from the value of
257`Info-default-directory-list', and Emacs is not installed in one
258of the standard directories, the first element of the resulting
778911b9
EZ
259list is the directory where Emacs installs the Info files that
260come with it. This is so that Emacs's own manual, which suits the
4dddb0b7
EZ
261version of Emacs you are using, will always be found first. This
262is useful when you install an experimental version of Emacs without
263removing the standard installation.
264
265If you want to override the order of directories in
266`Info-default-directory-list', set INFOPATH in the environment.
5da0f945
RS
267
268If you run the Emacs executable from the `src' directory in the Emacs
778911b9
EZ
269source tree, and INFOPATH is not defined, the `info' directory in the
270source tree is used as the first element of `Info-directory-list', in
271place of the installation Info directory. This is useful when you run
272a version of Emacs without installing it.")
a384cab3 273
ded3e3d8 274(defcustom Info-additional-directory-list nil
bdf62a4d 275 "List of additional directories to search for Info documentation files.
e9b1d996 276These directories are searched after those in `Info-directory-list'."
ded3e3d8
RS
277 :type '(repeat directory)
278 :group 'info)
bdf62a4d 279
610bc96b 280(defcustom Info-scroll-prefer-subnodes nil
9201cc28 281 "If non-nil, \\<Info-mode-map>\\[Info-scroll-up] in a menu visits subnodes.
185cff95 282
7a53d8c8
EZ
283If this is non-nil, and you scroll far enough in a node that its menu
284appears on the screen, the next \\<Info-mode-map>\\[Info-scroll-up]
285moves to a subnode indicated by the following menu item. This means
286that you visit a subnode before getting to the end of the menu.
287
288Setting this option to nil results in behavior similar to the stand-alone
289Info reader program, which visits the first subnode from the menu only
290when you hit the end of the current node."
bf247b6e 291 :version "22.1"
7a53d8c8
EZ
292 :type 'boolean
293 :group 'info)
294
a9efebd0 295(defcustom Info-hide-note-references t
9201cc28 296 "If non-nil, hide the tag and section reference in *note and * menu items.
8a7757f6 297If value is non-nil but not `hide', also replaces the \"*note\" with \"see\".
185cff95 298If value is non-nil but not t or `hide', the reference section is still shown.
a0b8485f
GM
299`nil' completely disables this feature. If this is non-nil, you might
300want to set `Info-refill-paragraphs'."
bf247b6e 301 :version "22.1"
8a7757f6 302 :type '(choice (const :tag "No hiding" nil)
0452a274 303 (const :tag "Replace tag and hide reference" t)
8a7757f6
JL
304 (const :tag "Hide tag and reference" hide)
305 (other :tag "Only replace tag" tag))
3ffbc301
JL
306 :set (lambda (sym val)
307 (set sym val)
308 (dolist (buffer (buffer-list))
309 (with-current-buffer buffer
310 (when (eq major-mode 'Info-mode)
311 (revert-buffer t t)))))
a9efebd0
KS
312 :group 'info)
313
bb1e1730 314(defcustom Info-refill-paragraphs nil
9201cc28 315 "If non-nil, attempt to refill paragraphs with hidden references.
185cff95 316This refilling may accidentally remove explicit line breaks in the Info
a0b8485f
GM
317file, so be prepared for a few surprises if you enable this feature.
318This only has an effect if `Info-hide-note-references' is non-nil."
bf247b6e 319 :version "22.1"
bb1e1730
KS
320 :type 'boolean
321 :group 'info)
322
66fc722f
JL
323(defcustom Info-breadcrumbs-depth 4
324 "Depth of breadcrumbs to display.
3250 means do not display breadcrumbs."
dbd6da78
JL
326 :version "23.1"
327 :type 'integer
328 :group 'info)
66fc722f 329
180ee7c7 330(defcustom Info-search-whitespace-regexp "\\s-+"
9201cc28 331 "If non-nil, regular expression to match a sequence of whitespace chars.
8a7757f6
JL
332This applies to Info search for regular expressions.
333You might want to use something like \"[ \\t\\r\\n]+\" instead.
334In the Customization buffer, that is `[' followed by a space,
335a tab, a carriage return (control-M), a newline, and `]+'."
336 :type 'regexp
337 :group 'info)
338
98e77be5 339(defcustom Info-isearch-search t
9201cc28 340 "If non-nil, isearch in Info searches through multiple nodes.
6270bbe7 341Before leaving the initial Info node, where isearch was started,
242c0a95 342it fails once with the error message [end of node], and with
6270bbe7
JL
343subsequent C-s/C-r continues through other nodes without failing
344with this error message in other nodes. When isearch fails for
242c0a95
JL
345the rest of the manual, it displays the error message [end of manual],
346wraps around the whole manual and restarts the search from the top/final
347node depending on search direction.
6270bbe7
JL
348
349Setting this option to nil restores the default isearch behavior
350with wrapping around the current Info node."
98e77be5
JL
351 :version "22.1"
352 :type 'boolean
353 :group 'info)
354
d457219d 355(defvar Info-isearch-initial-node nil)
4bbedd98
JL
356(defvar Info-isearch-initial-history nil)
357(defvar Info-isearch-initial-history-list nil)
d457219d 358
dde7f979
SM
359(defcustom Info-mode-hook
360 ;; Try to obey obsolete Info-fontify settings.
361 (unless (and (boundp 'Info-fontify) (null Info-fontify))
362 '(turn-on-font-lock))
8a7757f6
JL
363 "Hooks run when `Info-mode' is called."
364 :type 'hook
365 :group 'info)
366
367(defcustom Info-selection-hook nil
368 "Hooks run when `Info-select-node' is called."
544e5562
CW
369 :type 'hook
370 :group 'info)
371
8a7757f6
JL
372(defvar Info-edit-mode-hook nil
373 "Hooks run when `Info-edit-mode' is called.")
374
5313bbc7
GM
375(make-obsolete-variable 'Info-edit-mode-hook
376 "editing Info nodes by hand is not recommended." "24.4")
377
a384cab3 378(defvar Info-current-file nil
d6be34f3
RS
379 "Info file that Info is now looking at, or nil.
380This is the name that was specified in Info, not the actual file name.
d590dbd2 381It doesn't contain directory names or file name extensions added by Info.")
a384cab3
JB
382
383(defvar Info-current-subfile nil
fdf4b680 384 "Info subfile that is actually in the *info* buffer now.
ef9644f5 385It is nil if current Info file is not split into subfiles.")
a384cab3
JB
386
387(defvar Info-current-node nil
388 "Name of node that Info is now looking at, or nil.")
389
c5fe2ff1 390(defvar Info-tag-table-marker nil
a384cab3
JB
391 "Marker pointing at beginning of current Info file's tag table.
392Marker points nowhere if file has no tag table.")
393
c5fe2ff1
RS
394(defvar Info-tag-table-buffer nil
395 "Buffer used for indirect tag tables.")
396
552775bd
RS
397(defvar Info-current-file-completions nil
398 "Cached completion list for current Info file.")
399
313f39aa
JL
400(defvar Info-file-completions nil
401 "Cached completion alist of visited Info files.
402Each element of the alist is (FILE . COMPLETIONS)")
403
94b10022
JL
404(defvar Info-file-supports-index-cookies nil
405 "Non-nil if current Info file supports index cookies.")
406
66fc722f
JL
407(defvar Info-file-supports-index-cookies-list nil
408 "List of Info files with information about index cookies support.
409Each element of the list is a list (FILENAME SUPPORTS-INDEX-COOKIES)
410where SUPPORTS-INDEX-COOKIES can be either t or nil.")
411
1143a6b0 412(defvar Info-index-alternatives nil
fdf4b680 413 "List of possible matches for last `Info-index' command.")
1143a6b0 414
836bb478
JL
415(defvar Info-point-loc nil
416 "Point location within a selected node.
417If string, the point is moved to the proper occurrence of the
418name of the followed cross reference within a selected node.
419If number, the point is moved to the corresponding line.")
8a7757f6 420
552775bd
RS
421(defvar Info-standalone nil
422 "Non-nil if Emacs was started solely as an Info browser.")
6a013a49 423
64cde199
JL
424(defvar Info-file-attributes nil
425 "Alist of file attributes of visited Info files.
426Each element is a list (FILE-NAME FILE-ATTRIBUTES...).")
427
428(defvar Info-toc-nodes nil
429 "Alist of cached parent-children node information in visited Info files.
430Each element is (FILE (NODE-NAME PARENT SECTION CHILDREN) ...)
431where PARENT is the parent node extracted from the Up pointer,
432SECTION is the section name in the Top node where this node is placed,
433CHILDREN is a list of child nodes extracted from the node menu.")
434
435(defvar Info-index-nodes nil
436 "Alist of cached index node names of visited Info files.
437Each element has the form (INFO-FILE INDEX-NODE-NAMES-LIST).")
438
6a013a49
JL
439(defvar Info-virtual-files nil
440 "List of definitions of virtual Info files.
441Each element of the list has the format (FILENAME (OPERATION . HANDLER) ...)
442where FILENAME is a regexp that matches a class of virtual Info file names.
443It should be carefully chosen to not cause file name clashes with
444existing file names. OPERATION is one of the following operation
445symbols `find-file', `find-node', `toc-nodes' that define what HANDLER
446function to call instead of calling the default corresponding function
447to override it.")
448
449(defvar Info-virtual-nodes nil
450 "List of definitions of virtual Info nodes.
451Each element of the list has the format (NODENAME (OPERATION . HANDLER) ...)
452where NODENAME is a regexp that matches a class of virtual Info node names.
453It should be carefully chosen to not cause node name clashes with
454existing node names. OPERATION is one of the following operation
6194c800
JB
455symbols `find-node' that define what HANDLER function to call instead
456of calling the default corresponding function to override it.")
6a013a49
JL
457
458(defvar Info-current-node-virtual nil
459 "Non-nil if the current Info node is virtual.")
460
461(defun Info-virtual-file-p (filename)
462 "Check if Info file FILENAME is virtual."
463 (Info-virtual-fun 'find-file filename nil))
464
465(defun Info-virtual-fun (op filename nodename)
466 "Find a function that handles operations on virtual manuals.
467OP is an operation symbol (`find-file', `find-node' or `toc-nodes'),
468FILENAME is a virtual Info file name, NODENAME is a virtual Info
469node name. Return a function found either in `Info-virtual-files'
470or `Info-virtual-nodes'."
471 (or (and (stringp filename) ; some legacy code can still use a symbol
472 (cdr-safe (assoc op (assoc-default filename
473 Info-virtual-files
474 'string-match))))
475 (and (stringp nodename) ; some legacy code can still use a symbol
476 (cdr-safe (assoc op (assoc-default nodename
477 Info-virtual-nodes
478 'string-match))))))
479
480(defun Info-virtual-call (virtual-fun &rest args)
481 "Call a function that handles operations on virtual manuals."
482 (when (functionp virtual-fun)
483 (or (apply virtual-fun args) t)))
484
7d3766a8 485\f
bd0c9168 486(defvar Info-suffix-list
3c19e6c1
RS
487 ;; The MS-DOS list should work both when long file names are
488 ;; supported (Windows 9X), and when only 8+3 file names are available.
bd0c9168 489 (if (eq system-type 'ms-dos)
6194c800
JB
490 '( (".gz" . "gunzip")
491 (".z" . "gunzip")
492 (".bz2" . ("bzip2" "-dc"))
493 (".inz" . "gunzip")
494 (".igz" . "gunzip")
495 (".info.Z" . "gunzip")
496 (".info.gz" . "gunzip")
497 ("-info.Z" . "gunzip")
498 ("-info.gz" . "gunzip")
499 ("/index.gz" . "gunzip")
500 ("/index.z" . "gunzip")
501 (".inf" . nil)
502 (".info" . nil)
503 ("-info" . nil)
504 ("/index" . nil)
505 ("" . nil))
506 '( (".info.Z" . "uncompress")
507 (".info.Y" . "unyabba")
508 (".info.gz" . "gunzip")
509 (".info.z" . "gunzip")
510 (".info.bz2" . ("bzip2" "-dc"))
511 (".info.xz" . "unxz")
512 (".info" . nil)
513 ("-info.Z" . "uncompress")
514 ("-info.Y" . "unyabba")
515 ("-info.gz" . "gunzip")
516 ("-info.bz2" . ("bzip2" "-dc"))
517 ("-info.z" . "gunzip")
518 ("-info.xz" . "unxz")
519 ("-info" . nil)
520 ("/index.Z" . "uncompress")
521 ("/index.Y" . "unyabba")
522 ("/index.gz" . "gunzip")
523 ("/index.z" . "gunzip")
524 ("/index.bz2" . ("bzip2" "-dc"))
525 ("/index.xz" . "unxz")
526 ("/index" . nil)
527 (".Z" . "uncompress")
528 (".Y" . "unyabba")
529 (".gz" . "gunzip")
530 (".z" . "gunzip")
531 (".bz2" . ("bzip2" "-dc"))
532 (".xz" . "unxz")
533 ("" . nil)))
1143a6b0
ER
534 "List of file name suffixes and associated decoding commands.
535Each entry should be (SUFFIX . STRING); the file is given to
544e210f
KH
536the command as standard input.
537
538STRING may be a list of strings. In that case, the first element is
539the command name, and the rest are arguments to that command.
540
541If STRING is nil, no decoding is done.
97f99202
KH
542Because the SUFFIXes are tried in order, the empty string should
543be last in the list.")
1143a6b0 544
c8e9dd54 545;; Concatenate SUFFIX onto FILENAME. SUFFIX should start with a dot.
e0c1e774
EZ
546;; First, on MS-DOS with no long file names support, delete some of
547;; the extension in FILENAME to make room.
548(defun info-insert-file-contents-1 (filename suffix lfn)
549 (if lfn ; long file names are supported
bd0c9168
RS
550 (concat filename suffix)
551 (let* ((sans-exts (file-name-sans-extension filename))
c8e9dd54
RS
552 ;; How long is the extension in FILENAME (not counting the dot).
553 (ext-len (max 0 (- (length filename) (length sans-exts) 1)))
554 ext-left)
9b842cab 555 ;; SUFFIX starts with a dot. If FILENAME already has one,
1583fe94 556 ;; get rid of the one in SUFFIX (unless suffix is empty).
c8e9dd54 557 (or (and (<= ext-len 0)
9b842cab 558 (not (eq (aref filename (1- (length filename))) ?.)))
1583fe94 559 (= (length suffix) 0)
9b842cab 560 (setq suffix (substring suffix 1)))
c8e9dd54
RS
561 ;; How many chars of that extension should we keep?
562 (setq ext-left (min ext-len (max 0 (- 3 (length suffix)))))
bd0c9168
RS
563 ;; Get rid of the rest of the extension, and add SUFFIX.
564 (concat (substring filename 0 (- (length filename)
565 (- ext-len ext-left)))
566 suffix))))
567
9c7924d5
RS
568(defun info-file-exists-p (filename)
569 (and (file-exists-p filename)
570 (not (file-directory-p filename))))
571
1143a6b0 572(defun info-insert-file-contents (filename &optional visit)
185cff95 573 "Insert the contents of an Info file in the current buffer.
1143a6b0 574Do the right thing if the file has been compressed or zipped."
e0c1e774 575 (let* ((tail Info-suffix-list)
a2014063 576 (jka-compr-verbose nil)
ab5a535c
KS
577 (lfn (if (fboundp 'msdos-long-file-names)
578 (msdos-long-file-names)
579 t))
e0c1e774
EZ
580 (check-short (and (fboundp 'msdos-long-file-names)
581 lfn))
582 fullname decoder done)
b8fa4e87 583 (if (info-file-exists-p filename)
bd0c9168
RS
584 ;; FILENAME exists--see if that name contains a suffix.
585 ;; If so, set DECODE accordingly.
97f99202
KH
586 (progn
587 (while (and tail
588 (not (string-match
589 (concat (regexp-quote (car (car tail))) "$")
590 filename)))
591 (setq tail (cdr tail)))
592 (setq fullname filename
593 decoder (cdr (car tail))))
bd0c9168 594 ;; Try adding suffixes to FILENAME and see if we can find something.
e0c1e774
EZ
595 (while (and tail (not done))
596 (setq fullname (info-insert-file-contents-1 filename
597 (car (car tail)) lfn))
598 (if (info-file-exists-p fullname)
599 (setq done t
600 ;; If we found a file with a suffix, set DECODER
601 ;; according to the suffix.
602 decoder (cdr (car tail)))
603 ;; When the MS-DOS port runs on Windows, we need to check
604 ;; the short variant of a long file name as well.
605 (when check-short
606 (setq fullname (info-insert-file-contents-1 filename
607 (car (car tail)) nil))
608 (if (info-file-exists-p fullname)
609 (setq done t
610 decoder (cdr (car tail))))))
97f99202 611 (setq tail (cdr tail)))
97f99202 612 (or tail
bd0c9168 613 (error "Can't find %s or any compressed version of it" filename)))
e175bda2 614 ;; check for conflict with jka-compr
70746649 615 (if (and (jka-compr-installed-p)
e175bda2
RS
616 (jka-compr-get-compression-info fullname))
617 (setq decoder nil))
97f99202 618 (if decoder
3c19e6c1
RS
619 (progn
620 (insert-file-contents-literally fullname visit)
e8dab975 621 (let ((inhibit-read-only t)
3c19e6c1 622 (coding-system-for-write 'no-conversion)
8b5e8b42 623 (inhibit-null-byte-detection t) ; Index nodes include null bytes
3c19e6c1
RS
624 (default-directory (or (file-name-directory fullname)
625 default-directory)))
544e210f
KH
626 (or (consp decoder)
627 (setq decoder (list decoder)))
628 (apply 'call-process-region (point-min) (point-max)
629 (car decoder) t t nil (cdr decoder))))
8b5e8b42 630 (let ((inhibit-null-byte-detection t)) ; Index nodes include null bytes
64cde199
JL
631 (insert-file-contents fullname visit)))
632
633 ;; Clear the caches of modified Info files.
634 (let* ((attribs-old (cdr (assoc fullname Info-file-attributes)))
635 (modtime-old (and attribs-old (nth 5 attribs-old)))
636 (attribs-new (and (stringp fullname) (file-attributes fullname)))
637 (modtime-new (and attribs-new (nth 5 attribs-new))))
638 (when (and modtime-old modtime-new
639 (> (float-time modtime-new) (float-time modtime-old)))
640 (setq Info-index-nodes (remove (assoc (or Info-current-file filename)
641 Info-index-nodes)
642 Info-index-nodes))
643 (setq Info-toc-nodes (remove (assoc (or Info-current-file filename)
644 Info-toc-nodes)
645 Info-toc-nodes)))
646 ;; Add new modtime to `Info-file-attributes'.
647 (setq Info-file-attributes
648 (cons (cons fullname attribs-new)
649 (remove (assoc fullname Info-file-attributes)
650 Info-file-attributes))))))
66fc722f
JL
651
652(defun Info-file-supports-index-cookies (&optional file)
653 "Return non-nil value if FILE supports Info index cookies.
654Info index cookies were first introduced in 4.7, and all later
2a567197 655makeinfo versions output them in index nodes, so we can rely
66fc722f
JL
656solely on the makeinfo version. This function caches the information
657in `Info-file-supports-index-cookies-list'."
658 (or file (setq file Info-current-file))
659 (or (assoc file Info-file-supports-index-cookies-list)
660 ;; Skip virtual Info files
661 (and (or (not (stringp file))
6a013a49 662 (Info-virtual-file-p file))
66fc722f
JL
663 (setq Info-file-supports-index-cookies-list
664 (cons (cons file nil) Info-file-supports-index-cookies-list)))
665 (save-excursion
666 (let ((found nil))
667 (goto-char (point-min))
668 (condition-case ()
669 (if (and (re-search-forward
670 "makeinfo[ \n]version[ \n]\\([0-9]+.[0-9]+\\)"
c9384295 671 (line-beginning-position 4) t)
66fc722f
JL
672 (not (version< (match-string 1) "4.7")))
673 (setq found t))
674 (error nil))
675 (setq Info-file-supports-index-cookies-list
676 (cons (cons file found) Info-file-supports-index-cookies-list)))))
677 (cdr (assoc file Info-file-supports-index-cookies-list)))
678
7d3766a8 679\f
3a59b662
SM
680(defun Info-default-dirs ()
681 (let ((source (expand-file-name "info/" source-directory))
682 (sibling (if installation-directory
683 (expand-file-name "info/" installation-directory)
684 (if invocation-directory
685 (let ((infodir (expand-file-name
41a1027e 686 "../share/info/"
3a59b662
SM
687 invocation-directory)))
688 (if (file-exists-p infodir)
689 infodir
690 (setq infodir (expand-file-name
41a1027e 691 "../../../share/info/"
3a59b662
SM
692 invocation-directory))
693 (and (file-exists-p infodir)
694 infodir))))))
695 alternative)
696 (setq alternative
697 (if (and sibling (file-exists-p sibling))
698 ;; Uninstalled, Emacs builddir != srcdir.
699 sibling
700 ;; Uninstalled, builddir == srcdir
701 source))
702 (if (or (member alternative Info-default-directory-list)
703 ;; On DOS/NT, we use movable executables always,
704 ;; and we must always find the Info dir at run time.
705 (if (memq system-type '(ms-dos windows-nt))
706 nil
707 ;; Use invocation-directory for Info
708 ;; only if we used it for exec-directory also.
709 (not (string= exec-directory
710 (expand-file-name "lib-src/"
711 installation-directory))))
712 (not (file-exists-p alternative)))
713 Info-default-directory-list
714 ;; `alternative' contains the Info files that came with this
715 ;; version, so we should look there first. `Info-insert-dir'
716 ;; currently expects to find `alternative' first on the list.
717 (cons alternative
a025fccf
SM
718 ;; Don't drop the last part, it might contain non-Emacs stuff.
719 ;; (reverse (cdr (reverse
720 Info-default-directory-list)))) ;; )))
3a59b662 721
7d3766a8 722(defun info-initialize ()
fdf4b680 723 "Initialize `Info-directory-list', if that hasn't been done yet."
7d3766a8 724 (unless Info-directory-list
e6ce307c
RS
725 (let ((path (getenv "INFOPATH"))
726 (sep (regexp-quote path-separator)))
7d3766a8 727 (setq Info-directory-list
78e7e8a0
MB
728 (prune-directory-list
729 (if path
e6ce307c
RS
730 (if (string-match-p (concat sep "\\'") path)
731 (append (split-string (substring path 0 -1) sep)
3a59b662 732 (Info-default-dirs))
e6ce307c 733 (split-string path sep))
eb7afdad 734 (Info-default-dirs))))
dad6fae7
GM
735 ;; If we are running uninstalled, our own Info files should
736 ;; always come first. If INFOPATH was set, they might not.
737 (and path
738 installation-directory
739 (let ((dir (expand-file-name "info/" installation-directory)))
94ffb4b2
GM
740 (when (file-directory-p dir)
741 (setq Info-directory-list (delete dir Info-directory-list))
742 (push dir Info-directory-list))))
eb7afdad
GM
743 ;; For a self-contained (ie relocatable) NS build, AFAICS we
744 ;; always want the included info directory to be at the head of
745 ;; the search path, unless it's already in INFOPATH somewhere.
746 ;; It's at the head of Info-default-directory-list,
747 ;; but there's no way to get it at the head of Info-directory-list
748 ;; except by doing it here.
749 (and path
750 (featurep 'ns)
751 (let ((dir (expand-file-name "../info" data-directory)))
752 (and (file-directory-p dir)
753 (not (member dir (split-string path ":" t)))
754 (push dir Info-directory-list)))))))
1143a6b0 755
a6e4564e 756;;;###autoload
761231d1 757(defun info-other-window (&optional file-or-node buffer)
a6e4564e 758 "Like `info' but show the Info buffer in another window."
761231d1
DC
759 (interactive (list
760 (if (and current-prefix-arg (not (numberp current-prefix-arg)))
761 (read-file-name "Info file name: " nil nil t))
762 (if (numberp current-prefix-arg)
763 (format "*info*<%s>" current-prefix-arg))))
764 (info-setup file-or-node
765 (switch-to-buffer-other-window (or buffer "*info*"))))
399c88ad 766
6bdad9ae 767;;;###autoload (put 'info 'info-file (purecopy "emacs"))
a384cab3 768;;;###autoload
94807253 769(defun info (&optional file-or-node buffer)
a384cab3 770 "Enter Info, the documentation browser.
94807253 771Optional argument FILE-OR-NODE specifies the file to examine;
a384cab3 772the default is the top-level directory of Info.
94807253 773Called from a program, FILE-OR-NODE may specify an Info node of the form
538e85c6 774\"(FILENAME)NODENAME\".
836bb478
JL
775Optional argument BUFFER specifies the Info buffer name;
776the default buffer name is *info*. If BUFFER exists,
777just switch to BUFFER. Otherwise, create a new buffer
778with the top-level Info directory.
a384cab3 779
836bb478
JL
780In interactive use, a non-numeric prefix argument directs
781this command to read a file name from the minibuffer.
761231d1
DC
782
783A numeric prefix argument N selects an Info buffer named
784\"*info*<%s>\".
e341dab2
RS
785
786The search path for Info files is in the variable `Info-directory-list'.
399c88ad 787The top-level Info directory is made by combining all the files named `dir'
88e1d519
JL
788in all the directories in that path.
789
790See a list of available Info commands in `Info-mode'."
836bb478
JL
791 (interactive (list
792 (if (and current-prefix-arg (not (numberp current-prefix-arg)))
793 (read-file-name "Info file name: " nil nil t))
794 (if (numberp current-prefix-arg)
795 (format "*info*<%s>" current-prefix-arg))))
72258fe5
CY
796 (info-setup file-or-node
797 (pop-to-buffer-same-window (or buffer "*info*"))))
919a69aa
CY
798
799(defun info-setup (file-or-node buffer)
800 "Display Info node FILE-OR-NODE in BUFFER."
1b3b87df 801 (if (and buffer (not (derived-mode-p 'Info-mode)))
836bb478 802 (Info-mode))
94807253 803 (if file-or-node
60705054
SM
804 ;; If argument already contains parentheses, don't add another set
805 ;; since the argument will then be parsed improperly. This also
806 ;; has the added benefit of allowing node names to be included
807 ;; following the parenthesized filename.
83040cb0 808 (Info-goto-node
94807253
JL
809 (if (and (stringp file-or-node) (string-match "(.*)" file-or-node))
810 file-or-node
811 (concat "(" file-or-node ")")))
b0dd5bf5
RS
812 (if (and (zerop (buffer-size))
813 (null Info-history))
814 ;; If we just created the Info buffer, go to the directory.
815 (Info-directory))))
a384cab3 816
c3717746
RS
817;;;###autoload
818(defun info-emacs-manual ()
3a8803c0 819 "Display the Emacs manual in Info mode."
c3717746
RS
820 (interactive)
821 (info "emacs"))
822
3290526d
GM
823;;;###autoload
824(defun info-emacs-bug ()
825 "Display the \"Reporting Bugs\" section of the Emacs manual in Info mode."
826 (interactive)
827 (info "(emacs)Bugs"))
828
552775bd
RS
829;;;###autoload
830(defun info-standalone ()
831 "Run Emacs as a standalone Info reader.
832Usage: emacs -f info-standalone [filename]
833In standalone mode, \\<Info-mode-map>\\[Info-exit] exits Emacs itself."
834 (setq Info-standalone t)
835 (if (and command-line-args-left
836 (not (string-match "^-" (car command-line-args-left))))
837 (condition-case err
838 (progn
839 (info (car command-line-args-left))
840 (setq command-line-args-left (cdr command-line-args-left)))
841 (error (send-string-to-terminal
842 (format "%s\n" (if (eq (car-safe err) 'error)
843 (nth 1 err) err)))
844 (save-buffers-kill-emacs)))
845 (info)))
7d3766a8 846\f
983dfbf8 847;; See if the accessible portion of the buffer begins with a node
11638562
EZ
848;; delimiter, and the node header line which follows matches REGEXP.
849;; Typically, this test will be followed by a loop that examines the
850;; rest of the buffer with (search-forward "\n\^_"), and it's a pity
851;; to have the overhead of this special test inside the loop.
852
853;; This function changes match-data, but supposedly the caller might
854;; want to use the results of re-search-backward.
855
856;; The return value is the value of point at the beginning of matching
983dfbf8 857;; REGEXP, if the function succeeds, nil otherwise.
11638562 858(defun Info-node-at-bob-matching (regexp)
760d5cb3
GM
859 (and (bobp) ; are we at beginning of buffer?
860 (looking-at "\^_") ; does it begin with node delimiter?
11638562
EZ
861 (let (beg)
862 (forward-line 1)
863 (setq beg (point))
760d5cb3 864 (forward-line 1) ; does the line after delimiter match REGEXP?
11638562
EZ
865 (re-search-backward regexp beg t))))
866
8a7757f6 867(defun Info-find-file (filename &optional noerror)
6194c800 868 "Return expanded FILENAME, or t if FILENAME is \"dir\".
8a7757f6
JL
869Optional second argument NOERROR, if t, means if file is not found
870just return nil (no error)."
a384cab3
JB
871 ;; Convert filename to lower case if not found as specified.
872 ;; Expand it.
6a013a49
JL
873 (cond
874 ((Info-virtual-call
875 (Info-virtual-fun 'find-file filename nil)
876 filename noerror))
877 ((stringp filename)
878 (let (temp temp-downcase found)
879 (setq filename (substitute-in-file-name filename))
880 (let ((dirs (if (string-match "^\\./" filename)
881 ;; If specified name starts with `./'
882 ;; then just try current directory.
883 '("./")
884 (if (file-name-absolute-p filename)
885 ;; No point in searching for an
886 ;; absolute file name
887 '(nil)
888 (if Info-additional-directory-list
889 (append Info-directory-list
890 Info-additional-directory-list)
891 Info-directory-list)))))
1c4dd947
LMI
892 ;; Fall back on the installation directory if we can't find
893 ;; the info node anywhere else.
894 (when installation-directory
895 (setq dirs (append dirs (list (expand-file-name
896 "info" installation-directory)))))
6a013a49
JL
897 ;; Search the directory list for file FILENAME.
898 (while (and dirs (not found))
899 (setq temp (expand-file-name filename (car dirs)))
900 (setq temp-downcase
901 (expand-file-name (downcase filename) (car dirs)))
902 ;; Try several variants of specified name.
903 (let ((suffix-list Info-suffix-list)
904 (lfn (if (fboundp 'msdos-long-file-names)
905 (msdos-long-file-names)
906 t)))
907 (while (and suffix-list (not found))
908 (cond ((info-file-exists-p
909 (info-insert-file-contents-1
910 temp (car (car suffix-list)) lfn))
911 (setq found temp))
912 ((info-file-exists-p
913 (info-insert-file-contents-1
914 temp-downcase (car (car suffix-list)) lfn))
915 (setq found temp-downcase))
916 ((and (fboundp 'msdos-long-file-names)
917 lfn
918 (info-file-exists-p
919 (info-insert-file-contents-1
920 temp (car (car suffix-list)) nil)))
921 (setq found temp)))
922 (setq suffix-list (cdr suffix-list))))
923 (setq dirs (cdr dirs))))
924 (if found
925 (setq filename found)
926 (if noerror
927 (setq filename nil)
3c0c4562
JL
928 ;; If there is no previous Info file, go to the directory.
929 (unless Info-current-file
930 (Info-directory))
931 (user-error "Info file %s does not exist" filename)))
6a013a49 932 filename))))
8a7757f6 933
9b057d61 934(defun Info-find-node (filename nodename &optional no-going-back strict-case)
185cff95 935 "Go to an Info node specified as separate FILENAME and NODENAME.
8a7757f6 936NO-GOING-BACK is non-nil if recovering from an error in this function;
9b057d61
GM
937it says do not attempt further (recursive) error recovery.
938
939This function first looks for a case-sensitive match for NODENAME;
940if none is found it then tries a case-insensitive match (unless
941STRICT-CASE is non-nil)."
8a7757f6
JL
942 (info-initialize)
943 (setq filename (Info-find-file filename))
185cff95 944 ;; Go into Info buffer.
1b3b87df 945 (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
b0dd5bf5
RS
946 ;; Record the node we are leaving, if we were in one.
947 (and (not no-going-back)
948 Info-current-file
159dfdde
SM
949 (push (list Info-current-file Info-current-node (point))
950 Info-history))
9b057d61 951 (Info-find-node-2 filename nodename no-going-back strict-case))
4fceda3c 952
d590dbd2 953;;;###autoload
4fceda3c 954(defun Info-on-current-buffer (&optional nodename)
70746649
RS
955 "Use Info mode to browse the current Info buffer.
956With a prefix arg, this queries for the node name to visit first;
957otherwise, that defaults to `Top'."
4fceda3c
SM
958 (interactive
959 (list (if current-prefix-arg
960 (completing-read "Node name: " (Info-build-node-completions)
07e91aa3
SM
961 nil t "Top"))))
962 (unless nodename (setq nodename "Top"))
75296efc 963 (info-initialize)
4fceda3c 964 (Info-mode)
d590dbd2
CY
965 (set (make-local-variable 'Info-current-file)
966 (or buffer-file-name
967 ;; If called on a non-file buffer, make a fake file name.
968 (concat default-directory (buffer-name))))
4fceda3c
SM
969 (Info-find-node-2 nil nodename))
970
f584b4c7 971(defun Info-revert-find-node (filename nodename)
185cff95 972 "Go to an Info node FILENAME and NODENAME, re-reading disk contents.
f584b4c7
RS
973When *info* is already displaying FILENAME and NODENAME, the window position
974is preserved, if possible."
1b3b87df 975 (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
f584b4c7
RS
976 (let ((old-filename Info-current-file)
977 (old-nodename Info-current-node)
3ffbc301 978 (window-selected (eq (selected-window) (get-buffer-window)))
f584b4c7
RS
979 (pcolumn (current-column))
980 (pline (count-lines (point-min) (line-beginning-position)))
981 (wline (count-lines (point-min) (window-start)))
96639c89
JL
982 (new-history (and Info-current-file
983 (list Info-current-file Info-current-node (point)))))
3ffbc301
JL
984 ;; When `Info-current-file' is nil, `Info-find-node-2' rereads the file.
985 (setq Info-current-file nil)
f584b4c7 986 (Info-find-node filename nodename)
f584b4c7
RS
987 (if (and (equal old-filename Info-current-file)
988 (equal old-nodename Info-current-node))
989 (progn
990 ;; note goto-line is no good, we want to measure from point-min
3ffbc301
JL
991 (when window-selected
992 (goto-char (point-min))
993 (forward-line wline)
994 (set-window-start (selected-window) (point)))
cb7de2e7 995 (goto-char (point-min))
f584b4c7
RS
996 (forward-line pline)
997 (move-to-column pcolumn))
998 ;; only add to the history when coming from a different file+node
999 (if new-history
1000 (setq Info-history (cons new-history Info-history))))))
1001
6194c800 1002(defun Info-revert-buffer-function (_ignore-auto noconfirm)
e56f84d7
TTN
1003 (when (or noconfirm (y-or-n-p "Revert info buffer? "))
1004 (Info-revert-find-node Info-current-file Info-current-node)
1005 (message "Reverted %s" Info-current-file)))
1006
357d11de
GM
1007(defun Info-find-in-tag-table-1 (marker regexp case-fold)
1008 "Find a node in a tag table.
1009MARKER specifies the buffer and position to start searching at.
1010REGEXP is a regular expression matching nodes or references. Its first
1011group should match `Node:' or `Ref:'.
1012CASE-FOLD t means search for a case-insensitive match.
1013If a match was found, value is a list (FOUND-ANCHOR POS MODE), where
1014FOUND-ANCHOR is non-nil if a `Ref:' was matched, POS is the position
1015where the match was found, and MODE is `major-mode' of the buffer in
1016which the match was found."
dde7f979 1017 (let ((case-fold-search case-fold))
e8dab975 1018 (with-current-buffer (marker-buffer marker)
357d11de 1019 (goto-char marker)
921e5fe6 1020
357d11de
GM
1021 ;; Search tag table
1022 (beginning-of-line)
1023 (when (re-search-forward regexp nil t)
1024 (list (string-equal "Ref:" (match-string 1))
365d2503 1025 (+ (point-min) (read (current-buffer)))
357d11de
GM
1026 major-mode)))))
1027
9b057d61 1028(defun Info-find-in-tag-table (marker regexp &optional strict-case)
357d11de
GM
1029 "Find a node in a tag table.
1030MARKER specifies the buffer and position to start searching at.
1031REGEXP is a regular expression matching nodes or references. Its first
1032group should match `Node:' or `Ref:'.
1033If a match was found, value is a list (FOUND-ANCHOR POS MODE), where
1034FOUND-ANCHOR is non-nil if a `Ref:' was matched, POS is the position
1035where the match was found, and MODE is `major-mode' of the buffer in
1036which the match was found.
1037This function tries to find a case-sensitive match first, then a
9b057d61
GM
1038case-insensitive match is tried (unless optional argument STRICT-CASE
1039is non-nil)."
357d11de 1040 (let ((result (Info-find-in-tag-table-1 marker regexp nil)))
9b057d61
GM
1041 (or strict-case (car result)
1042 (setq result (Info-find-in-tag-table-1 marker regexp t)))
357d11de
GM
1043 result))
1044
1045(defun Info-find-node-in-buffer-1 (regexp case-fold)
1046 "Find a node or anchor in the current buffer.
1047REGEXP is a regular expression matching nodes or references. Its first
1048group should match `Node:' or `Ref:'.
1049CASE-FOLD t means search for a case-insensitive match.
1050Value is the position at which a match was found, or nil if not found."
1051 (let ((case-fold-search case-fold)
1052 found)
1053 (save-excursion
9b026d9f
GM
1054 (if (Info-node-at-bob-matching regexp)
1055 (setq found (point))
1056 (while (and (not found)
1057 (search-forward "\n\^_" nil t))
1058 (forward-line 1)
1059 (let ((beg (point)))
1060 (forward-line 1)
1061 (if (re-search-backward regexp beg t)
1062 (setq found (line-beginning-position)))))))
1063 found))
921e5fe6 1064
9b057d61 1065(defun Info-find-node-in-buffer (regexp &optional strict-case)
357d11de
GM
1066 "Find a node or anchor in the current buffer.
1067REGEXP is a regular expression matching nodes or references. Its first
1068group should match `Node:' or `Ref:'.
1069Value is the position at which a match was found, or nil if not found.
1070This function looks for a case-sensitive match first. If none is found,
9b057d61
GM
1071a case-insensitive match is tried (unless optional argument STRICT-CASE
1072is non-nil)."
357d11de 1073 (or (Info-find-node-in-buffer-1 regexp nil)
9b057d61
GM
1074 (and (not strict-case)
1075 (Info-find-node-in-buffer-1 regexp t))))
921e5fe6 1076
9b057d61 1077(defun Info-find-node-2 (filename nodename &optional no-going-back strict-case)
9e5c2f50 1078 (buffer-disable-undo (current-buffer))
1b3b87df 1079 (or (derived-mode-p 'Info-mode)
a384cab3
JB
1080 (Info-mode))
1081 (widen)
1082 (setq Info-current-node nil)
1083 (unwind-protect
8bdf4b20 1084 (let ((case-fold-search t)
6a013a49
JL
1085 (virtual-fun (Info-virtual-fun 'find-node
1086 (or filename Info-current-file)
1087 nodename))
8bdf4b20 1088 anchorpos)
6a013a49
JL
1089 (cond
1090 ((functionp virtual-fun)
1091 (let ((filename (or filename Info-current-file)))
6a013a49 1092 (setq buffer-read-only nil)
30760c8b
JL
1093 (setq Info-current-file filename
1094 Info-current-subfile nil
1095 Info-current-file-completions nil
1096 buffer-file-name nil)
6a013a49 1097 (erase-buffer)
6a013a49
JL
1098 (Info-virtual-call virtual-fun filename nodename no-going-back)
1099 (set-marker Info-tag-table-marker nil)
1100 (setq buffer-read-only t)
1101 (set-buffer-modified-p nil)
1102 (set (make-local-variable 'Info-current-node-virtual) t)))
1103 ((not (and
1104 ;; Reread a file when moving from a virtual node.
1105 (not Info-current-node-virtual)
1106 (or (null filename)
1107 (equal Info-current-file filename))))
1108 ;; Switch files if necessary
1109 (let ((inhibit-read-only t))
30760c8b
JL
1110 (when Info-current-node-virtual
1111 ;; When moving from a virtual node.
1112 (set (make-local-variable 'Info-current-node-virtual) nil)
1113 (if (null filename)
1114 (setq filename Info-current-file)))
6a013a49
JL
1115 (setq Info-current-file nil
1116 Info-current-subfile nil
1117 Info-current-file-completions nil
1118 buffer-file-name nil)
1119 (erase-buffer)
1120 (info-insert-file-contents filename nil)
1121 (setq default-directory (file-name-directory filename))
1122 (set-buffer-modified-p nil)
1123 (set (make-local-variable 'Info-file-supports-index-cookies)
1124 (Info-file-supports-index-cookies filename))
1125
1126 ;; See whether file has a tag table. Record the location if yes.
1127 (goto-char (point-max))
1128 (forward-line -8)
1129 ;; Use string-equal, not equal, to ignore text props.
1130 (if (not (or (string-equal nodename "*")
1131 (not
1132 (search-forward "\^_\nEnd tag table\n" nil t))))
1133 (let (pos)
1134 ;; We have a tag table. Find its beginning.
1135 ;; Is this an indirect file?
1136 (search-backward "\nTag table:\n")
1137 (setq pos (point))
1138 (if (save-excursion
1139 (forward-line 2)
1140 (looking-at "(Indirect)\n"))
1141 ;; It is indirect. Copy it to another buffer
1142 ;; and record that the tag table is in that buffer.
1143 (let ((buf (current-buffer))
1144 (tagbuf
1145 (or Info-tag-table-buffer
1146 (generate-new-buffer " *info tag table*"))))
1147 (setq Info-tag-table-buffer tagbuf)
1148 (with-current-buffer tagbuf
1149 (buffer-disable-undo (current-buffer))
1150 (setq case-fold-search t)
1151 (erase-buffer)
1152 (insert-buffer-substring buf))
1153 (set-marker Info-tag-table-marker
1154 (match-end 0) tagbuf))
1155 (set-marker Info-tag-table-marker pos)))
1156 (set-marker Info-tag-table-marker nil))
1157 (setq Info-current-file filename)
1158 )))
1159
37a3ff5b
RS
1160 ;; Use string-equal, not equal, to ignore text props.
1161 (if (string-equal nodename "*")
1162 (progn (setq Info-current-node nodename)
1163 (Info-set-mode-line))
1164 ;; Possibilities:
1165 ;;
1166 ;; 1. Anchor found in tag table
1167 ;; 2. Anchor *not* in tag table
1168 ;;
1169 ;; 3. Node found in tag table
1170 ;; 4. Node *not* found in tag table, but found in file
1171 ;; 5. Node *not* in tag table, and *not* in file
1172 ;;
1173 ;; *Or* the same, but in an indirect subfile.
1174
1175 ;; Search file for a suitable node.
8bdf4b20 1176 (let ((guesspos (point-min))
357d11de 1177 (regexp (concat "\\(Node:\\|Ref:\\) *\\("
4ce5c223 1178 (if (stringp nodename)
dd31e4e8
GM
1179 (regexp-quote nodename)
1180 "")
dde7f979 1181 "\\) *[,\t\n\177]")))
37a3ff5b 1182
82172606 1183 (catch 'foo
921e5fe6 1184
82172606 1185 ;; First, search a tag table, if any
357d11de
GM
1186 (when (marker-position Info-tag-table-marker)
1187 (let* ((m Info-tag-table-marker)
9b057d61 1188 (found (Info-find-in-tag-table m regexp strict-case)))
921e5fe6 1189
357d11de
GM
1190 (when found
1191 ;; FOUND is (ANCHOR POS MODE).
1192 (setq guesspos (nth 1 found))
921e5fe6 1193
357d11de
GM
1194 ;; If this is an indirect file, determine which
1195 ;; file really holds this node and read it in.
1196 (unless (eq (nth 2 found) 'Info-mode)
1197 ;; Note that the current buffer must be the
1198 ;; *info* buffer on entry to
1199 ;; Info-read-subfile. Thus the hackery above.
1200 (setq guesspos (Info-read-subfile guesspos)))
82172606
DL
1201
1202 ;; Handle anchor
357d11de
GM
1203 (when (nth 0 found)
1204 (goto-char (setq anchorpos guesspos))
1205 (throw 'foo t)))))
82172606
DL
1206
1207 ;; Else we may have a node, which we search for:
1208 (goto-char (max (point-min)
1209 (- (byte-to-position guesspos) 1000)))
921e5fe6 1210
357d11de
GM
1211 ;; Now search from our advised position (or from beg of
1212 ;; buffer) to find the actual node. First, check
1213 ;; whether the node is right where we are, in case the
1214 ;; buffer begins with a node.
9b057d61 1215 (let ((pos (Info-find-node-in-buffer regexp strict-case)))
357d11de
GM
1216 (when pos
1217 (goto-char pos)
141b49f5
JL
1218 (throw 'foo t)))
1219
1220 (when (string-match "\\([^.]+\\)\\." nodename)
1221 (let (Info-point-loc)
1222 (Info-find-node-2
1223 filename (match-string 1 nodename) no-going-back))
1224 (widen)
1225 (throw 'foo t))
1226
1227 ;; No such anchor in tag table or node in tag table or file
71873e2b 1228 (user-error "No such node or anchor: %s" nodename))
82172606
DL
1229
1230 (Info-select-node)
8a7757f6 1231 (goto-char (point-min))
73bde1a8 1232 (forward-line 1) ; skip header line
3c5d6dfb
JL
1233 ;; (when (> Info-breadcrumbs-depth 0) ; skip breadcrumbs line
1234 ;; (forward-line 1))
73bde1a8 1235
8a7757f6
JL
1236 (cond (anchorpos
1237 (let ((new-history (list Info-current-file
1238 (substring-no-properties nodename))))
1239 ;; Add anchors to the history too
1240 (setq Info-history-list
1241 (cons new-history
645ca9cf 1242 (remove new-history Info-history-list))))
8a7757f6 1243 (goto-char anchorpos))
836bb478 1244 ((numberp Info-point-loc)
3fbb3dc4 1245 (forward-line (- Info-point-loc 2))
836bb478
JL
1246 (setq Info-point-loc nil))
1247 ((stringp Info-point-loc)
1248 (Info-find-index-name Info-point-loc)
1249 (setq Info-point-loc nil))))))
a384cab3 1250 ;; If we did not finish finding the specified node,
3c0c4562
JL
1251 ;; go back to the previous one or to the Top node.
1252 (unless (or Info-current-node no-going-back)
1253 (if Info-history
1254 (let ((hist (car Info-history)))
1255 (setq Info-history (cdr Info-history))
1256 (Info-find-node (nth 0 hist) (nth 1 hist) t)
1257 (goto-char (nth 2 hist)))
1258 (Info-find-node Info-current-file "Top" t)))))
a384cab3 1259
44c327f9
JB
1260;; Cache the contents of the (virtual) dir file, once we have merged
1261;; it for the first time, so we can save time subsequently.
7ea13762
RS
1262(defvar Info-dir-contents nil)
1263
44c327f9
JB
1264;; Cache for the directory we decided to use for the default-directory
1265;; of the merged dir text.
1266(defvar Info-dir-contents-directory nil)
1267
c142ab2d
RS
1268;; Record the file attributes of all the files from which we
1269;; constructed Info-dir-contents.
1270(defvar Info-dir-file-attributes nil)
1271
4fba3b2c
RS
1272(defvar Info-dir-file-name nil)
1273
7ea13762 1274;; Construct the Info directory node by merging the files named `dir'
44c327f9
JB
1275;; from various directories. Set the *info* buffer's
1276;; default-directory to the first directory we actually get any text
1277;; from.
7ea13762 1278(defun Info-insert-dir ()
c142ab2d
RS
1279 (if (and Info-dir-contents Info-dir-file-attributes
1280 ;; Verify that none of the files we used has changed
1281 ;; since we used it.
1282 (eval (cons 'and
b461e32d
SM
1283 (mapcar (lambda (elt)
1284 (let ((curr (file-attributes
1285 ;; Handle symlinks
1286 (file-truename (car elt)))))
1287
1288 ;; Don't compare the access time.
1289 (if curr (setcar (nthcdr 4 curr) 0))
1290 (setcar (nthcdr 4 (cdr elt)) 0)
1291 (equal (cdr elt) curr)))
c142ab2d 1292 Info-dir-file-attributes))))
4fba3b2c
RS
1293 (progn
1294 (insert Info-dir-contents)
1295 (goto-char (point-min)))
dd31e4e8 1296 (let ((dirs (if Info-additional-directory-list
b34dcc82
RS
1297 (append Info-directory-list
1298 Info-additional-directory-list)
1299 Info-directory-list))
1bd19a31 1300 (dir-file-attrs nil)
1bcedb3b
RS
1301 ;; Bind this in case the user sets it to nil.
1302 (case-fold-search t)
4fba3b2c
RS
1303 ;; This is set non-nil if we find a problem in some input files.
1304 problems
f4008b6e 1305 buffers buffer others nodes dirs-done)
44c327f9
JB
1306
1307 ;; Search the directory list for the directory file.
7ea13762 1308 (while dirs
8d1abb42
RS
1309 (let ((truename (file-truename (expand-file-name (car dirs)))))
1310 (or (member truename dirs-done)
1311 (member (directory-file-name truename) dirs-done)
1312 ;; Try several variants of specified name.
1313 ;; Try upcasing, appending `.info', or both.
825d6f08
RS
1314 (let* (file
1315 (attrs
1316 (or
1317 (progn (setq file (expand-file-name "dir" truename))
1318 (file-attributes file))
1319 (progn (setq file (expand-file-name "DIR" truename))
1320 (file-attributes file))
1321 (progn (setq file (expand-file-name "dir.info" truename))
1322 (file-attributes file))
1323 (progn (setq file (expand-file-name "DIR.INFO" truename))
17798e78 1324 (file-attributes file))
2e86d857
GM
1325 ;; Shouldn't really happen, but sometimes does,
1326 ;; eg on Debian systems with buggy packages;
1327 ;; so may as well try it.
1328 ;; http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00005.html
17798e78 1329 (progn (setq file (expand-file-name "dir.gz" truename))
825d6f08 1330 (file-attributes file)))))
8d1abb42
RS
1331 (setq dirs-done
1332 (cons truename
1333 (cons (directory-file-name truename)
1334 dirs-done)))
825d6f08 1335 (if attrs
e8dab975 1336 (with-current-buffer (generate-new-buffer " info dir")
825d6f08
RS
1337 (or buffers
1338 (message "Composing main Info directory..."))
9d499629 1339 (condition-case nil
8b5e8b42
EZ
1340 ;; Index nodes include null bytes. DIR
1341 ;; files should not have indices, but who
1342 ;; knows...
1343 (let ((inhibit-null-byte-detection t))
9d499629 1344 (insert-file-contents file)
1bd19a31
MB
1345 (set (make-local-variable 'Info-dir-file-name)
1346 file)
6af7040d 1347 (push (current-buffer) buffers)
1bd19a31 1348 (push (cons file attrs) dir-file-attrs))
9d499629 1349 (error (kill-buffer (current-buffer))))))))
1bd19a31
MB
1350 (unless (cdr dirs)
1351 (set (make-local-variable 'Info-dir-contents-directory)
1352 (file-name-as-directory (car dirs))))
825d6f08 1353 (setq dirs (cdr dirs))))
399c88ad 1354
4db579ab 1355 (or buffers
81e14cb2 1356 (error "Can't find the Info directory node"))
1bd19a31 1357
44c327f9 1358 ;; Distinguish the dir file that comes with Emacs from all the
f4008b6e 1359 ;; others. Yes, that is really what this is supposed to do.
f601cd3e
DL
1360 ;; The definition of `Info-directory-list' puts it first on that
1361 ;; list and so last in `buffers' at this point.
1362 (setq buffer (car (last buffers))
1363 others (delq buffer buffers))
44c327f9 1364
debcea0c
KH
1365 ;; Insert the entire original dir file as a start; note that we've
1366 ;; already saved its default directory to use as the default
1367 ;; directory for the whole concatenation.
69672704 1368 (save-excursion (insert-buffer-substring buffer))
44c327f9 1369
7ea13762 1370 ;; Look at each of the other buffers one by one.
6af7040d
SM
1371 (dolist (other others)
1372 (let (this-buffer-nodes)
7ea13762 1373 ;; In each, find all the menus.
6af7040d 1374 (with-current-buffer other
7ea13762
RS
1375 (goto-char (point-min))
1376 ;; Find each menu, and add an elt to NODES for it.
1377 (while (re-search-forward "^\\* Menu:" nil t)
6af7040d
SM
1378 (while (and (zerop (forward-line 1)) (eolp)))
1379 (let ((beg (point))
1380 nodename end)
1381 (re-search-backward "^\^_")
7ea13762 1382 (search-forward "Node: ")
89b064a9 1383 (setq nodename (Info-following-node-name))
3a6ade8a 1384 (search-forward "\n\^_" nil 'move)
7ea13762
RS
1385 (beginning-of-line)
1386 (setq end (point))
6af7040d 1387 (push (list nodename other beg end) this-buffer-nodes)))
9f4aee27 1388 (if (assoc-string "top" this-buffer-nodes t)
4fba3b2c
RS
1389 (setq nodes (nconc this-buffer-nodes nodes))
1390 (setq problems t)
6af7040d 1391 (message "No `top' node in %s" Info-dir-file-name)))))
fdf4b680 1392 ;; Add to the main menu a menu item for each other node.
6af7040d 1393 (re-search-forward "^\\* Menu:")
7ea13762
RS
1394 (forward-line 1)
1395 (let ((menu-items '("top"))
3a6ade8a 1396 (end (save-excursion (search-forward "\^_" nil t) (point))))
6af7040d
SM
1397 (dolist (node nodes)
1398 (let ((nodename (car node)))
c3a29d70
RS
1399 (save-excursion
1400 (or (member (downcase nodename) menu-items)
b37daea4 1401 (re-search-forward (concat "^\\* +"
c3a29d70
RS
1402 (regexp-quote nodename)
1403 "::")
1404 end t)
1405 (progn
1406 (insert "* " nodename "::" "\n")
6af7040d 1407 (push nodename menu-items)))))))
7ea13762
RS
1408 ;; Now take each node of each of the other buffers
1409 ;; and merge it into the main buffer.
6af7040d 1410 (dolist (node nodes)
760d5cb3 1411 (let ((case-fold-search t)
6af7040d 1412 (nodename (car node)))
7ea13762
RS
1413 (goto-char (point-min))
1414 ;; Find the like-named node in the main buffer.
ba42ce14 1415 (if (re-search-forward (concat "^\^_.*\n.*Node: "
7ea13762
RS
1416 (regexp-quote nodename)
1417 "[,\n\t]")
1418 nil t)
1419 (progn
3a6ade8a 1420 (search-forward "\n\^_" nil 'move)
25869acf
RS
1421 (beginning-of-line)
1422 (insert "\n"))
7ea13762
RS
1423 ;; If none exists, add one.
1424 (goto-char (point-max))
dfbf6104 1425 (insert "\^_\nFile: dir\tNode: " nodename "\n\n* Menu:\n\n"))
7ea13762
RS
1426 ;; Merge the text from the other buffer's menu
1427 ;; into the menu in the like-named node in the main buffer.
6af7040d
SM
1428 (apply 'insert-buffer-substring (cdr node))))
1429 (Info-dir-remove-duplicates)
dc9bec22
TTN
1430 ;; Kill all the buffers we just made, including the special one excised.
1431 (mapc 'kill-buffer (cons buffer buffers))
4fba3b2c
RS
1432 (goto-char (point-min))
1433 (if problems
1434 (message "Composing main Info directory...problems encountered, see `*Messages*'")
1bd19a31
MB
1435 (message "Composing main Info directory...done"))
1436 (set (make-local-variable 'Info-dir-contents) (buffer-string))
1437 (set (make-local-variable 'Info-dir-file-attributes) dir-file-attrs)))
44c327f9 1438 (setq default-directory Info-dir-contents-directory))
7ea13762 1439
6af7040d
SM
1440(defvar Info-streamline-headings
1441 '(("Emacs" . "Emacs")
1442 ("Programming" . "Programming")
1443 ("Libraries" . "Libraries")
1444 ("World Wide Web\\|Net Utilities" . "Net Utilities"))
1445 "List of elements (RE . NAME) to merge headings matching RE to NAME.")
1446
1447(defun Info-dir-remove-duplicates ()
1448 (let (limit)
1449 (goto-char (point-min))
1450 ;; Remove duplicate headings in the same menu.
1451 (while (search-forward "\n* Menu:" nil t)
141b49f5 1452 (setq limit (save-excursion (search-forward "\n\^_" nil t)))
6af7040d
SM
1453 ;; Look for the next heading to unify.
1454 (while (re-search-forward "^\\(\\w.*\\)\n\\*" limit t)
1455 (let ((name (match-string 1))
1456 (start (match-beginning 0))
1457 (entries nil) re)
1458 ;; Check whether this heading should be streamlined.
1459 (save-match-data
1460 (dolist (x Info-streamline-headings)
1461 (when (string-match (car x) name)
1462 (setq name (cdr x))
1463 (setq re (car x)))))
1464 (if re (replace-match name t t nil 1))
1465 (goto-char (if (re-search-forward "^[^* \n\t]" limit t)
1466 (match-beginning 0)
1467 (or limit (point-max))))
1468 ;; Look for other headings of the same category and merge them.
1469 (save-excursion
1470 (while (re-search-forward "^\\(\\w.*\\)\n\\*" limit t)
1471 (when (if re (save-match-data (string-match re (match-string 1)))
1472 (equal name (match-string 1)))
1473 (forward-line 0)
1474 ;; Delete redundant heading.
1475 (delete-region (match-beginning 0) (point))
1476 ;; Push the entries onto `text'.
1477 (push
1478 (delete-and-extract-region
1479 (point)
1480 (if (re-search-forward "^[^* \n\t]" nil t)
1481 (match-beginning 0)
2d19a2a4
JL
1482 (or limit (point-max))))
1483 entries)
1484 (forward-line 0))))
6af7040d
SM
1485 ;; Insert the entries just found.
1486 (while (= (line-beginning-position 0) (1- (point)))
1487 (backward-char))
1488 (dolist (entry (nreverse entries))
1489 (insert entry)
1490 (while (= (line-beginning-position 0) (1- (point)))
1491 (delete-region (1- (point)) (point))))
921e5fe6 1492
6af7040d 1493 ;; Now remove duplicate entries under the same heading.
3bfd723a
MR
1494 (let (seen)
1495 (save-restriction
1496 (narrow-to-region start (point))
1497 (goto-char (point-min))
1498 (while (re-search-forward "^* \\([^:\n]+:\\(:\\|[^.\n]+\\).\\)" nil 'move)
1499 ;; Fold case straight away; `member-ignore-case' here wasteful.
1500 (let ((x (downcase (match-string 1))))
1501 (if (member x seen)
1502 (delete-region
1503 (match-beginning 0)
1504 (if (re-search-forward "^[^ \t]" nil 'move)
1505 (goto-char (match-beginning 0))
1506 (point-max)))
1507 (push x seen)))))))))))
6af7040d 1508
c5fe2ff1
RS
1509;; Note that on entry to this function the current-buffer must be the
1510;; *info* buffer; not the info tags buffer.
a384cab3 1511(defun Info-read-subfile (nodepos)
a361deba
RS
1512 ;; NODEPOS is either a position (in the Info file as a whole,
1513 ;; not relative to a subfile) or the name of a subfile.
a384cab3
JB
1514 (let (lastfilepos
1515 lastfilename)
a361deba 1516 (if (numberp nodepos)
e8dab975 1517 (with-current-buffer (marker-buffer Info-tag-table-marker)
a361deba 1518 (goto-char (point-min))
ba42ce14
EZ
1519 (or (looking-at "\^_")
1520 (search-forward "\n\^_"))
a361deba
RS
1521 (forward-line 2)
1522 (catch 'foo
1523 (while (not (looking-at "\^_"))
1524 (if (not (eolp))
1525 (let ((beg (point))
1526 thisfilepos thisfilename)
1527 (search-forward ": ")
1528 (setq thisfilename (buffer-substring beg (- (point) 2)))
365d2503 1529 (setq thisfilepos (+ (point-min) (read (current-buffer))))
a361deba
RS
1530 ;; read in version 19 stops at the end of number.
1531 ;; Advance to the next line.
1532 (forward-line 1)
1533 (if (> thisfilepos nodepos)
1534 (throw 'foo t))
1535 (setq lastfilename thisfilename)
1536 (setq lastfilepos thisfilepos))
1537 (forward-line 1)))))
1538 (setq lastfilename nodepos)
1539 (setq lastfilepos 0))
c5fe2ff1
RS
1540 ;; Assume previous buffer is in Info-mode.
1541 ;; (set-buffer (get-buffer "*info*"))
a384cab3 1542 (or (equal Info-current-subfile lastfilename)
e8dab975 1543 (let ((inhibit-read-only t))
a384cab3
JB
1544 (setq buffer-file-name nil)
1545 (widen)
1546 (erase-buffer)
1143a6b0 1547 (info-insert-file-contents lastfilename)
a384cab3
JB
1548 (set-buffer-modified-p nil)
1549 (setq Info-current-subfile lastfilename)))
b0e52598
RS
1550 ;; Widen in case we are in the same subfile as before.
1551 (widen)
a384cab3 1552 (goto-char (point-min))
d44014cb 1553 ;; Skip the summary segment for `Info-search'.
ba42ce14
EZ
1554 (if (looking-at "\^_")
1555 (forward-char 1)
1556 (search-forward "\n\^_"))
d44014cb
JL
1557 ;; Don't add the length of the skipped summary segment to
1558 ;; the value returned to `Info-find-node-2'. (Bug#14125)
a361deba 1559 (if (numberp nodepos)
d44014cb 1560 (+ (- nodepos lastfilepos) (point-min)))))
a384cab3 1561
ec9b1372 1562(defun Info-unescape-quotes (value)
1ed6e0c3 1563 "Unescape double quotes and backslashes in VALUE."
ec9b1372
KB
1564 (let ((start 0)
1565 (unquote value))
1566 (while (string-match "[^\\\"]*\\(\\\\\\)[\\\\\"]" unquote start)
1567 (setq unquote (replace-match "" t t unquote 1))
1568 (setq start (- (match-end 0) 1)))
1569 unquote))
1570
1571;; As of Texinfo 4.6, makeinfo writes constructs like
1572;; \0\h[image param=value ...\h\0]
1573;; into the Info file for handling images.
1574(defun Info-split-parameter-string (parameter-string)
6194c800
JB
1575 "Return alist of (\"KEY\" . \"VALUE\") from PARAMETER-STRING.
1576PARAMETER-STRING is a whitespace separated list of KEY=VALUE pairs.
1577If VALUE contains whitespace or double quotes, it must be quoted
1578in double quotes and any double quotes or backslashes must be
1579escaped (\\\",\\\\)."
ec9b1372
KB
1580 (let ((start 0)
1581 (parameter-alist))
1582 (while (string-match
1583 "\\s *\\([^=]+\\)=\\(?:\\([^\\s \"]+\\)\\|\\(?:\"\\(\\(?:[^\\\"]\\|\\\\[\\\\\"]\\)*\\)\"\\)\\)"
1584 parameter-string start)
1585 (setq start (match-end 0))
1586 (push (cons (match-string 1 parameter-string)
1587 (or (match-string 2 parameter-string)
1588 (Info-unescape-quotes
1589 (match-string 3 parameter-string))))
1590 parameter-alist))
1591 parameter-alist))
1592
1593(defun Info-display-images-node ()
1594 "Display images in current node."
1595 (save-excursion
1596 (let ((inhibit-read-only t)
dde7f979 1597 (case-fold-search t))
ec9b1372
KB
1598 (goto-char (point-min))
1599 (while (re-search-forward
1600 "\\(\0\b[[]image\\(\\(?:[^\b]\\|[^\0]+\b\\)*\\)\0\b[]]\\)"
1601 nil t)
1602 (let* ((start (match-beginning 1))
1603 (parameter-alist (Info-split-parameter-string (match-string 2)))
d3425b35
NR
1604 (src (cdr (assoc-string "src" parameter-alist))))
1605 (if (display-images-p)
1606 (let* ((image-file (if src (if (file-name-absolute-p src) src
1607 (concat default-directory src))
1608 ""))
1609 (image (if (file-exists-p image-file)
1610 (create-image image-file)
96727100
JL
1611 (or (cdr (assoc-string "text" parameter-alist))
1612 (and src (concat "[broken image:" src "]"))
1613 "[broken image]"))))
d3425b35
NR
1614 (if (not (get-text-property start 'display))
1615 (add-text-properties
96727100
JL
1616 start (point)
1617 `(display ,image rear-nonsticky (display)
1618 help-echo ,(cdr (assoc-string "alt" parameter-alist))))))
d3425b35
NR
1619 ;; text-only display, show alternative text if provided, or
1620 ;; otherwise a clue that there's meant to be a picture
1621 (delete-region start (point))
1622 (insert (or (cdr (assoc-string "text" parameter-alist))
1623 (cdr (assoc-string "alt" parameter-alist))
96727100 1624 (and src (concat "[image:" src "]"))
d3425b35 1625 "[image]"))))))
ec9b1372
KB
1626 (set-buffer-modified-p nil)))
1627
0c1b7af5
JL
1628;; Texinfo 4.7 adds cookies of the form ^@^H[NAME CONTENTS ^@^H].
1629;; Hide any construct of the general form ^@[^@-^_][ ... ^@[^@-^_]],
1630;; including one optional trailing newline.
1631(defun Info-hide-cookies-node ()
e37c1854 1632 "Hide unrecognized cookies in current node."
0c1b7af5
JL
1633 (save-excursion
1634 (let ((inhibit-read-only t)
1635 (case-fold-search t))
1636 (goto-char (point-min))
1637 (while (re-search-forward
1638 "\\(\0[\0-\37][[][^\0]*\0[\0-\37][]]\n?\\)"
1639 nil t)
1640 (let* ((start (match-beginning 1)))
d3de1c8e
JL
1641 (if (and (not (get-text-property start 'invisible))
1642 (not (get-text-property start 'display)))
0c1b7af5
JL
1643 (put-text-property start (point) 'invisible t)))))
1644 (set-buffer-modified-p nil)))
1645
a384cab3 1646(defun Info-select-node ()
185cff95 1647 "Select the Info node that point is in."
b038485e 1648 ;; Bind this in case the user sets it to nil.
1bcedb3b
RS
1649 (let ((case-fold-search t))
1650 (save-excursion
760d5cb3
GM
1651 ;; Find beginning of node.
1652 (if (search-backward "\n\^_" nil 'move)
1653 (forward-line 2)
1654 (if (looking-at "\^_")
1655 (forward-line 1)
1656 (signal 'search-failed (list "\n\^_"))))
1657 ;; Get nodename spelled as it is in the node.
1658 (re-search-forward "Node:[ \t]*")
1659 (setq Info-current-node
1660 (buffer-substring-no-properties (point)
1661 (progn
1662 (skip-chars-forward "^,\t\n")
1663 (point))))
1664 (Info-set-mode-line)
1665 ;; Find the end of it, and narrow.
1666 (beginning-of-line)
1667 (let (active-expression)
50ac70af 1668 ;; Narrow to the node contents
760d5cb3
GM
1669 (narrow-to-region (point)
1670 (if (re-search-forward "\n[\^_\f]" nil t)
1671 (prog1
1672 (1- (point))
1673 (if (looking-at "[\n\^_\f]*execute: ")
1674 (progn
1675 (goto-char (match-end 0))
1676 (setq active-expression
1677 (read (current-buffer))))))
1678 (point-max)))
1679 (if Info-enable-active-nodes (eval active-expression))
8a7757f6
JL
1680 ;; Add a new unique history item to full history list
1681 (let ((new-history (list Info-current-file Info-current-node)))
1682 (setq Info-history-list
645ca9cf 1683 (cons new-history (remove new-history Info-history-list)))
424b9d3e 1684 (setq Info-history-forward nil))
141b49f5
JL
1685 (if (not (eq Info-fontify-maximum-menu-size nil))
1686 (Info-fontify-node))
ec9b1372 1687 (Info-display-images-node)
0c1b7af5 1688 (Info-hide-cookies-node)
760d5cb3 1689 (run-hooks 'Info-selection-hook)))))
a384cab3 1690
8eafa165
JL
1691(defvar Info-mode-line-node-keymap
1692 (let ((map (make-sparse-keymap)))
8aab8422
CY
1693 (define-key map [mode-line mouse-1] 'Info-mouse-scroll-up)
1694 (define-key map [mode-line mouse-3] 'Info-mouse-scroll-down)
8eafa165
JL
1695 map)
1696 "Keymap to put on the Info node name in the mode line.")
1697
a384cab3
JB
1698(defun Info-set-mode-line ()
1699 (setq mode-line-buffer-identification
313fe58a 1700 (nconc (propertized-buffer-identification "%b")
918e364a 1701 (list
8eafa165
JL
1702 (concat
1703 " ("
1704 (if (stringp Info-current-file)
fd5b25da 1705 (replace-regexp-in-string
75498db0
CY
1706 "%" "%%"
1707 (file-name-sans-extension
1708 (file-name-nondirectory Info-current-file)))
bec275ed 1709 (format "*%S*" Info-current-file))
8eafa165
JL
1710 ") "
1711 (if Info-current-node
fd5b25da
JL
1712 (propertize (replace-regexp-in-string
1713 "%" "%%" Info-current-node)
8eafa165
JL
1714 'face 'mode-line-buffer-id
1715 'help-echo
1716 "mouse-1: scroll forward, mouse-3: scroll back"
1717 'mouse-face 'mode-line-highlight
1718 'local-map Info-mode-line-node-keymap)
1719 ""))))))
a384cab3 1720\f
185cff95 1721;; Go to an Info node specified with a filename-and-nodename string
a384cab3
JB
1722;; of the sort that is found in pointers in nodes.
1723
83040cb0
SM
1724;; Don't autoload this function: the correct entry point for other packages
1725;; to use is `info'. --Stef
1726;; ;;;###autoload
9b057d61 1727(defun Info-goto-node (nodename &optional fork strict-case)
185cff95 1728 "Go to Info node named NODENAME. Give just NODENAME or (FILENAME)NODENAME.
dc414be1
EZ
1729If NODENAME is of the form (FILENAME)NODENAME, the node is in the Info file
1730FILENAME; otherwise, NODENAME should be in the current Info file (or one of
1731its sub-files).
c6a22ce2
JL
1732Completion is available for node names in the current Info file as well as
1733in the Info file FILENAME after the closing parenthesis in (FILENAME).
1734Empty NODENAME in (FILENAME) defaults to the Top node.
7210b6f5 1735If FORK is non-nil (interactively with a prefix arg), show the node in
185cff95 1736a new Info buffer.
9b057d61
GM
1737If FORK is a string, it is the name to use for the new buffer.
1738
1739This function first looks for a case-sensitive match for the node part
1740of NODENAME; if none is found it then tries a case-insensitive match
1741\(unless STRICT-CASE is non-nil)."
d1268e52 1742 (interactive (list (Info-read-node-name "Go to node: ") current-prefix-arg))
d0e41cba 1743 (info-initialize)
4fceda3c 1744 (if fork
760d5cb3
GM
1745 (set-buffer
1746 (clone-buffer (concat "*info-" (if (stringp fork) fork nodename) "*") t)))
a384cab3
JB
1747 (let (filename)
1748 (string-match "\\s *\\((\\s *\\([^\t)]*\\)\\s *)\\s *\\|\\)\\(.*\\)"
1749 nodename)
1750 (setq filename (if (= (match-beginning 1) (match-end 1))
1751 ""
c60c12be
SM
1752 (match-string 2 nodename))
1753 nodename (match-string 3 nodename))
836bb478 1754 (let ((trim (string-match "\\s +\\'" filename)))
a384cab3 1755 (if trim (setq filename (substring filename 0 trim))))
836bb478 1756 (let ((trim (string-match "\\s +\\'" nodename)))
a384cab3 1757 (if trim (setq nodename (substring nodename 0 trim))))
e579232c 1758 (if transient-mark-mode (deactivate-mark))
a384cab3 1759 (Info-find-node (if (equal filename "") nil filename)
9b057d61 1760 (if (equal nodename "") "Top" nodename) nil strict-case)))
552775bd 1761
ddf89211
RS
1762(defvar Info-read-node-completion-table)
1763
e8dab975 1764(defun Info-read-node-name-2 (dirs suffixes string pred action)
538e85c6
CY
1765 "Internal function used to complete Info node names.
1766Return a completion table for Info files---the FILENAME part of a
1767node named \"(FILENAME)NODENAME\". DIRS is a list of Info
1768directories to search if FILENAME is not absolute; SUFFIXES is a
1769list of valid filename suffixes for Info files. See
1770`try-completion' for a description of the remaining arguments."
e8dab975
SM
1771 (setq suffixes (remove "" suffixes))
1772 (when (file-name-absolute-p string)
1773 (setq dirs (list (file-name-directory string))))
1774 (let ((names nil)
8a2e287c 1775 (names-sans-suffix nil)
e8dab975
SM
1776 (suffix (concat (regexp-opt suffixes t) "\\'"))
1777 (string-dir (file-name-directory string)))
a89da416
RS
1778 (dolist (dir dirs)
1779 (unless dir
1780 (setq dir default-directory))
1781 (if string-dir (setq dir (expand-file-name string-dir dir)))
1782 (when (file-directory-p dir)
1783 (dolist (file (file-name-all-completions
1784 (file-name-nondirectory string) dir))
1785 ;; If the file name has no suffix or a standard suffix,
1786 ;; include it.
1787 (and (or (null (file-name-extension file))
1788 (string-match suffix file))
185cff95 1789 ;; But exclude subfiles of split Info files.
a89da416
RS
1790 (not (string-match "-[0-9]+\\'" file))
1791 ;; And exclude backup files.
1792 (not (string-match "~\\'" file))
1793 (push (if string-dir (concat string-dir file) file) names))
1794 ;; If the file name ends in a standard suffix,
1795 ;; add the unsuffixed name as a completion option.
1796 (when (string-match suffix file)
1797 (setq file (substring file 0 (match-beginning 0)))
8a2e287c
JL
1798 (push (if string-dir (concat string-dir file) file)
1799 names-sans-suffix)))))
1800 ;; If there is just one file, don't duplicate it with suffixes,
1801 ;; so `Info-read-node-name-1' will be able to complete a single
1802 ;; candidate and to add the terminating ")".
1803 (if (and (= (length names) 1) (= (length names-sans-suffix) 1))
1804 (setq names names-sans-suffix)
1805 (setq names (append names-sans-suffix names)))
e8dab975 1806 (complete-with-action action names string pred)))
a89da416 1807
03524be6 1808(defun Info-read-node-name-1 (string predicate code)
538e85c6
CY
1809 "Internal function used by `Info-read-node-name'.
1810See `completing-read' for a description of arguments and usage."
365d2503
SM
1811 (cond
1812 ;; First complete embedded file names.
1813 ((string-match "\\`([^)]*\\'" string)
e2947429
SM
1814 (completion-table-with-context
1815 "("
e8dab975
SM
1816 (apply-partially 'completion-table-with-terminator ")"
1817 (apply-partially 'Info-read-node-name-2
1818 Info-directory-list
1819 (mapcar 'car Info-suffix-list)))
e2947429 1820 (substring string 1)
e8dab975 1821 predicate
e2947429 1822 code))
313f39aa
JL
1823 ;; If a file name was given, complete nodes in the file.
1824 ((string-match "\\`(\\([^)]+\\))" string)
1825 (let ((file0 (match-string 0 string))
1826 (file1 (match-string 1 string))
c6a22ce2
JL
1827 (nodename (substring string (match-end 0))))
1828 (if (and (equal nodename "") (eq code 'lambda))
1829 ;; Empty node name is permitted that means "Top".
1830 t
1831 (completion-table-with-context
1832 file0
1833 (apply-partially
1834 (lambda (string pred action)
1835 (complete-with-action
1836 action
1837 (Info-build-node-completions (Info-find-file file1))
1838 string pred)))
1839 nodename predicate code))))
365d2503 1840 ;; Otherwise use Info-read-node-completion-table.
e2947429
SM
1841 (t (complete-with-action
1842 code Info-read-node-completion-table string predicate))))
03524be6 1843
a89da416 1844;; Arrange to highlight the proper letters in the completion list buffer.
f75d05eb 1845(defun Info-read-node-name (prompt)
538e85c6
CY
1846 "Read an Info node name with completion, prompting with PROMPT.
1847A node name can have the form \"NODENAME\", referring to a node
c6a22ce2
JL
1848in the current Info file, or \"(FILENAME)NODENAME\", referring to
1849a node in FILENAME. \"(FILENAME)\" is a short format to go to
1850the Top node in FILENAME."
552775bd 1851 (let* ((completion-ignore-case t)
ddf89211 1852 (Info-read-node-completion-table (Info-build-node-completions))
b6d61ffa 1853 (nodename (completing-read prompt 'Info-read-node-name-1 nil t)))
552775bd 1854 (if (equal nodename "")
f75d05eb 1855 (Info-read-node-name prompt)
552775bd
RS
1856 nodename)))
1857
c6a22ce2
JL
1858(defun Info-build-node-completions (&optional filename)
1859 (if filename
1860 (or (cdr (assoc filename Info-file-completions))
313f39aa
JL
1861 (with-temp-buffer
1862 (Info-mode)
c6a22ce2 1863 (Info-goto-node (format "(%s)Top" filename))
313f39aa 1864 (Info-build-node-completions-1)
c6a22ce2 1865 (push (cons filename Info-current-file-completions) Info-file-completions)
313f39aa
JL
1866 Info-current-file-completions))
1867 (or Info-current-file-completions
1868 (Info-build-node-completions-1))))
1869
1870(defun Info-build-node-completions-1 ()
1871 (let ((compl nil)
1872 ;; Bind this in case the user sets it to nil.
1873 (case-fold-search t)
1874 (node-regexp "Node: *\\([^,\n]*\\) *[,\n\t]"))
1875 (save-excursion
1876 (save-restriction
1877 (or Info-tag-table-marker
1878 (error "No Info tags found"))
1879 (if (marker-buffer Info-tag-table-marker)
1880 (let ((marker Info-tag-table-marker))
1881 (set-buffer (marker-buffer marker))
552775bd 1882 (widen)
313f39aa
JL
1883 (goto-char marker)
1884 (while (re-search-forward "\n\\(Node\\|Ref\\): \\(.*\\)\177" nil t)
1885 (setq compl
1886 (cons (list (match-string-no-properties 2))
1887 compl))))
1888 (widen)
1889 (goto-char (point-min))
1890 ;; If the buffer begins with a node header, process that first.
1891 (if (Info-node-at-bob-matching node-regexp)
1892 (setq compl (list (match-string-no-properties 1))))
1893 ;; Now for the rest of the nodes.
1894 (while (search-forward "\n\^_" nil t)
1895 (forward-line 1)
1896 (let ((beg (point)))
1897 (forward-line 1)
1898 (if (re-search-backward node-regexp beg t)
1899 (setq compl
1900 (cons (list (match-string-no-properties 1))
1901 compl))))))))
1902 (setq compl (cons '("*") (nreverse compl)))
1903 (set (make-local-variable 'Info-current-file-completions) compl)
1904 compl))
1905
a384cab3 1906\f
aea2a8da
JB
1907(defun Info-restore-point (hl)
1908 "If this node has been visited, restore the point value when we left."
cedb118c
RS
1909 (while hl
1910 (if (and (equal (nth 0 (car hl)) Info-current-file)
e90d1271
RS
1911 ;; Use string-equal, not equal, to ignore text props.
1912 (string-equal (nth 1 (car hl)) Info-current-node))
cedb118c 1913 (progn
d96504df
KH
1914 (goto-char (nth 2 (car hl)))
1915 (setq hl nil)) ;terminate the while at next iter
cedb118c 1916 (setq hl (cdr hl)))))
aea2a8da 1917\f
2c80a618
GM
1918(defvar Info-search-history nil
1919 "The history list for `Info-search'.")
a384cab3 1920
8a7757f6
JL
1921(defvar Info-search-case-fold nil
1922 "The value of `case-fold-search' from previous `Info-search' command.")
1923
dc6c0eda
SM
1924(defun Info--search-loop (regexp bound backward)
1925 (when backward
1926 ;; Hide Info file header for backward search.
1927 (narrow-to-region (save-excursion
1928 (goto-char (point-min))
1929 (search-forward "\n\^_")
1930 (1- (point)))
1931 (point-max)))
1932 (let ((give-up nil)
1933 (found nil)
1934 (beg-found nil))
1935 (while (not (or give-up
1936 (and found
1937 (funcall isearch-filter-predicate
1938 beg-found found))))
1939 (let ((search-spaces-regexp Info-search-whitespace-regexp))
1940 (if (funcall
1941 (if backward #'re-search-backward #'re-search-forward)
1942 regexp bound t)
1943 (setq found (point) beg-found (if backward (match-end 0)
1944 (match-beginning 0)))
1945 (setq give-up t found nil))))
1946 found))
1947
6194c800 1948(defun Info-search (regexp &optional bound _noerror _count direction)
0b02cda9
JL
1949 "Search for REGEXP, starting from point, and select node it's found in.
1950If DIRECTION is `backward', search in the reverse direction."
bbc96600
EZ
1951 (interactive (list (read-string
1952 (if Info-search-history
5b76833f
RF
1953 (format "Regexp search%s (default %s): "
1954 (if case-fold-search "" " case-sensitively")
bbc96600 1955 (car Info-search-history))
8a7757f6 1956 (format "Regexp search%s: "
5b76833f 1957 (if case-fold-search "" " case-sensitively")))
bbc96600 1958 nil 'Info-search-history)))
f9be2e35 1959 (deactivate-mark)
2c80a618
GM
1960 (when (equal regexp "")
1961 (setq regexp (car Info-search-history)))
c47b5bbe 1962 (when regexp
dc6c0eda
SM
1963 (setq Info-search-case-fold case-fold-search)
1964 (let* ((backward (eq direction 'backward))
1965 (onode Info-current-node)
1966 (ofile Info-current-file)
1967 (opoint (point))
1968 (opoint-min (point-min))
1969 (opoint-max (point-max))
1970 (ostart (window-start))
1971 (osubfile Info-current-subfile)
1972 (found
1973 (save-excursion
1974 (save-restriction
1975 (widen)
1976 (Info--search-loop regexp bound backward)))))
1977
1978 (unless (or (not isearch-mode) (not Info-isearch-search)
1979 Info-isearch-initial-node
1980 bound
1981 (and found (> found opoint-min) (< found opoint-max)))
242c0a95 1982 (signal 'search-failed (list regexp "end of node")))
d457219d 1983
774f8aee 1984 ;; If no subfiles, give error now.
dc6c0eda
SM
1985 (unless (or found Info-current-subfile)
1986 (if isearch-mode
1987 (signal 'search-failed (list regexp "end of manual"))
1988 (let ((search-spaces-regexp Info-search-whitespace-regexp))
1989 (if backward
1990 (re-search-backward regexp)
1991 (re-search-forward regexp)))))
774f8aee 1992
d457219d
JL
1993 (if (and bound (not found))
1994 (signal 'search-failed (list regexp)))
1995
0b02cda9 1996 (unless (or found bound)
774f8aee
RS
1997 (unwind-protect
1998 ;; Try other subfiles.
1999 (let ((list ()))
e8dab975 2000 (with-current-buffer (marker-buffer Info-tag-table-marker)
774f8aee
RS
2001 (goto-char (point-min))
2002 (search-forward "\n\^_\nIndirect:")
2003 (save-restriction
2004 (narrow-to-region (point)
2005 (progn (search-forward "\n\^_")
2006 (1- (point))))
c5fe2ff1 2007 (goto-char (point-min))
774f8aee
RS
2008 ;; Find the subfile we just searched.
2009 (search-forward (concat "\n" osubfile ": "))
2010 ;; Skip that one.
0b02cda9 2011 (forward-line (if backward 0 1))
866920e3 2012 (if backward (forward-char -1))
774f8aee
RS
2013 ;; Make a list of all following subfiles.
2014 ;; Each elt has the form (VIRT-POSITION . SUBFILENAME).
0b02cda9
JL
2015 (while (not (if backward (bobp) (eobp)))
2016 (if backward
2017 (re-search-backward "\\(^.*\\): [0-9]+$")
2018 (re-search-forward "\\(^.*\\): [0-9]+$"))
774f8aee
RS
2019 (goto-char (+ (match-end 1) 2))
2020 (setq list (cons (cons (+ (point-min)
2021 (read (current-buffer)))
2022 (match-string-no-properties 1))
2023 list))
0b02cda9
JL
2024 (goto-char (if backward
2025 (1- (match-beginning 0))
2026 (1+ (match-end 0)))))
774f8aee
RS
2027 ;; Put in forward order
2028 (setq list (nreverse list))))
2029 (while list
2030 (message "Searching subfile %s..." (cdr (car list)))
2031 (Info-read-subfile (car (car list)))
dc6c0eda 2032 (when backward (goto-char (point-max)))
774f8aee 2033 (setq list (cdr list))
dc6c0eda 2034 (setq found (Info--search-loop regexp nil backward))
c47b5bbe 2035 (if found
774f8aee
RS
2036 (setq list nil)))
2037 (if found
2038 (message "")
30c62133 2039 (signal 'search-failed (if isearch-mode
cb0a02ea 2040 (list regexp "end of manual")
30c62133 2041 (list regexp)))))
774f8aee
RS
2042 (if (not found)
2043 (progn (Info-read-subfile osubfile)
2044 (goto-char opoint)
2045 (Info-select-node)
2046 (set-window-start (selected-window) ostart)))))
0b02cda9
JL
2047
2048 (if (and (string= osubfile Info-current-subfile)
2049 (> found opoint-min)
2050 (< found opoint-max))
2051 ;; Search landed in the same node
2052 (goto-char found)
2053 (widen)
2054 (goto-char found)
2055 (save-match-data (Info-select-node)))
2056
760d5cb3
GM
2057 ;; Use string-equal, not equal, to ignore text props.
2058 (or (and (string-equal onode Info-current-node)
2059 (equal ofile Info-current-file))
866920e3
JL
2060 (and isearch-mode isearch-wrapped
2061 (eq opoint (if isearch-forward opoint-min opoint-max)))
760d5cb3
GM
2062 (setq Info-history (cons (list ofile onode opoint)
2063 Info-history))))))
8a7757f6
JL
2064
2065(defun Info-search-case-sensitively ()
2066 "Search for a regexp case-sensitively."
2067 (interactive)
2068 (let ((case-fold-search nil))
2069 (call-interactively 'Info-search)))
2070
2071(defun Info-search-next ()
2072 "Search for next regexp from a previous `Info-search' command."
2073 (interactive)
2074 (let ((case-fold-search Info-search-case-fold))
2075 (if Info-search-history
2076 (Info-search (car Info-search-history))
2077 (call-interactively 'Info-search))))
0b02cda9
JL
2078
2079(defun Info-search-backward (regexp &optional bound noerror count)
2080 "Search for REGEXP in the reverse direction."
2081 (interactive (list (read-string
2082 (if Info-search-history
5b76833f
RF
2083 (format "Regexp search%s backward (default %s): "
2084 (if case-fold-search "" " case-sensitively")
0b02cda9
JL
2085 (car Info-search-history))
2086 (format "Regexp search%s backward: "
5b76833f 2087 (if case-fold-search "" " case-sensitively")))
0b02cda9
JL
2088 nil 'Info-search-history)))
2089 (Info-search regexp bound noerror count 'backward))
2090
2091(defun Info-isearch-search ()
9553cf63 2092 (if Info-isearch-search
98e77be5 2093 (lambda (string &optional bound noerror count)
a9f9d9de
JL
2094 (let ((Info-search-whitespace-regexp
2095 (if (if isearch-regexp
2096 isearch-regexp-lax-whitespace
2097 isearch-lax-whitespace)
2098 search-whitespace-regexp)))
2099 (Info-search
2100 (cond
2101 (isearch-word
2102 ;; Lax version of word search
2103 (let ((lax (not (or isearch-nonincremental
2104 (eq (length string)
2105 (length (isearch--state-string
2106 (car isearch-cmds))))))))
2107 (if (functionp isearch-word)
2108 (funcall isearch-word string lax)
2109 (word-search-regexp string lax))))
2110 (isearch-regexp string)
2111 (t (regexp-quote string)))
2112 bound noerror count
2113 (unless isearch-forward 'backward)))
98db7a38 2114 (point))
8cbd80f7 2115 (isearch-search-fun-default)))
0b02cda9
JL
2116
2117(defun Info-isearch-wrap ()
d457219d
JL
2118 (if Info-isearch-search
2119 (if Info-isearch-initial-node
2120 (progn
2121 (if isearch-forward (Info-top-node) (Info-final-node))
2122 (goto-char (if isearch-forward (point-min) (point-max))))
2123 (setq Info-isearch-initial-node Info-current-node)
2124 (setq isearch-wrapped nil))
0b02cda9
JL
2125 (goto-char (if isearch-forward (point-min) (point-max)))))
2126
2127(defun Info-isearch-push-state ()
2128 `(lambda (cmd)
bec275ed 2129 (Info-isearch-pop-state cmd ',Info-current-file ',Info-current-node)))
0b02cda9 2130
6194c800 2131(defun Info-isearch-pop-state (_cmd file node)
bec275ed
JL
2132 (or (and (equal Info-current-file file)
2133 (equal Info-current-node node))
0b02cda9
JL
2134 (progn (Info-find-node file node) (sit-for 0))))
2135
d457219d 2136(defun Info-isearch-start ()
74a131b6
JL
2137 (setq Info-isearch-initial-node
2138 ;; Don't stop at initial node for nonincremental search.
2139 ;; Otherwise this variable is set after first search failure.
4bbedd98
JL
2140 (and isearch-nonincremental Info-current-node))
2141 (setq Info-isearch-initial-history Info-history
2142 Info-isearch-initial-history-list Info-history-list)
2143 (add-hook 'isearch-mode-end-hook 'Info-isearch-end nil t))
2144
2145(defun Info-isearch-end ()
2146 ;; Remove intermediate nodes (visited while searching)
2147 ;; from the history. Add only the last node (where Isearch ended).
2148 (if (> (length Info-history)
2149 (length Info-isearch-initial-history))
2150 (setq Info-history
2151 (nthcdr (- (length Info-history)
2152 (length Info-isearch-initial-history)
2153 1)
2154 Info-history)))
2155 (if (> (length Info-history-list)
2156 (length Info-isearch-initial-history-list))
2157 (setq Info-history-list
2158 (cons (car Info-history-list)
2159 Info-isearch-initial-history-list)))
2160 (remove-hook 'isearch-mode-end-hook 'Info-isearch-end t))
0ec3382b 2161
3fbb3dc4
JL
2162(defun Info-isearch-filter (beg-found found)
2163 "Test whether the current search hit is a visible useful text.
2164Return non-nil if the text from BEG-FOUND to FOUND is visible
2165and is not in the header line or a tag table."
0ec3382b
JL
2166 (save-match-data
2167 (let ((backward (< found beg-found)))
2168 (not
2169 (or
f6b6e113 2170 (and (not search-invisible)
744059ae
JL
2171 (if backward
2172 (or (text-property-not-all found beg-found 'invisible nil)
2173 (text-property-not-all found beg-found 'display nil))
2174 (or (text-property-not-all beg-found found 'invisible nil)
2175 (text-property-not-all beg-found found 'display nil))))
0ec3382b
JL
2176 ;; Skip node header line
2177 (and (save-excursion (forward-line -1)
2178 (looking-at "\^_"))
2179 (forward-line (if backward -1 1)))
2180 ;; Skip Tag Table node
2181 (save-excursion
2182 (and (search-backward "\^_" nil t)
2183 (looking-at
2184 "\^_\n\\(Tag Table\\|Local Variables\\)"))))))))
2185
a384cab3 2186\f
a384cab3 2187(defun Info-extract-pointer (name &optional errorname)
fdf4b680
DL
2188 "Extract the value of the node-pointer named NAME.
2189If there is none, use ERRORNAME in the error message;
c60c12be
SM
2190if ERRORNAME is nil, just return nil."
2191 ;; Bind this in case the user sets it to nil.
1bcedb3b
RS
2192 (let ((case-fold-search t))
2193 (save-excursion
c60c12be
SM
2194 (goto-char (point-min))
2195 (let ((bound (point)))
2196 (forward-line 1)
2197 (cond ((re-search-backward
2198 (concat name ":" (Info-following-node-name-re)) bound t)
bec275ed 2199 (match-string-no-properties 1))
c60c12be 2200 ((not (eq errorname t))
71873e2b
SM
2201 (user-error "Node has no %s"
2202 (capitalize (or errorname name)))))))))
c60c12be
SM
2203
2204(defun Info-following-node-name-re (&optional allowedchars)
2205 "Return a regexp matching a node name.
fdf4b680 2206ALLOWEDCHARS, if non-nil, goes within [...] to make a regexp
c60c12be
SM
2207saying which chars may appear in the node name.
2208Submatch 1 is the complete node name.
2209Submatch 2 if non-nil is the parenthesized file name part of the node name.
2210Submatch 3 is the local part of the node name.
2211End of submatch 0, 1, and 3 are the same, so you can safely concat."
feecf435 2212 (concat "[ \t\n]*" ;Skip leading space.
c60c12be
SM
2213 "\\(\\(([^)]+)\\)?" ;Node name can start with a file name.
2214 "\\([" (or allowedchars "^,\t\n") "]*" ;Any number of allowed chars.
2215 "[" (or allowedchars "^,\t\n") " ]" ;The last char can't be a space.
2216 "\\|\\)\\)")) ;Allow empty node names.
a384cab3 2217
718e6bc7
RS
2218;;; For compatibility; other files have used this name.
2219(defun Info-following-node-name ()
2220 (and (looking-at (Info-following-node-name-re))
bec275ed 2221 (match-string-no-properties 1)))
718e6bc7 2222
a384cab3
JB
2223(defun Info-next ()
2224 "Go to the next node of this node."
2225 (interactive)
222a6c9b
CY
2226 ;; In case another window is currently selected
2227 (save-window-excursion
1b3b87df 2228 (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
222a6c9b 2229 (Info-goto-node (Info-extract-pointer "next"))))
a384cab3
JB
2230
2231(defun Info-prev ()
2232 "Go to the previous node of this node."
2233 (interactive)
222a6c9b
CY
2234 ;; In case another window is currently selected
2235 (save-window-excursion
1b3b87df 2236 (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
222a6c9b 2237 (Info-goto-node (Info-extract-pointer "prev[ious]*" "previous"))))
a384cab3 2238
5dab2fb4
RS
2239(defun Info-up (&optional same-file)
2240 "Go to the superior node of this node.
2241If SAME-FILE is non-nil, do not move to a different Info file."
a384cab3 2242 (interactive)
222a6c9b
CY
2243 ;; In case another window is currently selected
2244 (save-window-excursion
1b3b87df 2245 (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
222a6c9b
CY
2246 (let ((old-node Info-current-node)
2247 (old-file Info-current-file)
2248 (node (Info-extract-pointer "up")) p)
d590dbd2 2249 (and same-file
222a6c9b
CY
2250 (string-match "^(" node)
2251 (error "Up node is in another Info file"))
2252 (Info-goto-node node)
2253 (setq p (point))
2254 (goto-char (point-min))
bec275ed
JL
2255 (if (and (stringp old-file)
2256 (search-forward "\n* Menu:" nil t)
222a6c9b
CY
2257 (re-search-forward
2258 (if (string-equal old-node "Top")
2259 (concat "\n\\*[^:]+: +(" (file-name-nondirectory old-file) ")")
2260 (concat "\n\\* +\\(" (regexp-quote old-node)
2261 ":\\|[^:]+: +" (regexp-quote old-node) "\\)"))
2262 nil t))
2263 (progn (beginning-of-line) (if (looking-at "^\\* ") (forward-char 2)))
2264 (goto-char p)
2265 (Info-restore-point Info-history)))))
a384cab3 2266
424b9d3e
JL
2267(defun Info-history-back ()
2268 "Go back in the history to the last node visited."
a384cab3
JB
2269 (interactive)
2270 (or Info-history
71873e2b 2271 (user-error "This is the first Info node you looked at"))
424b9d3e
JL
2272 (let ((history-forward
2273 (cons (list Info-current-file Info-current-node (point))
2274 Info-history-forward))
2275 filename nodename opoint)
a384cab3
JB
2276 (setq filename (car (car Info-history)))
2277 (setq nodename (car (cdr (car Info-history))))
2278 (setq opoint (car (cdr (cdr (car Info-history)))))
2279 (setq Info-history (cdr Info-history))
2280 (Info-find-node filename nodename)
2281 (setq Info-history (cdr Info-history))
424b9d3e
JL
2282 (setq Info-history-forward history-forward)
2283 (goto-char opoint)))
2284
2285(defalias 'Info-last 'Info-history-back)
2286
2287(defun Info-history-forward ()
2288 "Go forward in the history of visited nodes."
2289 (interactive)
2290 (or Info-history-forward
71873e2b 2291 (user-error "This is the last Info node you looked at"))
424b9d3e
JL
2292 (let ((history-forward (cdr Info-history-forward))
2293 filename nodename opoint)
2294 (setq filename (car (car Info-history-forward)))
2295 (setq nodename (car (cdr (car Info-history-forward))))
2296 (setq opoint (car (cdr (cdr (car Info-history-forward)))))
2297 (Info-find-node filename nodename)
2298 (setq Info-history-forward history-forward)
a384cab3 2299 (goto-char opoint)))
6a013a49
JL
2300\f
2301(add-to-list 'Info-virtual-files
2302 '("\\`dir\\'"
2303 (toc-nodes . Info-directory-toc-nodes)
2304 (find-file . Info-directory-find-file)
2305 (find-node . Info-directory-find-node)
2306 ))
2307
2308(defun Info-directory-toc-nodes (filename)
6a8230fe 2309 "Directory-specific implementation of `Info-toc-nodes'."
6a013a49
JL
2310 `(,filename
2311 ("Top" nil nil nil)))
2312
6194c800
JB
2313(defun Info-directory-find-file (filename &optional _noerror)
2314 "Directory-specific implementation of `Info-find-file'."
6a013a49
JL
2315 filename)
2316
6194c800
JB
2317(defun Info-directory-find-node (_filename _nodename &optional _no-going-back)
2318 "Directory-specific implementation of `Info-find-node-2'."
6a013a49 2319 (Info-insert-dir))
a384cab3 2320
48e5b471 2321;;;###autoload
a384cab3
JB
2322(defun Info-directory ()
2323 "Go to the Info directory node."
2324 (interactive)
2325 (Info-find-node "dir" "top"))
2326\f
6a013a49
JL
2327(add-to-list 'Info-virtual-files
2328 '("\\`\\*History\\*\\'"
2329 (toc-nodes . Info-history-toc-nodes)
2330 (find-file . Info-history-find-file)
2331 (find-node . Info-history-find-node)
2332 ))
2333
2334(defun Info-history-toc-nodes (filename)
75bfc667 2335 "History-specific implementation of `Info-toc-nodes'."
6a013a49
JL
2336 `(,filename
2337 ("Top" nil nil nil)))
2338
6194c800
JB
2339(defun Info-history-find-file (filename &optional _noerror)
2340 "History-specific implementation of `Info-find-file'."
6a013a49
JL
2341 filename)
2342
6194c800
JB
2343(defun Info-history-find-node (filename nodename &optional _no-going-back)
2344 "History-specific implementation of `Info-find-node-2'."
6a013a49
JL
2345 (insert (format "\n\^_\nFile: %s, Node: %s, Up: (dir)\n\n"
2346 (or filename Info-current-file) nodename))
2347 (insert "Recently Visited Nodes\n")
2348 (insert "**********************\n\n")
2349 (insert "* Menu:\n\n")
645ca9cf 2350 (let ((hl (remove '("*History*" "Top") Info-history-list)))
6a013a49
JL
2351 (while hl
2352 (let ((file (nth 0 (car hl)))
2353 (node (nth 1 (car hl))))
2354 (if (stringp file)
2355 (insert "* " node ": ("
2356 (propertize (or (file-name-directory file) "") 'invisible t)
2357 (file-name-nondirectory file)
2358 ")" node ".\n")))
2359 (setq hl (cdr hl)))))
2360
8a7757f6 2361(defun Info-history ()
89b064a9 2362 "Go to a node with a menu of visited nodes."
8a7757f6 2363 (interactive)
6a013a49
JL
2364 (Info-find-node "*History*" "Top")
2365 (Info-next-reference)
2366 (Info-next-reference))
2367\f
2368(add-to-list 'Info-virtual-nodes
2369 '("\\`\\*TOC\\*\\'"
2370 (find-node . Info-toc-find-node)
2371 ))
2372
6194c800
JB
2373(defun Info-toc-find-node (filename nodename &optional _no-going-back)
2374 "Toc-specific implementation of `Info-find-node-2'."
6a013a49
JL
2375 (let* ((curr-file (substring-no-properties (or filename Info-current-file)))
2376 (curr-node (substring-no-properties (or nodename Info-current-node)))
2377 (node-list (Info-toc-nodes curr-file)))
2378 (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
2379 curr-file curr-node))
2380 (insert "Table of Contents\n")
2381 (insert "*****************\n\n")
2382 (insert "*Note Top::\n")
2383 (Info-toc-insert
2384 (nth 3 (assoc "Top" node-list)) ; get Top nodes
2385 node-list 0 curr-file)
2386 (unless (bobp)
2387 (let ((Info-hide-note-references 'hide)
2388 (Info-fontify-visited-nodes nil))
2389 (setq Info-current-file filename Info-current-node "*TOC*")
2390 (goto-char (point-min))
2391 (narrow-to-region (or (re-search-forward "\n[\^_\f]\n" nil t)
2392 (point-min))
2393 (point-max))
2394 (Info-fontify-node)
2395 (widen)))))
8a7757f6 2396
8a7757f6 2397(defun Info-toc ()
bc224645
JL
2398 "Go to a node with table of contents of the current Info file.
2399Table of contents is created from the tree structure of menus."
8a7757f6 2400 (interactive)
6a013a49
JL
2401 (Info-find-node Info-current-file "*TOC*")
2402 (let ((prev-node (nth 1 (car Info-history))) p)
2403 (goto-char (point-min))
2404 (if (setq p (search-forward (concat "*Note " prev-node ":") nil t))
2405 (setq p (- p (length prev-node) 2)))
2406 (goto-char (or p (point-min)))))
8a7757f6 2407
6a013a49 2408(defun Info-toc-insert (nodes node-list level curr-file)
8a7757f6
JL
2409 "Insert table of contents with references to nodes."
2410 (let ((section "Top"))
2411 (while nodes
2412 (let ((node (assoc (car nodes) node-list)))
586f9284
JL
2413 (unless (member (nth 2 node) (list nil section))
2414 (insert (setq section (nth 2 node)) "\n"))
8a7757f6 2415 (insert (make-string level ?\t))
6a013a49
JL
2416 (insert "*Note " (car nodes) ":: \n")
2417 (Info-toc-insert (nth 3 node) node-list (1+ level) curr-file)
8a7757f6
JL
2418 (setq nodes (cdr nodes))))))
2419
6a013a49 2420(defun Info-toc-build (file)
8a7757f6 2421 "Build table of contents from menus of Info FILE and its subfiles."
8a7757f6 2422 (with-temp-buffer
ea99d5c8
JL
2423 (let* ((file (and (stringp file) (Info-find-file file)))
2424 (default-directory (or (and (stringp file)
2425 (file-name-directory file))
141b49f5 2426 default-directory))
ea99d5c8 2427 (main-file (and (stringp file) file))
141b49f5
JL
2428 (sections '(("Top" "Top")))
2429 nodes subfiles)
2430 (while (or main-file subfiles)
586f9284 2431 ;; (or main-file (message "Searching subfile %s..." (car subfiles)))
8a7757f6 2432 (erase-buffer)
141b49f5
JL
2433 (info-insert-file-contents (or main-file (car subfiles)))
2434 (goto-char (point-min))
8a7757f6
JL
2435 (while (and (search-forward "\n\^_\nFile:" nil 'move)
2436 (search-forward "Node: " nil 'move))
586f9284
JL
2437 (let* ((nodename (substring-no-properties (Info-following-node-name)))
2438 (bound (- (or (save-excursion (search-forward "\n\^_" nil t))
2439 (point-max)) 2))
2440 (upnode (and (re-search-forward
2441 (concat "Up:" (Info-following-node-name-re))
2442 bound t)
2443 (match-string-no-properties 1)))
2444 (section "Top")
2445 menu-items)
688070a5 2446 (when (and upnode (string-match "(" upnode)) (setq upnode nil))
141b49f5 2447 (when (and (not (Info-index-node nodename file))
8a7757f6
JL
2448 (re-search-forward "^\\* Menu:" bound t))
2449 (forward-line 1)
2450 (beginning-of-line)
2451 (setq bound (or (and (equal nodename "Top")
2452 (save-excursion
2453 (re-search-forward
2454 "^[ \t-]*The Detailed Node Listing" nil t)))
2455 bound))
2456 (while (< (point) bound)
2457 (cond
2458 ;; Menu item line
2459 ((looking-at "^\\* +[^:]+:")
2460 (beginning-of-line)
2461 (forward-char 2)
2462 (let ((menu-node-name (substring-no-properties
2463 (Info-extract-menu-node-name))))
2464 (setq menu-items (cons menu-node-name menu-items))
2465 (if (equal nodename "Top")
2466 (setq sections
2467 (cons (list menu-node-name section) sections)))))
2468 ;; Other non-empty strings in the Top node are section names
2469 ((and (equal nodename "Top")
2470 (looking-at "^\\([^ \t\n*=.-][^:\n]*\\)"))
2471 (setq section (match-string-no-properties 1))))
2472 (forward-line 1)
2473 (beginning-of-line)))
586f9284 2474 (setq nodes (cons (list nodename upnode
8a7757f6
JL
2475 (cadr (assoc nodename sections))
2476 (nreverse menu-items))
2477 nodes))
2478 (goto-char bound)))
141b49f5 2479 (if main-file
8a7757f6
JL
2480 (save-excursion
2481 (goto-char (point-min))
2482 (if (search-forward "\n\^_\nIndirect:" nil t)
2483 (let ((bound (save-excursion (search-forward "\n\^_" nil t))))
2484 (while (re-search-forward "^\\(.*\\): [0-9]+$" bound t)
2485 (setq subfiles (cons (match-string-no-properties 1)
2486 subfiles)))))
2487 (setq subfiles (nreverse subfiles)
141b49f5 2488 main-file nil))
8a7757f6
JL
2489 (setq subfiles (cdr subfiles))))
2490 (message "")
2491 (nreverse nodes))))
586f9284 2492
6a013a49
JL
2493(defun Info-toc-nodes (filename)
2494 "Return a node list of Info FILENAME with parent-children information.
586f9284 2495This information is cached in the variable `Info-toc-nodes' with the help
6a013a49
JL
2496of the function `Info-toc-build'."
2497 (cond
2498 ((Info-virtual-call
2499 (Info-virtual-fun 'toc-nodes (or filename Info-current-file) nil)
2500 filename))
2501 (t
2502 (or filename (setq filename Info-current-file))
2503 (or (assoc filename Info-toc-nodes)
2504 ;; Skip virtual Info files
2505 (and (or (not (stringp filename))
2506 (Info-virtual-file-p filename))
2507 (push (cons filename nil) Info-toc-nodes))
2508 ;; Scan the entire manual and cache the result in Info-toc-nodes
2509 (let ((nodes (Info-toc-build filename)))
2510 (push (cons filename nodes) Info-toc-nodes)
2511 nodes)
2512 ;; If there is an error, still add nil to the cache
2513 (push (cons filename nil) Info-toc-nodes))
2514 (cdr (assoc filename Info-toc-nodes)))))
586f9284 2515
8a7757f6
JL
2516\f
2517(defun Info-follow-reference (footnotename &optional fork)
fdf4b680 2518 "Follow cross reference named FOOTNOTENAME to the node it refers to.
8a7757f6
JL
2519FOOTNOTENAME may be an abbreviation of the reference name.
2520If FORK is non-nil (interactively with a prefix arg), show the node in
185cff95 2521a new Info buffer. If FORK is a string, it is the name to use for the
8a7757f6 2522new buffer."
a384cab3
JB
2523 (interactive
2524 (let ((completion-ignore-case t)
1bcedb3b 2525 (case-fold-search t)
67bc89ab 2526 completions default alt-default (start-point (point)) str i bol eol)
a384cab3 2527 (save-excursion
67bc89ab 2528 ;; Store end and beginning of line.
9b026d9f
GM
2529 (setq eol (line-end-position)
2530 bol (line-beginning-position))
a384cab3 2531 (goto-char (point-min))
8a7757f6 2532 (while (re-search-forward "\\*note[ \n\t]+\\([^:]*\\):" nil t)
c60c12be 2533 (setq str (match-string-no-properties 1))
a384cab3
JB
2534 ;; See if this one should be the default.
2535 (and (null default)
1f179e27 2536 (<= (match-beginning 0) start-point)
a384cab3
JB
2537 (<= start-point (point))
2538 (setq default t))
67bc89ab
RS
2539 ;; See if this one should be the alternate default.
2540 (and (null alt-default)
2541 (and (<= bol (match-beginning 0))
2542 (<= (point) eol))
2543 (setq alt-default t))
a384cab3
JB
2544 (setq i 0)
2545 (while (setq i (string-match "[ \n\t]+" str i))
2546 (setq str (concat (substring str 0 i) " "
2547 (substring str (match-end 0))))
2548 (setq i (1+ i)))
2549 ;; Record as a completion and perhaps as default.
2550 (if (eq default t) (setq default str))
67bc89ab 2551 (if (eq alt-default t) (setq alt-default str))
ec6d29af 2552 ;; Don't add this string if it's a duplicate.
c60c12be
SM
2553 (or (assoc-string str completions t)
2554 (push str completions))))
67bc89ab
RS
2555 ;; If no good default was found, try an alternate.
2556 (or default
2557 (setq default alt-default))
2558 ;; If only one cross-reference found, then make it default.
2559 (if (eq (length completions) 1)
c60c12be 2560 (setq default (car completions)))
a384cab3 2561 (if completions
b0ebdfe5 2562 (let ((input (completing-read (if default
968b7671 2563 (concat
5b76833f
RF
2564 "Follow reference named (default "
2565 default "): ")
b0ebdfe5
RS
2566 "Follow reference named: ")
2567 completions nil t)))
2568 (list (if (equal input "")
8a7757f6 2569 default input) current-prefix-arg))
71873e2b 2570 (user-error "No cross-references in this node"))))
ebf8f7e1
RS
2571
2572 (unless footnotename
2573 (error "No reference was specified"))
2574
dde7f979 2575 (let (target i (str (concat "\\*note " (regexp-quote footnotename)))
1bcedb3b 2576 (case-fold-search t))
a384cab3
JB
2577 (while (setq i (string-match " " str i))
2578 (setq str (concat (substring str 0 i) "[ \t\n]+" (substring str (1+ i))))
2579 (setq i (+ i 6)))
2580 (save-excursion
8a7757f6
JL
2581 ;; Move point to the beginning of reference if point is on reference
2582 (or (looking-at "\\*note[ \n\t]+")
2583 (and (looking-back "\\*note[ \n\t]+")
2584 (goto-char (match-beginning 0)))
2585 (if (and (save-excursion
2586 (goto-char (+ (point) 5)) ; skip a possible *note
2587 (re-search-backward "\\*note[ \n\t]+" nil t)
836bb478 2588 (looking-at str))
8a7757f6
JL
2589 (<= (point) (match-end 0)))
2590 (goto-char (match-beginning 0))))
2591 ;; Go to the reference closest to point
2592 (let ((next-ref (save-excursion (and (re-search-forward str nil t)
2593 (+ (match-beginning 0) 5))))
2594 (prev-ref (save-excursion (and (re-search-backward str nil t)
2595 (+ (match-beginning 0) 5)))))
2596 (goto-char (cond ((and next-ref prev-ref)
2597 (if (< (abs (- next-ref (point)))
2598 (abs (- prev-ref (point))))
2599 next-ref prev-ref))
2600 ((or next-ref prev-ref))
71873e2b
SM
2601 ((user-error "No cross-reference named %s"
2602 footnotename))))
8a7757f6 2603 (setq target (Info-extract-menu-node-name t))))
a384cab3
JB
2604 (while (setq i (string-match "[ \t\n]+" target i))
2605 (setq target (concat (substring target 0 i) " "
2606 (substring target (match-end 0))))
2607 (setq i (+ i 1)))
8a7757f6 2608 (Info-goto-node target fork)))
a384cab3 2609
e057da52
SM
2610(defconst Info-menu-entry-name-re "\\(?:[^:]\\|:[^:,.;() \t\n]\\)*"
2611 ;; We allow newline because this is also used in Info-follow-reference,
2612 ;; where the xref name might be wrapped over two lines.
c60c12be
SM
2613 "Regexp that matches a menu entry name upto but not including the colon.
2614Because of ambiguities, this should be concatenated with something like
2615`:' and `Info-following-node-name-re'.")
2616
836bb478 2617(defun Info-extract-menu-node-name (&optional multi-line index-node)
a384cab3 2618 (skip-chars-forward " \t\n")
c60c12be
SM
2619 (when (looking-at (concat Info-menu-entry-name-re ":\\(:\\|"
2620 (Info-following-node-name-re
836bb478
JL
2621 (cond
2622 (index-node "^,\t\n")
2623 (multi-line "^.,\t")
2624 (t "^.,\t\n")))
2625 "\\)"
2626 (if index-node
2627 "\\.\\(?:[ \t\n]+(line +\\([0-9]+\\))\\)?"
2628 "")))
2629 (if index-node
2630 (setq Info-point-loc
2631 (if (match-beginning 5)
2632 (string-to-number (match-string 5))
bec275ed
JL
2633 (buffer-substring-no-properties
2634 (match-beginning 0) (1- (match-beginning 1)))))
02c9f5cd 2635;;; Uncomment next line to use names of cross-references in non-index nodes:
836bb478
JL
2636;;; (setq Info-point-loc
2637;;; (buffer-substring (match-beginning 0) (1- (match-beginning 1))))
2638 )
c60c12be
SM
2639 (replace-regexp-in-string
2640 "[ \n]+" " "
d18b513b
JL
2641 (or (and (not (equal (match-string-no-properties 2) ""))
2642 (match-string-no-properties 2))
c60c12be 2643 ;; If the node name is the menu entry name (using `entry::').
bec275ed
JL
2644 (buffer-substring-no-properties
2645 (match-beginning 0) (1- (match-beginning 1)))))))
a384cab3 2646
e8adde3f 2647;; No one calls this.
9e5c2f50
RS
2648;;(defun Info-menu-item-sequence (list)
2649;; (while list
e8adde3f 2650;; (Info-menu (car list))
9e5c2f50 2651;; (setq list (cdr list))))
a384cab3 2652
6356e646 2653(defvar Info-complete-menu-buffer)
e4e8ee63 2654(defvar Info-complete-next-re nil)
141b49f5 2655(defvar Info-complete-nodes nil)
e4e8ee63 2656(defvar Info-complete-cache nil)
6356e646 2657
c60c12be
SM
2658(defconst Info-node-spec-re
2659 (concat (Info-following-node-name-re "^.,:") "[,:.]")
a1637357
SM
2660 "Regexp to match the text after a : until the terminating `.'.")
2661
e8adde3f 2662(defun Info-complete-menu-item (string predicate action)
2d12f5c2
SM
2663 ;; This uses two dynamically bound variables:
2664 ;; - `Info-complete-menu-buffer' which contains the buffer in which
2665 ;; is the menu of items we're trying to complete.
2666 ;; - `Info-complete-next-re' which, if non-nil, indicates that we should
2667 ;; also look for menu items in subsequent nodes as long as those
2668 ;; nodes' names match `Info-complete-next-re'. This feature is currently
141b49f5
JL
2669 ;; not used.
2670 ;; - `Info-complete-nodes' which, if non-nil, indicates that we should
2671 ;; also look for menu items in these nodes. This feature is currently
2d12f5c2 2672 ;; only used for completion in Info-index.
0defe758
LK
2673
2674 ;; Note that `Info-complete-menu-buffer' could be current already,
2675 ;; so we want to save point.
e8dab975 2676 (with-current-buffer Info-complete-menu-buffer
494858be
SM
2677 (save-excursion
2678 (let ((completion-ignore-case t)
2679 (case-fold-search t)
2680 (orignode Info-current-node)
2681 nextnode)
2682 (goto-char (point-min))
2683 (search-forward "\n* Menu:")
c2a37b78
SM
2684 (cond
2685 ((eq (car-safe action) 'boundaries) nil)
2686 ((eq action 'lambda)
2687 (re-search-forward
2688 (concat "\n\\* +" (regexp-quote string) ":") nil t))
2689 (t
494858be
SM
2690 (let ((pattern (concat "\n\\* +\\("
2691 (regexp-quote string)
c2a37b78
SM
2692 Info-menu-entry-name-re "\\):"
2693 Info-node-spec-re))
494858be
SM
2694 completions
2695 (complete-nodes Info-complete-nodes))
2696 ;; Check the cache.
2697 (if (and (equal (nth 0 Info-complete-cache) Info-current-file)
2698 (equal (nth 1 Info-complete-cache) Info-current-node)
2699 (equal (nth 2 Info-complete-cache) Info-complete-next-re)
2700 (equal (nth 5 Info-complete-cache) Info-complete-nodes)
2701 (let ((prev (nth 3 Info-complete-cache)))
2702 (eq t (compare-strings string 0 (length prev)
2703 prev 0 nil t))))
2704 ;; We can reuse the previous list.
2705 (setq completions (nth 4 Info-complete-cache))
2706 ;; The cache can't be used.
2707 (while
2708 (progn
2709 (while (re-search-forward pattern nil t)
2710 (push (match-string-no-properties 1)
2711 completions))
329c48d8 2712 (setq completions (delete-dups completions))
494858be
SM
2713 ;; Check subsequent nodes if applicable.
2714 (or (and Info-complete-next-re
2715 (setq nextnode (Info-extract-pointer "next" t))
2716 (string-match Info-complete-next-re nextnode))
2717 (and complete-nodes
2718 (setq complete-nodes (cdr complete-nodes)
2719 nextnode (car complete-nodes)))))
2720 (Info-goto-node nextnode))
2721 ;; Go back to the start node (for the next completion).
2722 (unless (equal Info-current-node orignode)
2723 (Info-goto-node orignode))
2724 ;; Update the cache.
2725 (set (make-local-variable 'Info-complete-cache)
d5850019
JB
2726 (list Info-current-file Info-current-node
2727 Info-complete-next-re string completions
2728 Info-complete-nodes)))
c2a37b78 2729 (complete-with-action action completions string predicate))))))))
e8adde3f
RS
2730
2731
4fceda3c 2732(defun Info-menu (menu-item &optional fork)
dc414be1
EZ
2733 "Go to the node pointed to by the menu item named (or abbreviated) MENU-ITEM.
2734The menu item should one of those listed in the current node's menu.
2735Completion is allowed, and the default menu item is the one point is on.
7210b6f5 2736If FORK is non-nil (interactively with a prefix arg), show the node in
185cff95 2737a new Info buffer. If FORK is a string, it is the name to use for the
7210b6f5 2738new buffer."
a384cab3 2739 (interactive
c2a37b78 2740 (let (;; If point is within a menu item, use that item as the default
a384cab3
JB
2741 (default nil)
2742 (p (point))
211d6309 2743 beg
760d5cb3 2744 (case-fold-search t))
a384cab3
JB
2745 (save-excursion
2746 (goto-char (point-min))
2747 (if (not (search-forward "\n* menu:" nil t))
71873e2b 2748 (user-error "No menu in this node"))
e8adde3f
RS
2749 (setq beg (point))
2750 (and (< (point) p)
2751 (save-excursion
2752 (goto-char p)
2753 (end-of-line)
00d32b3f
SM
2754 (if (re-search-backward (concat "\n\\* +\\("
2755 Info-menu-entry-name-re
2756 "\\):") beg t)
110d4e80 2757 (setq default (match-string-no-properties 1))))))
a384cab3
JB
2758 (let ((item nil))
2759 (while (null item)
e8adde3f
RS
2760 (setq item (let ((completion-ignore-case t)
2761 (Info-complete-menu-buffer (current-buffer)))
a384cab3
JB
2762 (completing-read (if default
2763 (format "Menu item (default %s): "
2764 default)
760d5cb3 2765 "Menu item: ")
e8adde3f 2766 'Info-complete-menu-item nil t)))
aea2a8da
JB
2767 ;; we rely on the fact that completing-read accepts an input
2768 ;; of "" even when the require-match argument is true and ""
2769 ;; is not a valid possibility
a384cab3
JB
2770 (if (string= item "")
2771 (if default
2772 (setq item default)
760d5cb3
GM
2773 ;; ask again
2774 (setq item nil))))
4fceda3c 2775 (list item current-prefix-arg))))
a384cab3
JB
2776 ;; there is a problem here in that if several menu items have the same
2777 ;; name you can only go to the node of the first with this command.
69188b79
CY
2778 (Info-goto-node (Info-extract-menu-item menu-item)
2779 (and fork
2780 (if (stringp fork) fork menu-item))))
399c88ad 2781
a384cab3
JB
2782(defun Info-extract-menu-item (menu-item)
2783 (setq menu-item (regexp-quote menu-item))
1bcedb3b
RS
2784 (let ((case-fold-search t))
2785 (save-excursion
760d5cb3
GM
2786 (let ((case-fold-search t))
2787 (goto-char (point-min))
2788 (or (search-forward "\n* menu:" nil t)
71873e2b 2789 (user-error "No menu in this node"))
760d5cb3
GM
2790 (or (re-search-forward (concat "\n\\* +" menu-item ":") nil t)
2791 (re-search-forward (concat "\n\\* +" menu-item) nil t)
71873e2b 2792 (user-error "No such item in menu"))
760d5cb3
GM
2793 (beginning-of-line)
2794 (forward-char 2)
141b49f5 2795 (Info-extract-menu-node-name nil (Info-index-node))))))
a384cab3
JB
2796
2797;; If COUNT is nil, use the last item in the menu.
c24d4826 2798(defun Info-extract-menu-counting (count &optional no-detail)
1bcedb3b
RS
2799 (let ((case-fold-search t))
2800 (save-excursion
c24d4826
MR
2801 (let ((case-fold-search t)
2802 (bound (when (and no-detail
2803 (re-search-forward
2804 "^[ \t-]*The Detailed Node Listing" nil t))
2805 (match-beginning 0))))
760d5cb3 2806 (goto-char (point-min))
c24d4826 2807 (or (search-forward "\n* menu:" bound t)
71873e2b 2808 (user-error "No menu in this node"))
760d5cb3 2809 (if count
c24d4826 2810 (or (search-forward "\n* " bound t count)
760d5cb3 2811 (error "Too few items in menu"))
c24d4826 2812 (while (search-forward "\n* " bound t)
760d5cb3 2813 nil))
141b49f5 2814 (Info-extract-menu-node-name nil (Info-index-node))))))
a384cab3 2815
e38e7367
RM
2816(defun Info-nth-menu-item ()
2817 "Go to the node of the Nth menu item.
2818N is the digit argument used to invoke this command."
a384cab3 2819 (interactive)
e38e7367
RM
2820 (Info-goto-node
2821 (Info-extract-menu-counting
2822 (- (aref (this-command-keys) (1- (length (this-command-keys)))) ?0))))
a384cab3
JB
2823
2824(defun Info-top-node ()
2825 "Go to the Top node of this file."
2826 (interactive)
2827 (Info-goto-node "Top"))
2828
2829(defun Info-final-node ()
2830 "Go to the final node in this file."
2831 (interactive)
2832 (Info-goto-node "Top")
760d5cb3
GM
2833 (let ((Info-history nil)
2834 (case-fold-search t))
c24d4826
MR
2835 ;; Go to the last node in the menu of Top. But don't delve into
2836 ;; detailed node listings.
2837 (Info-goto-node (Info-extract-menu-counting nil t))
a384cab3 2838 ;; If the last node in the menu is not last in pointer structure,
c24d4826
MR
2839 ;; move forward (but not down- or upward - see bug#1116) until we
2840 ;; can't go any farther.
2841 (while (Info-forward-node t t t) nil)
a384cab3 2842 ;; Then keep moving down to last subnode, unless we reach an index.
141b49f5 2843 (while (and (not (Info-index-node))
a384cab3
JB
2844 (save-excursion (search-forward "\n* Menu:" nil t)))
2845 (Info-goto-node (Info-extract-menu-counting nil)))))
2846
c24d4826 2847(defun Info-forward-node (&optional not-down not-up no-error)
a384cab3
JB
2848 "Go forward one node, considering all nodes as forming one sequence."
2849 (interactive)
2850 (goto-char (point-min))
2851 (forward-line 1)
760d5cb3
GM
2852 (let ((case-fold-search t))
2853 ;; three possibilities, in order of priority:
2854 ;; 1. next node is in a menu in this node (but not in an index)
2855 ;; 2. next node is next at same level
2856 ;; 3. next node is up and next
2857 (cond ((and (not not-down)
2858 (save-excursion (search-forward "\n* menu:" nil t))
141b49f5 2859 (not (Info-index-node)))
760d5cb3
GM
2860 (Info-goto-node (Info-extract-menu-counting 1))
2861 t)
6af7040d 2862 ((save-excursion (search-backward "next:" nil t))
760d5cb3
GM
2863 (Info-next)
2864 t)
c24d4826
MR
2865 ((and (not not-up)
2866 (save-excursion (search-backward "up:" nil t))
760d5cb3
GM
2867 ;; Use string-equal, not equal, to ignore text props.
2868 (not (string-equal (downcase (Info-extract-pointer "up"))
2869 "top")))
2870 (let ((old-node Info-current-node))
2871 (Info-up)
3820edeb
JL
2872 (let ((old-history Info-history)
2873 success)
760d5cb3 2874 (unwind-protect
c24d4826 2875 (setq success (Info-forward-node t nil no-error))
3820edeb
JL
2876 (or success (Info-goto-node old-node)))
2877 (if Info-history-skip-intermediate-nodes
2878 (setq Info-history old-history)))))
760d5cb3 2879 (no-error nil)
71873e2b 2880 (t (user-error "No pointer forward from this node")))))
a384cab3
JB
2881
2882(defun Info-backward-node ()
2883 "Go backward one node, considering all nodes as forming one sequence."
2884 (interactive)
2885 (let ((prevnode (Info-extract-pointer "prev[ious]*" t))
760d5cb3
GM
2886 (upnode (Info-extract-pointer "up" t))
2887 (case-fold-search t))
a384cab3 2888 (cond ((and upnode (string-match "(" upnode))
71873e2b 2889 (user-error "First node in file"))
a384cab3 2890 ((and upnode (or (null prevnode)
e90d1271
RS
2891 ;; Use string-equal, not equal,
2892 ;; to ignore text properties.
2893 (string-equal (downcase prevnode)
2894 (downcase upnode))))
a384cab3
JB
2895 (Info-up))
2896 (prevnode
2897 ;; If we move back at the same level,
2898 ;; go down to find the last subnode*.
2899 (Info-prev)
3820edeb 2900 (let ((old-history Info-history))
141b49f5 2901 (while (and (not (Info-index-node))
a384cab3 2902 (save-excursion (search-forward "\n* Menu:" nil t)))
3820edeb
JL
2903 (Info-goto-node (Info-extract-menu-counting nil)))
2904 (if Info-history-skip-intermediate-nodes
2905 (setq Info-history old-history))))
a384cab3 2906 (t
71873e2b 2907 (user-error "No pointer backward from this node")))))
a384cab3
JB
2908
2909(defun Info-exit ()
2910 "Exit Info by selecting some other buffer."
2911 (interactive)
552775bd
RS
2912 (if Info-standalone
2913 (save-buffers-kill-emacs)
4643e92f 2914 (quit-window)))
a384cab3 2915
253db917 2916(defun Info-next-menu-item ()
3a8803c0 2917 "Go to the node of the next menu item."
253db917 2918 (interactive)
fdf4b680 2919 ;; Bind this in case the user sets it to nil.
760d5cb3
GM
2920 (let* ((case-fold-search t)
2921 (node
2922 (save-excursion
2923 (forward-line -1)
2924 (search-forward "\n* menu:" nil t)
2925 (and (search-forward "\n* " nil t)
2926 (Info-extract-menu-node-name)))))
fadfb77f 2927 (if node (Info-goto-node node)
71873e2b 2928 (user-error "No more items in menu"))))
253db917
ER
2929
2930(defun Info-last-menu-item ()
3a8803c0 2931 "Go to the node of the previous menu item."
253db917
ER
2932 (interactive)
2933 (save-excursion
2934 (forward-line 1)
fdf4b680 2935 ;; Bind this in case the user sets it to nil.
760d5cb3
GM
2936 (let* ((case-fold-search t)
2937 (beg (save-excursion
2938 (and (search-backward "\n* menu:" nil t)
2939 (point)))))
0a56332b 2940 (or (and beg (search-backward "\n* " beg t))
71873e2b 2941 (user-error "No previous items in menu")))
0a56332b
RS
2942 (Info-goto-node (save-excursion
2943 (goto-char (match-end 0))
2944 (Info-extract-menu-node-name)))))
253db917 2945
552775bd 2946(defmacro Info-no-error (&rest body)
651eaf36 2947 `(condition-case nil (progn ,@body t) (error nil)))
253db917
ER
2948
2949(defun Info-next-preorder ()
3c9179ea
RS
2950 "Go to the next subnode or the next node, or go up a level."
2951 (interactive)
2952 (cond ((Info-no-error (Info-next-menu-item)))
2953 ((Info-no-error (Info-next)))
5dab2fb4 2954 ((Info-no-error (Info-up t))
ed690657
KH
2955 ;; Since we have already gone thru all the items in this menu,
2956 ;; go up to the end of this node.
b54d0f0e
RS
2957 (goto-char (point-max))
2958 ;; Since logically we are done with the node with that menu,
fd3d78f2
JL
2959 ;; move on from it. But don't add intermediate nodes
2960 ;; to the history on recursive calls.
3820edeb
JL
2961 (let ((old-history Info-history))
2962 (Info-next-preorder)
2963 (if Info-history-skip-intermediate-nodes
2964 (setq Info-history old-history))))
3c9179ea 2965 (t
71873e2b 2966 (user-error "No more nodes"))))
253db917
ER
2967
2968(defun Info-last-preorder ()
2969 "Go to the last node, popping up a level if there is none."
2970 (interactive)
5147931d
JL
2971 (cond ((and Info-scroll-prefer-subnodes
2972 (Info-no-error
2973 (Info-last-menu-item)
2974 ;; If we go down a menu item, go to the end of the node
2975 ;; so we can scroll back through it.
2976 (goto-char (point-max))))
b54d0f0e 2977 ;; Keep going down, as long as there are nested menu nodes.
3820edeb 2978 (let ((old-history Info-history))
d18b513b
JL
2979 (while (Info-no-error
2980 (Info-last-menu-item)
2981 ;; If we go down a menu item, go to the end of the node
2982 ;; so we can scroll back through it.
3820edeb
JL
2983 (goto-char (point-max))))
2984 (if Info-history-skip-intermediate-nodes
2985 (setq Info-history old-history)))
ed690657 2986 (recenter -1))
c2def7a0
MB
2987 ((and (Info-no-error (Info-extract-pointer "prev"))
2988 (not (equal (Info-extract-pointer "up")
5dab2fb4
RS
2989 (Info-extract-pointer "prev"))))
2990 (Info-no-error (Info-prev))
ed690657 2991 (goto-char (point-max))
3820edeb 2992 (let ((old-history Info-history))
d18b513b
JL
2993 (while (Info-no-error
2994 (Info-last-menu-item)
2995 ;; If we go down a menu item, go to the end of the node
2996 ;; so we can scroll back through it.
3820edeb
JL
2997 (goto-char (point-max))))
2998 (if Info-history-skip-intermediate-nodes
2999 (setq Info-history old-history)))
ed690657 3000 (recenter -1))
5dab2fb4 3001 ((Info-no-error (Info-up t))
ed690657 3002 (goto-char (point-min))
760d5cb3
GM
3003 (let ((case-fold-search t))
3004 (or (search-forward "\n* Menu:" nil t)
3005 (goto-char (point-max)))))
71873e2b 3006 (t (user-error "No previous nodes"))))
253db917
ER
3007
3008(defun Info-scroll-up ()
3f32dc86 3009 "Scroll one screenful forward in Info, considering all nodes as one sequence.
280d11ed 3010Once you scroll far enough in a node that its menu appears on the screen
7a53d8c8
EZ
3011but after point, the next scroll moves into its first subnode, unless
3012`Info-scroll-prefer-subnodes' is nil.
280d11ed 3013
7a53d8c8
EZ
3014When you scroll past the end of a node, that goes to the next node if
3015`Info-scroll-prefer-subnodes' is non-nil and to the first subnode otherwise;
3016if this node has no successor, it moves to the parent node's successor,
3017and so on. If `Info-scroll-prefer-subnodes' is non-nil and point is inside
3018the menu of a node, it moves to subnode indicated by the following menu
3019item. (That case won't normally result from this command, but can happen
3020in other ways.)"
280d11ed 3021
253db917 3022 (interactive)
0a56332b
RS
3023 (if (or (< (window-start) (point-min))
3024 (> (window-start) (point-max)))
3025 (set-window-start (selected-window) (point)))
760d5cb3
GM
3026 (let* ((case-fold-search t)
3027 (virtual-end (save-excursion
3028 (goto-char (point-min))
7a53d8c8
EZ
3029 (if (and Info-scroll-prefer-subnodes
3030 (search-forward "\n* Menu:" nil t))
760d5cb3
GM
3031 (point)
3032 (point-max)))))
0a56332b
RS
3033 (if (or (< virtual-end (window-start))
3034 (pos-visible-in-window-p virtual-end))
7a53d8c8
EZ
3035 (cond
3036 (Info-scroll-prefer-subnodes (Info-next-preorder))
3037 ((Info-no-error (Info-goto-node (Info-extract-menu-counting 1))))
3038 (t (Info-next-preorder)))
0a56332b 3039 (scroll-up))))
253db917 3040
8aab8422
CY
3041(defun Info-mouse-scroll-up (e)
3042 "Scroll one screenful forward in Info, using the mouse.
3043See `Info-scroll-up'."
3044 (interactive "e")
3045 (save-selected-window
3046 (if (eventp e)
3047 (select-window (posn-window (event-start e))))
3048 (Info-scroll-up)))
3049
253db917 3050(defun Info-scroll-down ()
3f32dc86 3051 "Scroll one screenful back in Info, considering all nodes as one sequence.
c2def7a0
MB
3052If point is within the menu of a node, and `Info-scroll-prefer-subnodes'
3053is non-nil, this goes to its last subnode. When you scroll past the
3054beginning of a node, that goes to the previous node or back up to the
3055parent node."
253db917 3056 (interactive)
0a56332b
RS
3057 (if (or (< (window-start) (point-min))
3058 (> (window-start) (point-max)))
3059 (set-window-start (selected-window) (point)))
760d5cb3
GM
3060 (let* ((case-fold-search t)
3061 (current-point (point))
c2def7a0
MB
3062 (virtual-end
3063 (and Info-scroll-prefer-subnodes
3064 (save-excursion
9b026d9f 3065 (setq current-point (line-beginning-position))
c2def7a0 3066 (goto-char (point-min))
9b026d9f 3067 (search-forward "\n* Menu:" current-point t)))))
3a8803c0 3068 (if (or virtual-end
7afe24e3 3069 (pos-visible-in-window-p (point-min) nil t))
0a56332b
RS
3070 (Info-last-preorder)
3071 (scroll-down))))
253db917 3072
8aab8422
CY
3073(defun Info-mouse-scroll-down (e)
3074 "Scroll one screenful backward in Info, using the mouse.
3075See `Info-scroll-down'."
3076 (interactive "e")
3077 (save-selected-window
3078 (if (eventp e)
3079 (select-window (posn-window (event-start e))))
3080 (Info-scroll-down)))
3081
afff09d0
JL
3082(defun Info-next-reference-or-link (pat prop)
3083 "Move point to the next pattern-based cross-reference or property-based link.
3084The next cross-reference is searched using the regexp PAT, and the next link
3085is searched using the text property PROP. Move point to the closest found position
3086of either a cross-reference found by `re-search-forward' or a link found by
3087`next-single-char-property-change'. Return the new position of point, or nil."
e38e6780 3088 (let ((pxref (save-excursion (re-search-forward pat nil t)))
afff09d0
JL
3089 (plink (next-single-char-property-change (point) prop)))
3090 (when (and (< plink (point-max)) (not (get-char-property plink prop)))
3091 (setq plink (next-single-char-property-change plink prop)))
3092 (if (< plink (point-max))
e38e6780 3093 (if (and pxref (<= pxref plink))
afff09d0
JL
3094 (goto-char (or (match-beginning 1) (match-beginning 0)))
3095 (goto-char plink))
e38e6780 3096 (if pxref (goto-char (or (match-beginning 1) (match-beginning 0)))))))
afff09d0
JL
3097
3098(defun Info-prev-reference-or-link (pat prop)
3099 "Move point to the previous pattern-based cross-reference or property-based link.
3100The previous cross-reference is searched using the regexp PAT, and the previous link
3101is searched using the text property PROP. Move point to the closest found position
3102of either a cross-reference found by `re-search-backward' or a link found by
3103`previous-single-char-property-change'. Return the new position of point, or nil."
e38e6780 3104 (let ((pxref (save-excursion (re-search-backward pat nil t)))
afff09d0
JL
3105 (plink (previous-single-char-property-change (point) prop)))
3106 (when (and (> plink (point-min)) (not (get-char-property plink prop)))
3107 (setq plink (previous-single-char-property-change plink prop)))
3108 (if (> plink (point-min))
e38e6780 3109 (if (and pxref (>= pxref plink))
afff09d0
JL
3110 (goto-char (or (match-beginning 1) (match-beginning 0)))
3111 (goto-char plink))
e38e6780 3112 (if pxref (goto-char (or (match-beginning 1) (match-beginning 0)))))))
afff09d0 3113
7b6d5ecf
CS
3114(defun Info-next-reference (&optional recur count)
3115 "Move cursor to the next cross-reference or menu item in the node.
3116If COUNT is non-nil (interactively with a prefix arg), jump over
3117COUNT cross-references."
3118 (interactive "i\np")
3119 (unless count
3120 (setq count 1))
3121 (if (< count 0)
3122 (Info-prev-reference recur (- count))
3123 (while (unless (zerop count) (setq count (1- count)))
3124 (let ((pat "\\*note[ \n\t]+\\([^:]+\\):\\|^\\* .*:\\|[hf]t?tps?://")
3125 (old-pt (point))
3126 (case-fold-search t))
3127 (or (eobp) (forward-char 1))
afff09d0 3128 (or (Info-next-reference-or-link pat 'link)
7b6d5ecf
CS
3129 (progn
3130 (goto-char (point-min))
afff09d0 3131 (or (Info-next-reference-or-link pat 'link)
7b6d5ecf
CS
3132 (progn
3133 (goto-char old-pt)
3134 (user-error "No cross references in this node")))))
7b6d5ecf
CS
3135 (if (looking-at "\\* Menu:")
3136 (if recur
3137 (user-error "No cross references in this node")
3138 (Info-next-reference t))
3139 (if (looking-at "^\\* ")
3140 (forward-char 2)))))))
3141
3142(defun Info-prev-reference (&optional recur count)
3143 "Move cursor to the previous cross-reference or menu item in the node.
3144If COUNT is non-nil (interactively with a prefix arg), jump over
3145COUNT cross-references."
3146 (interactive "i\np")
3147 (unless count
3148 (setq count 1))
3149 (if (< count 0)
3150 (Info-next-reference recur (- count))
3151 (while (unless (zerop count) (setq count (1- count)))
3152 (let ((pat "\\*note[ \n\t]+\\([^:]+\\):\\|^\\* .*:\\|[hf]t?tps?://")
3153 (old-pt (point))
3154 (case-fold-search t))
afff09d0 3155 (or (Info-prev-reference-or-link pat 'link)
7b6d5ecf
CS
3156 (progn
3157 (goto-char (point-max))
afff09d0 3158 (or (Info-prev-reference-or-link pat 'link)
7b6d5ecf
CS
3159 (progn
3160 (goto-char old-pt)
3161 (user-error "No cross references in this node")))))
7b6d5ecf
CS
3162 (if (looking-at "\\* Menu:")
3163 (if recur
3164 (user-error "No cross references in this node")
3165 (Info-prev-reference t))
3166 (if (looking-at "^\\* ")
3167 (forward-char 2)))))))
141b49f5 3168\f
141b49f5
JL
3169(defun Info-index-nodes (&optional file)
3170 "Return a list of names of all index nodes in Info FILE.
3171If FILE is omitted, it defaults to the current Info file.
50163b00
JL
3172First look in a list of cached index node names. Then scan Info
3173file and its subfiles for nodes with the index cookie. Then try
3174to find index nodes starting from the first node in the top level
3175menu whose name contains the word \"Index\", plus any immediately
3176following nodes whose names also contain the word \"Index\"."
141b49f5
JL
3177 (or file (setq file Info-current-file))
3178 (or (assoc file Info-index-nodes)
3179 ;; Skip virtual Info files
586f9284 3180 (and (or (not (stringp file))
6a013a49 3181 (Info-virtual-file-p file))
50163b00 3182 (setq Info-index-nodes (cons (cons file nil) Info-index-nodes)))
66fc722f 3183 (if (Info-file-supports-index-cookies file)
94b10022
JL
3184 ;; Find nodes with index cookie
3185 (let* ((default-directory (or (and (stringp file)
3186 (file-name-directory
3187 (setq file (Info-find-file file))))
3188 default-directory))
3189 Info-history Info-history-list Info-fontify-maximum-menu-size
c2a37b78 3190 (main-file file) subfiles nodes)
94b10022
JL
3191 (condition-case nil
3192 (with-temp-buffer
3193 (while (or main-file subfiles)
3194 (erase-buffer)
3195 (info-insert-file-contents (or main-file (car subfiles)))
3196 (goto-char (point-min))
3197 (while (search-forward "\0\b[index\0\b]" nil 'move)
3198 (save-excursion
3199 (re-search-backward "^\^_")
3200 (search-forward "Node: ")
3201 (setq nodes (cons (Info-following-node-name) nodes))))
3202 (if main-file
3203 (save-excursion
3204 (goto-char (point-min))
3205 (if (search-forward "\n\^_\nIndirect:" nil t)
3206 (let ((bound (save-excursion (search-forward "\n\^_" nil t))))
3207 (while (re-search-forward "^\\(.*\\): [0-9]+$" bound t)
3208 (setq subfiles (cons (match-string-no-properties 1)
3209 subfiles)))))
3210 (setq subfiles (nreverse subfiles)
3211 main-file nil))
3212 (setq subfiles (cdr subfiles)))))
3213 (error nil))
3214 (if nodes
3215 (setq nodes (nreverse nodes)
3216 Info-index-nodes (cons (cons file nodes) Info-index-nodes)))
3217 nodes)
3218 ;; Else find nodes with the word "Index" in the node name
3219 (let ((case-fold-search t)
66fc722f 3220 Info-history Info-history-list Info-fontify-maximum-menu-size Info-point-loc
94b10022
JL
3221 nodes node)
3222 (condition-case nil
3223 (with-temp-buffer
3224 (Info-mode)
3225 (Info-find-node file "Top")
3226 (when (and (search-forward "\n* menu:" nil t)
3227 (re-search-forward "\n\\* \\(.*\\<Index\\>\\)" nil t))
3228 (goto-char (match-beginning 1))
3229 (setq nodes (list (Info-extract-menu-node-name)))
3230 (Info-goto-node (car nodes))
3231 (while (and (setq node (Info-extract-pointer "next" t))
3232 (string-match "\\<Index\\>" node))
c2a37b78 3233 (push node nodes)
94b10022
JL
3234 (Info-goto-node node))))
3235 (error nil))
3236 (if nodes
3237 (setq nodes (nreverse nodes)
3238 Info-index-nodes (cons (cons file nodes) Info-index-nodes)))
3239 nodes))
50163b00
JL
3240 ;; If file has no index nodes, still add it to the cache
3241 (setq Info-index-nodes (cons (cons file nil) Info-index-nodes)))
141b49f5
JL
3242 (cdr (assoc file Info-index-nodes)))
3243
3244(defun Info-index-node (&optional node file)
3245 "Return non-nil value if NODE is an index node.
3246If NODE is nil, check the current Info node.
3247If FILE is nil, check the current Info file."
66fc722f 3248 (or file (setq file Info-current-file))
6a013a49
JL
3249 (if (and (or (and node (not (equal node Info-current-node)))
3250 (assoc file Info-index-nodes))
3251 (not Info-current-node-virtual))
50163b00
JL
3252 (member (or node Info-current-node) (Info-index-nodes file))
3253 ;; Don't search all index nodes if request is only for the current node
3254 ;; and file is not in the cache of index nodes
6a013a49
JL
3255 (save-match-data
3256 (if (Info-file-supports-index-cookies file)
3257 (save-excursion
3258 (goto-char (+ (or (save-excursion
3259 (search-backward "\n\^_" nil t))
3260 (point-min)) 2))
3261 (search-forward "\0\b[index\0\b]"
3262 (or (save-excursion
3263 (search-forward "\n\^_" nil t))
3264 (point-max)) t))
94b10022 3265 (string-match "\\<Index\\>" (or node Info-current-node ""))))))
552775bd 3266
e4e8ee63 3267(defun Info-goto-index ()
141b49f5
JL
3268 "Go to the first index node."
3269 (let ((node (car (Info-index-nodes))))
3270 (or node (error "No index"))
3271 (Info-goto-node node)))
e4e8ee63 3272
201bc1bd 3273;;;###autoload
1143a6b0 3274(defun Info-index (topic)
4a99f153 3275 "Look up a string TOPIC in the index for this manual and go to that entry.
1143a6b0
ER
3276If there are no exact matches to the specified topic, this chooses
3277the first match which is a case-insensitive substring of a topic.
89b064a9 3278Use the \\<Info-mode-map>\\[Info-index-next] command to see the other matches.
4a99f153 3279Give an empty topic name to go to the Index node itself."
e4e8ee63
SM
3280 (interactive
3281 (list
ea71ffe8
CY
3282 (let ((completion-ignore-case t)
3283 (Info-complete-menu-buffer (clone-buffer))
141b49f5
JL
3284 (Info-complete-nodes (Info-index-nodes))
3285 (Info-history-list nil))
aebd1760
RS
3286 (if (equal Info-current-file "dir")
3287 (error "The Info directory node has no index; use m to select a manual"))
e4e8ee63
SM
3288 (unwind-protect
3289 (with-current-buffer Info-complete-menu-buffer
3290 (Info-goto-index)
3291 (completing-read "Index topic: " 'Info-complete-menu-item))
3292 (kill-buffer Info-complete-menu-buffer)))))
aebd1760
RS
3293 (if (equal Info-current-file "dir")
3294 (error "The Info directory node has no index; use m to select a manual"))
03e8d958
KS
3295 ;; Strip leading colon in topic; index format does not allow them.
3296 (if (and (stringp topic)
3297 (> (length topic) 0)
3298 (= (aref topic 0) ?:))
3299 (setq topic (substring topic 1)))
1143a6b0 3300 (let ((orignode Info-current-node)
e38e6780 3301 (pattern (format "\n\\* +\\([^\n]*\\(%s\\)[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?"
1143a6b0 3302 (regexp-quote topic)))
141b49f5
JL
3303 node (nodes (Info-index-nodes))
3304 (ohist-list Info-history-list)
1bcedb3b 3305 (case-fold-search t))
e700ec12 3306 (Info-goto-index)
1143a6b0
ER
3307 (or (equal topic "")
3308 (let ((matches nil)
3309 (exact nil)
e700ec12
SM
3310 ;; We bind Info-history to nil for internal node-switches so
3311 ;; that we don't put junk in the history. In the first
3312 ;; Info-goto-index call, above, we do update the history
3313 ;; because that is what the user's previous node choice into it.
c696ac76 3314 (Info-history nil)
1143a6b0
ER
3315 found)
3316 (while
3317 (progn
3318 (goto-char (point-min))
3319 (while (re-search-forward pattern nil t)
e38e6780
JL
3320 (let ((entry (match-string-no-properties 1))
3321 (nodename (match-string-no-properties 3))
3322 (line (string-to-number (concat "0" (match-string 4)))))
3323 (add-text-properties
3324 (- (match-beginning 2) (match-beginning 1))
3325 (- (match-end 2) (match-beginning 1))
3326 '(face info-index-match) entry)
3327 (push (list entry nodename Info-current-node line) matches)))
141b49f5 3328 (setq nodes (cdr nodes) node (car nodes)))
1143a6b0
ER
3329 (Info-goto-node node))
3330 (or matches
3331 (progn
81e14cb2 3332 (Info-goto-node orignode)
71873e2b 3333 (user-error "No `%s' in index" topic)))
1143a6b0
ER
3334 ;; Here it is a feature that assoc is case-sensitive.
3335 (while (setq found (assoc topic matches))
3336 (setq exact (cons found exact)
3337 matches (delq found matches)))
141b49f5 3338 (setq Info-history-list ohist-list)
1143a6b0
ER
3339 (setq Info-index-alternatives (nconc exact (nreverse matches)))
3340 (Info-index-next 0)))))
3341
3342(defun Info-index-next (num)
89b064a9 3343 "Go to the next matching index item from the last \\<Info-mode-map>\\[Info-index] command."
1143a6b0
ER
3344 (interactive "p")
3345 (or Info-index-alternatives
71873e2b 3346 (user-error "No previous `i' command"))
1143a6b0
ER
3347 (while (< num 0)
3348 (setq num (+ num (length Info-index-alternatives))))
3349 (while (> num 0)
3350 (setq Info-index-alternatives
3351 (nconc (cdr Info-index-alternatives)
3352 (list (car Info-index-alternatives)))
3353 num (1- num)))
3354 (Info-goto-node (nth 1 (car Info-index-alternatives)))
3355 (if (> (nth 3 (car Info-index-alternatives)) 0)
3bc71084
JL
3356 ;; Forward 2 lines less because `Info-find-node-2' initially
3357 ;; puts point to the 2nd line.
7187cdae 3358 (forward-line (- (nth 3 (car Info-index-alternatives)) 2))
760d5cb3 3359 (forward-line 3) ; don't search in headers
1143a6b0 3360 (let ((name (car (car Info-index-alternatives))))
920bdaab
RS
3361 (Info-find-index-name name)))
3362 (message "Found `%s' in %s. %s"
1143a6b0
ER
3363 (car (car Info-index-alternatives))
3364 (nth 2 (car Info-index-alternatives))
3365 (if (cdr Info-index-alternatives)
fa62821e
EZ
3366 (format "(%s total; use `%s' for next)"
3367 (length Info-index-alternatives)
3368 (key-description (where-is-internal
3369 'Info-index-next overriding-local-map
3370 t)))
1143a6b0
ER
3371 "(Only match)")))
3372
920bdaab
RS
3373(defun Info-find-index-name (name)
3374 "Move point to the place within the current node where NAME is defined."
1bcedb3b
RS
3375 (let ((case-fold-search t))
3376 (if (or (re-search-forward (format
3377 "[a-zA-Z]+: %s\\( \\|$\\)"
3378 (regexp-quote name)) nil t)
d31c6ecf
RS
3379 ;; Find a function definition with a return type.
3380 (re-search-forward (format
f2fc5b0a 3381 "[a-zA-Z]+: [a-zA-Z0-9_ *&]+ %s\\( \\|$\\)"
d31c6ecf 3382 (regexp-quote name)) nil t)
1bcedb3b
RS
3383 (search-forward (format "`%s'" name) nil t)
3384 (and (string-match "\\`.*\\( (.*)\\)\\'" name)
3385 (search-forward
3386 (format "`%s'" (substring name 0 (match-beginning 1)))
3387 nil t))
bbe054f7
EZ
3388 (search-forward name nil t)
3389 ;; Try again without the " <1>" makeinfo can append
3390 (and (string-match "\\`\\(.*\\) <[0-9]+>\\'" name)
3391 (Info-find-index-name (match-string 1 name))))
3392 (progn (beginning-of-line) t) ;; non-nil for recursive call
1bcedb3b 3393 (goto-char (point-min)))))
6a013a49
JL
3394\f
3395(add-to-list 'Info-virtual-nodes
3396 '("\\`\\*Index.*\\*\\'"
3397 (find-node . Info-virtual-index-find-node)
221a0647 3398 (slow . t)
6a013a49
JL
3399 ))
3400
3401(defvar Info-virtual-index-nodes nil
3402 "Alist of cached matched index search nodes.
3403Each element is ((FILENAME . TOPIC) MATCHES) where
3404FILENAME is the file name of the manual,
3405TOPIC is the search string given as an argument to `Info-virtual-index',
3406MATCHES is a list of index matches found by `Info-index'.")
3407
6194c800
JB
3408(defun Info-virtual-index-find-node (filename nodename &optional _no-going-back)
3409 "Index-specific implementation of `Info-find-node-2'."
6a013a49
JL
3410 ;; Generate Index-like menu of matches
3411 (if (string-match "^\\*Index for `\\(.+\\)'\\*$" nodename)
3412 ;; Generate Index-like menu of matches
3413 (let* ((topic (match-string 1 nodename))
3414 (matches (cdr (assoc (cons (or filename Info-current-file) topic)
3415 Info-virtual-index-nodes))))
3416 (insert (format "\n\^_\nFile: %s, Node: %s, Up: *Index*\n\n"
3417 (or filename Info-current-file) nodename))
3418 (insert "Info Virtual Index\n")
3419 (insert "******************\n\n")
3420 (insert "Index entries that match `" topic "':\n\n")
3421 (insert "\0\b[index\0\b]\n")
3422 (if (null matches)
3423 (insert "No matches found.\n")
3424 (insert "* Menu:\n\n")
3425 (dolist (entry matches)
3426 (insert (format "* %-38s %s.%s\n"
3427 (format "%s [%s]:" (nth 0 entry) (nth 2 entry))
3428 (nth 1 entry)
3429 (if (nth 3 entry)
3430 (format " (line %s)" (nth 3 entry))
3431 ""))))))
3432 ;; Else, Generate a list of previous search results
3433 (let ((nodes (reverse Info-virtual-index-nodes)))
3434 (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
3435 (or filename Info-current-file) nodename))
3436 (insert "Info Virtual Index\n")
3437 (insert "******************\n\n")
3438 (insert "This is a list of search results produced by\n"
3439 "`Info-virtual-index' for the current manual.\n\n")
3440 (insert "* Menu:\n\n")
3441 (dolist (nodeinfo nodes)
3442 (when (equal (car (nth 0 nodeinfo)) (or filename Info-current-file))
3443 (insert
3444 (format "* %-20s %s.\n"
3445 (format "*Index for `%s'*::" (cdr (nth 0 nodeinfo)))
3446 (cdr (nth 0 nodeinfo)))))))))
3447
3448(defun Info-virtual-index (topic)
3449 "Show a node with all lines in the index containing a string TOPIC.
3450Like `Info-index' but displays a node with index search results.
3451Give an empty topic name to go to the node with links to previous
3452search results."
3453 ;; `interactive' is a copy from `Info-index'
3454 (interactive
3455 (list
3456 (let ((completion-ignore-case t)
3457 (Info-complete-menu-buffer (clone-buffer))
3458 (Info-complete-nodes (Info-index-nodes))
3459 (Info-history-list nil))
3460 (if (equal Info-current-file "dir")
3461 (error "The Info directory node has no index; use m to select a manual"))
3462 (unwind-protect
3463 (with-current-buffer Info-complete-menu-buffer
3464 (Info-goto-index)
3465 (completing-read "Index topic: " 'Info-complete-menu-item))
3466 (kill-buffer Info-complete-menu-buffer)))))
3467 (if (equal topic "")
3468 (Info-find-node Info-current-file "*Index*")
3469 (unless (assoc (cons Info-current-file topic) Info-virtual-index-nodes)
3470 (let ((orignode Info-current-node)
6194c800 3471 (ohist-list Info-history-list))
6a013a49
JL
3472 ;; Reuse `Info-index' to set `Info-index-alternatives'.
3473 (Info-index topic)
3474 (push (cons (cons Info-current-file topic) Info-index-alternatives)
3475 Info-virtual-index-nodes)
ee7683eb 3476 ;; Clean up unnecessary side-effects of `Info-index'.
6a013a49
JL
3477 (setq Info-history-list ohist-list)
3478 (Info-goto-node orignode)
3479 (message "")))
3480 (Info-find-node Info-current-file (format "*Index for `%s'*" topic))))
3481\f
3482(add-to-list 'Info-virtual-files
3483 '("\\`\\*Apropos\\*\\'"
3484 (toc-nodes . Info-apropos-toc-nodes)
3485 (find-file . Info-apropos-find-file)
3486 (find-node . Info-apropos-find-node)
221a0647 3487 (slow . t)
6a013a49
JL
3488 ))
3489
3490(defvar Info-apropos-file "*Apropos*"
3491 "Info file name of the virtual manual for matches of `info-apropos'.")
3492
3493(defvar Info-apropos-nodes nil
3494 "Alist of cached apropos matched nodes.
3495Each element is (NODENAME STRING MATCHES) where
3496NODENAME is the name of the node that holds the search result,
3497STRING is the search string given as an argument to `info-apropos',
3498MATCHES is a list of index matches found by `Info-apropos-matches'.")
3499
3500(defun Info-apropos-toc-nodes (filename)
d264a46b 3501 "Apropos-specific implementation of `Info-toc-nodes'."
6a013a49
JL
3502 (let ((nodes (mapcar 'car (reverse Info-apropos-nodes))))
3503 `(,filename
3504 ("Top" nil nil ,nodes)
3505 ,@(mapcar (lambda (node) `(,node "Top" nil nil)) nodes))))
3506
6194c800
JB
3507(defun Info-apropos-find-file (filename &optional _noerror)
3508 "Apropos-specific implementation of `Info-find-file'."
6a013a49
JL
3509 filename)
3510
6194c800
JB
3511(defun Info-apropos-find-node (_filename nodename &optional _no-going-back)
3512 "Apropos-specific implementation of `Info-find-node-2'."
6a013a49
JL
3513 (if (equal nodename "Top")
3514 ;; Generate Top menu
3515 (let ((nodes (reverse Info-apropos-nodes)))
3516 (insert (format "\n\^_\nFile: %s, Node: %s, Up: (dir)\n\n"
3517 Info-apropos-file nodename))
3518 (insert "Apropos Index\n")
3519 (insert "*************\n\n")
3520 (insert "This is a list of search results produced by `info-apropos'.\n\n")
3521 (insert "* Menu:\n\n")
3522 (dolist (nodeinfo nodes)
3523 (insert (format "* %-20s %s.\n"
3524 (format "%s::" (nth 0 nodeinfo))
3525 (nth 1 nodeinfo)))))
3526 ;; Else, Generate Index-like menu of matches
3527 (let* ((nodeinfo (assoc nodename Info-apropos-nodes))
3528 (matches (nth 2 nodeinfo)))
3529 (when matches
3530 (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
3531 Info-apropos-file nodename))
3532 (insert "Apropos Index\n")
3533 (insert "*************\n\n")
3534 (insert "Index entries that match `" (nth 1 nodeinfo) "':\n\n")
3535 (insert "\0\b[index\0\b]\n")
3536 (if (eq matches t)
3537 (insert "No matches found.\n")
3538 (insert "* Menu:\n\n")
3539 (dolist (entry matches)
3540 (insert (format "* %-38s (%s)%s.%s\n"
3541 (format "%s [%s]:" (nth 1 entry) (nth 0 entry))
3542 (nth 0 entry)
3543 (nth 2 entry)
3544 (if (nth 3 entry)
3545 (format " (line %s)" (nth 3 entry))
3546 "")))))))))
3547
3548(defun Info-apropos-matches (string)
3549 "Collect STRING matches from all known Info files on your system.
3550Return a list of matches where each element is in the format
3551\((FILENAME INDEXTEXT NODENAME LINENUMBER))."
ab2f22ad 3552 (unless (string= string "")
e38e6780 3553 (let ((pattern (format "\n\\* +\\([^\n]*\\(%s\\)[^\n]*\\):[ \t]+\\([^\n]+\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?"
ab2f22ad
JH
3554 (regexp-quote string)))
3555 (ohist Info-history)
37600b6d 3556 (ohist-list Info-history-list)
ab2f22ad
JH
3557 (current-node Info-current-node)
3558 (current-file Info-current-file)
141b49f5
JL
3559 manuals matches node nodes)
3560 (let ((Info-fontify-maximum-menu-size nil))
ab2f22ad 3561 (Info-directory)
59ad6ae5
EZ
3562 ;; current-node and current-file are nil when they invoke info-apropos
3563 ;; as the first Info command, i.e. info-apropos loads info.el. In that
8350f087 3564 ;; case, we use (DIR)Top instead, to avoid signaling an error after
59ad6ae5
EZ
3565 ;; the search is complete.
3566 (when (null current-node)
3567 (setq current-file Info-current-file)
3568 (setq current-node Info-current-node))
ab2f22ad
JH
3569 (message "Searching indices...")
3570 (goto-char (point-min))
3571 (re-search-forward "\\* Menu: *\n" nil t)
7b30b20c 3572 (while (re-search-forward "\\*.*: *(\\([^)]+\\))" nil t)
9ef5b432
EZ
3573 ;; add-to-list makes sure we don't have duplicates in `manuals',
3574 ;; so that the following dolist loop runs faster.
3575 (add-to-list 'manuals (match-string 1)))
185cff95 3576 (dolist (manual (nreverse manuals))
ab2f22ad 3577 (message "Searching %s" manual)
185cff95
JL
3578 (condition-case err
3579 (if (setq nodes (Info-index-nodes (Info-find-file manual)))
141b49f5
JL
3580 (save-excursion
3581 (Info-find-node manual (car nodes))
3582 (while
3583 (progn
3584 (goto-char (point-min))
3585 (while (re-search-forward pattern nil t)
e38e6780
JL
3586 (let ((entry (match-string-no-properties 1))
3587 (nodename (match-string-no-properties 3))
3588 (line (match-string-no-properties 4)))
3589 (add-text-properties
3590 (- (match-beginning 2) (match-beginning 1))
3591 (- (match-end 2) (match-beginning 1))
3592 '(face info-index-match) entry)
3593 (setq matches (cons (list manual entry nodename line)
3594 matches))))
141b49f5 3595 (setq nodes (cdr nodes) node (car nodes)))
185cff95
JL
3596 (Info-goto-node node))))
3597 (error
3598 (message "%s" (if (eq (car-safe err) 'error)
3599 (nth 1 err) err))
3600 (sit-for 1 t)))))
bec275ed 3601 (Info-find-node current-file current-node)
37600b6d
JH
3602 (setq Info-history ohist
3603 Info-history-list ohist-list)
ab2f22ad 3604 (message "Searching indices...done")
6a013a49 3605 (or (nreverse matches) t))))
ab2f22ad 3606
6a013a49
JL
3607;;;###autoload
3608(defun info-apropos (string)
3609 "Grovel indices of all known Info files on your system for STRING.
3610Build a menu of the possible matches."
3611 (interactive "sIndex apropos: ")
3612 (if (equal string "")
3613 (Info-find-node Info-apropos-file "Top")
3614 (let* ((nodes Info-apropos-nodes) nodename)
3615 (while (and nodes (not (equal string (nth 1 (car nodes)))))
3616 (setq nodes (cdr nodes)))
3617 (if nodes
3618 (Info-find-node Info-apropos-file (car (car nodes)))
3619 (setq nodename (format "Index for `%s'" string))
3620 (push (list nodename string (Info-apropos-matches string))
3621 Info-apropos-nodes)
3622 (Info-find-node Info-apropos-file nodename)))))
3623\f
fcdd8562
JL
3624(add-to-list 'Info-virtual-files
3625 '("\\`\\*Finder.*\\*\\'"
3626 (find-file . Info-finder-find-file)
3627 (find-node . Info-finder-find-node)
3628 ))
3629
3630(defvar Info-finder-file "*Finder*"
3631 "Info file name of the virtual Info keyword finder manual.")
3632
6194c800
JB
3633(defun Info-finder-find-file (filename &optional _noerror)
3634 "Finder-specific implementation of `Info-find-file'."
fcdd8562
JL
3635 filename)
3636
3637(defvar finder-known-keywords)
fcdd8562 3638(declare-function find-library-name "find-func" (library))
57938a79 3639(declare-function finder-unknown-keywords "finder" ())
fcdd8562 3640(declare-function lm-commentary "lisp-mnt" (&optional file))
28886d5e 3641(defvar finder-keywords-hash)
d5a6b3ba 3642(defvar package--builtins) ; finder requires package
fcdd8562 3643
6194c800
JB
3644(defun Info-finder-find-node (_filename nodename &optional _no-going-back)
3645 "Finder-specific implementation of `Info-find-node-2'."
221a0647 3646 (require 'finder)
fcdd8562
JL
3647 (cond
3648 ((equal nodename "Top")
3649 ;; Display Top menu with descriptions of the keywords
3650 (insert (format "\n\^_\nFile: %s, Node: %s, Up: (dir)\n\n"
3651 Info-finder-file nodename))
3652 (insert "Finder Keywords\n")
3653 (insert "***************\n\n")
3654 (insert "* Menu:\n\n")
96ae4c8f 3655 (dolist (assoc (append '((all . "All package info")
d5a6b3ba 3656 (unknown . "Unknown keywords"))
96ae4c8f
CY
3657 finder-known-keywords))
3658 (let ((keyword (car assoc)))
3659 (insert (format "* %s %s.\n"
3660 (concat (symbol-name keyword) ": "
d5a6b3ba 3661 "Keyword " (symbol-name keyword) ".")
96ae4c8f 3662 (cdr assoc))))))
d5a6b3ba 3663 ((equal nodename "Keyword unknown")
57938a79
JL
3664 ;; Display unknown keywords
3665 (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
3666 Info-finder-file nodename))
3667 (insert "Finder Unknown Keywords\n")
3668 (insert "***********************\n\n")
3669 (insert "* Menu:\n\n")
3670 (mapc
3671 (lambda (assoc)
3672 (insert (format "* %-14s %s.\n"
d5a6b3ba
JL
3673 (concat (symbol-name (car assoc)) ": "
3674 "Keyword " (symbol-name (car assoc)) ".")
57938a79
JL
3675 (cdr assoc))))
3676 (finder-unknown-keywords)))
d5a6b3ba 3677 ((equal nodename "Keyword all")
75a3ff20
JL
3678 ;; Display all package info.
3679 (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
3680 Info-finder-file nodename))
3681 (insert "Finder Package Info\n")
3682 (insert "*******************\n\n")
d5a6b3ba
JL
3683 (insert "* Menu:\n\n")
3684 (let (desc)
3685 (dolist (package package--builtins)
3686 (setq desc (cdr-safe package))
3687 (when (vectorp desc)
3688 (insert (format "* %-16s %s.\n"
3689 (concat (symbol-name (car package)) "::")
3690 (aref desc 2)))))))
3691 ((string-match "\\`Keyword " nodename)
96ae4c8f
CY
3692 (setq nodename (substring nodename (match-end 0)))
3693 ;; Display packages that match the keyword
3694 ;; or the list of keywords separated by comma.
d5a6b3ba 3695 (insert (format "\n\^_\nFile: %s, Node: Keyword %s, Up: Top\n\n"
96ae4c8f
CY
3696 Info-finder-file nodename))
3697 (insert "Finder Packages\n")
3698 (insert "***************\n\n")
3699 (insert
3700 "The following packages match the keyword `" nodename "':\n\n")
3701 (insert "* Menu:\n\n")
3702 (let ((keywords
3703 (mapcar 'intern (if (string-match-p "," nodename)
3704 (split-string nodename ",[ \t\n]*" t)
3705 (list nodename))))
3706 hits desc)
d5a6b3ba
JL
3707 (dolist (keyword keywords)
3708 (push (copy-tree (gethash keyword finder-keywords-hash)) hits))
96ae4c8f
CY
3709 (setq hits (delete-dups (apply 'append hits)))
3710 (dolist (package hits)
d5a6b3ba 3711 (setq desc (cdr-safe (assq package package--builtins)))
96ae4c8f
CY
3712 (when (vectorp desc)
3713 (insert (format "* %-16s %s.\n"
3714 (concat (symbol-name package) "::")
3715 (aref desc 2)))))))
3716 (t
fcdd8562
JL
3717 ;; Display commentary section
3718 (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
3719 Info-finder-file nodename))
3720 (insert "Finder Commentary\n")
3721 (insert "*****************\n\n")
3722 (insert
3723 "Commentary section of the package `" nodename "':\n\n")
3724 (let ((str (lm-commentary (find-library-name nodename))))
3725 (if (null str)
3726 (insert "Can't find any Commentary section\n\n")
3727 (insert
3728 (with-temp-buffer
3729 (insert str)
3730 (goto-char (point-min))
3731 (delete-blank-lines)
3732 (goto-char (point-max))
3733 (delete-blank-lines)
3734 (goto-char (point-min))
3735 (while (re-search-forward "^;+ ?" nil t)
3736 (replace-match "" nil nil))
96ae4c8f 3737 (buffer-string))))))))
fcdd8562
JL
3738
3739;;;###autoload
75a3ff20
JL
3740(defun info-finder (&optional keywords)
3741 "Display descriptions of the keywords in the Finder virtual manual.
3742In interactive use, a prefix argument directs this command to read
3743a list of keywords separated by comma. After that, it displays a node
6194c800 3744with a list of packages that contain all specified keywords."
75a3ff20
JL
3745 (interactive
3746 (when current-prefix-arg
3747 (require 'finder)
3748 (list
3749 (completing-read-multiple
3750 "Keywords (separated by comma): "
3751 (mapcar 'symbol-name (mapcar 'car (append finder-known-keywords
3752 (finder-unknown-keywords))))
3753 nil t))))
fcdd8562 3754 (require 'finder)
75a3ff20
JL
3755 (if keywords
3756 (Info-find-node Info-finder-file (mapconcat 'identity keywords ", "))
3757 (Info-find-node Info-finder-file "Top")))
3758
fcdd8562 3759\f
a384cab3
JB
3760(defun Info-undefined ()
3761 "Make command be undefined in Info."
3762 (interactive)
3763 (ding))
3764
3765(defun Info-help ()
3766 "Enter the Info tutorial."
3767 (interactive)
3768 (delete-other-windows)
3769 (Info-find-node "info"
3770 (if (< (window-height) 23)
3771 "Help-Small-Screen"
3772 "Help")))
3773
3774(defun Info-summary ()
3775 "Display a brief summary of all Info commands."
3776 (interactive)
3777 (save-window-excursion
3778 (switch-to-buffer "*Help*")
881c84c7 3779 (setq buffer-read-only nil)
a384cab3
JB
3780 (erase-buffer)
3781 (insert (documentation 'Info-mode))
9d29f94c 3782 (help-mode)
a384cab3
JB
3783 (goto-char (point-min))
3784 (let (ch flag)
3785 (while (progn (setq flag (not (pos-visible-in-window-p (point-max))))
3786 (message (if flag "Type Space to see more"
3787 "Type Space to return to Info"))
fc039bdc 3788 (if (not (eq ?\s (setq ch (read-event))))
dbc4e1c1 3789 (progn (setq unread-command-events (list ch)) nil)
a384cab3 3790 flag))
552775bd
RS
3791 (scroll-up)))
3792 (bury-buffer "*Help*")))
a384cab3
JB
3793\f
3794(defun Info-get-token (pos start all &optional errorstring)
fdf4b680 3795 "Return the token around POS.
6194c800 3796POS must be somewhere inside the token.
a384cab3 3797START is a regular expression which will match the
6194c800 3798 beginning of the tokens delimited string.
a384cab3 3799ALL is a regular expression with a single
90a715f0 3800 parenthesized subpattern which is the token to be
fdf4b680 3801 returned. E.g. '{\(.*\)}' would return any string
a384cab3 3802 enclosed in braces around POS.
6194c800 3803ERRORSTRING optional fourth argument, controls action on no match:
a384cab3
JB
3804 nil: return nil
3805 t: beep
3806 a string: signal an error, using that string."
1bcedb3b
RS
3807 (let ((case-fold-search t))
3808 (save-excursion
3809 (goto-char pos)
3810 ;; First look for a match for START that goes across POS.
3811 (while (and (not (bobp)) (> (point) (- pos (length start)))
3812 (not (looking-at start)))
3813 (forward-char -1))
3814 ;; If we did not find one, search back for START
3815 ;; (this finds only matches that end at or before POS).
3816 (or (looking-at start)
3817 (progn
3818 (goto-char pos)
3819 (re-search-backward start (max (point-min) (- pos 200)) 'yes)))
3820 (let (found)
3821 (while (and (re-search-forward all (min (point-max) (+ pos 200)) 'yes)
3822 (not (setq found (and (<= (match-beginning 0) pos)
3823 (> (match-end 0) pos))))))
3824 (if (and found (<= (match-beginning 0) pos)
3825 (> (match-end 0) pos))
110d4e80 3826 (match-string-no-properties 1)
1bcedb3b
RS
3827 (cond ((null errorstring)
3828 nil)
3829 ((eq errorstring t)
3830 (beep)
3831 nil)
3832 (t
3833 (error "No %s around position %d" errorstring pos))))))))
a384cab3 3834
981947af 3835(defun Info-mouse-follow-nearest-node (click)
f9969361
RS
3836 "\\<Info-mode-map>Follow a node reference near point.
3837Like \\[Info-menu], \\[Info-follow-reference], \\[Info-next], \\[Info-prev] or \\[Info-up] command, depending on where you click.
981947af 3838At end of the node's text, moves to the next node, or up if none."
f9969361 3839 (interactive "e")
d1268e52 3840 (mouse-set-point click)
e2469835 3841 (and (not (Info-follow-nearest-node))
981947af 3842 (save-excursion (forward-line 1) (eobp))
ed690657 3843 (Info-next-preorder)))
981947af 3844
8a7757f6 3845(defun Info-follow-nearest-node (&optional fork)
d0b560c6
JB
3846 "Follow a node reference near point.
3847If point is on a reference, follow that reference. Otherwise,
04d6dfe2
R
3848if point is in a menu item description, follow that menu item.
3849
6716bfa4 3850If FORK is non-nil (interactively with a prefix arg), show the node in
04d6dfe2 3851a new Info buffer.
6716bfa4 3852If FORK is a string, it is the name to use for the new buffer."
8a7757f6
JL
3853 (interactive "P")
3854 (or (Info-try-follow-nearest-node fork)
d0b560c6
JB
3855 (when (save-excursion
3856 (search-backward "\n* menu:" nil t))
3857 (save-excursion
3858 (beginning-of-line)
3859 (while (not (or (bobp) (looking-at "[^ \t]\\|[ \t]*$")))
3860 (beginning-of-line 0))
3861 (when (looking-at "\\* +\\([^\t\n]*\\):")
3862 (Info-goto-node
8a7757f6 3863 (Info-extract-menu-item (match-string-no-properties 1)) fork)
d0b560c6 3864 t)))
2cf7c3d1
MR
3865 (and (eq this-command 'Info-mouse-follow-nearest-node)
3866 ;; Don't raise an error when mouse-1 is bound to this - it's
3867 ;; often used to simply select the window or frame.
3868 (eq 'mouse-1 (event-basic-type last-input-event)))
71873e2b 3869 (user-error "Point neither on reference nor in menu item description")))
981947af
KH
3870
3871;; Common subroutine.
8a7757f6 3872(defun Info-try-follow-nearest-node (&optional fork)
8aed3f67 3873 "Follow a node reference near point. Return non-nil if successful.
7d1ac206 3874If FORK is non-nil, it is passed to `Info-goto-node'."
6af7040d 3875 (let (node)
a384cab3 3876 (cond
baa7f3de
JB
3877 ((setq node (Info-get-token (point) "[hf]t?tps?://"
3878 "\\([hf]t?tps?://[^ \t\n\"`({<>})']+\\)"))
3879 (browse-url node)
3880 (setq node t))
8a7757f6
JL
3881 ((setq node (Info-get-token (point) "\\*note[ \n\t]+"
3882 "\\*note[ \n\t]+\\([^:]*\\):\\(:\\|[ \n\t]*(\\)?"))
8a7757f6 3883 (Info-follow-reference node fork))
afff09d0
JL
3884 ;; footnote
3885 ((setq node (Info-get-token (point) "(" "\\(([0-9]+)\\)"))
3886 (let ((old-point (point)) new-point)
3887 (save-excursion
3888 (goto-char (point-min))
3889 (when (re-search-forward "^[ \t]*-+ Footnotes -+$" nil t)
3890 (setq new-point (if (< old-point (point))
3891 ;; Go to footnote reference
3892 (and (search-forward node nil t)
3893 ;; Put point at beginning of link
3894 (match-beginning 0))
3895 ;; Go to footnote definition
3896 (search-backward node nil t)))))
3897 (if new-point
3898 (progn
3899 (goto-char new-point)
3900 (setq node t))
1e072639
SB
3901 (setq node nil))))
3902 ;; menu item: node name
3903 ((setq node (Info-get-token (point) "\\* +" "\\* +\\([^:]*\\)::"))
3904 (Info-goto-node node fork))
3905 ;; menu item: node name or index entry
3906 ((Info-get-token (point) "\\* +" "\\* +\\(.*\\): ")
3907 (beginning-of-line)
3908 (forward-char 2)
3909 (setq node (Info-extract-menu-node-name nil (Info-index-node)))
3910 (Info-goto-node node fork))
3911 ((setq node (Info-get-token (point) "Up: " "Up: \\([^,\n\t]*\\)"))
3912 (Info-goto-node node fork))
3913 ((setq node (Info-get-token (point) "Next: " "Next: \\([^,\n\t]*\\)"))
3914 (Info-goto-node node fork))
3915 ((setq node (Info-get-token (point) "File: " "File: \\([^,\n\t]*\\)"))
3916 (Info-goto-node "Top" fork))
3917 ((setq node (Info-get-token (point) "Prev: " "Prev: \\([^,\n\t]*\\)"))
3918 (Info-goto-node node fork)))
981947af 3919 node))
3c5d6dfb
JL
3920
3921(defun Info-mouse-follow-link (click)
3922 "Follow a link where you click."
e8c1cabf 3923 (interactive "@e")
3c5d6dfb
JL
3924 (let* ((position (event-start click))
3925 (posn-string (and position (posn-string position)))
136e1c1d
CY
3926 (link-args (if posn-string
3927 (get-text-property (cdr posn-string)
3928 'link-args
3929 (car posn-string))
3930 (get-char-property (posn-point position)
3931 'link-args))))
136e1c1d
CY
3932 (cond ((stringp link-args)
3933 (Info-goto-node link-args))
3934 ;; These special values of the `link-args' property are used
3935 ;; for navigation; see `Info-fontify-node'.
3936 ((eq link-args 'prev) (Info-prev))
3937 ((eq link-args 'next) (Info-next))
3938 ((eq link-args 'up) (Info-up)))))
3c5d6dfb 3939
a384cab3 3940\f
fdeb777a
SM
3941(defvar Info-mode-map
3942 (let ((map (make-keymap)))
3943 (suppress-keymap map)
b96dec83 3944 (define-key map "." 'beginning-of-buffer)
fdeb777a 3945 (define-key map " " 'Info-scroll-up)
958614cf 3946 (define-key map [?\S-\ ] 'Info-scroll-down)
fdeb777a
SM
3947 (define-key map "\C-m" 'Info-follow-nearest-node)
3948 (define-key map "\t" 'Info-next-reference)
3949 (define-key map "\e\t" 'Info-prev-reference)
fdeb777a
SM
3950 (define-key map [backtab] 'Info-prev-reference)
3951 (define-key map "1" 'Info-nth-menu-item)
3952 (define-key map "2" 'Info-nth-menu-item)
3953 (define-key map "3" 'Info-nth-menu-item)
3954 (define-key map "4" 'Info-nth-menu-item)
3955 (define-key map "5" 'Info-nth-menu-item)
3956 (define-key map "6" 'Info-nth-menu-item)
3957 (define-key map "7" 'Info-nth-menu-item)
3958 (define-key map "8" 'Info-nth-menu-item)
3959 (define-key map "9" 'Info-nth-menu-item)
3960 (define-key map "0" 'undefined)
3961 (define-key map "?" 'Info-summary)
3962 (define-key map "]" 'Info-forward-node)
3963 (define-key map "[" 'Info-backward-node)
3964 (define-key map "<" 'Info-top-node)
3965 (define-key map ">" 'Info-final-node)
b96dec83
LMI
3966 (define-key map "b" 'beginning-of-buffer)
3967 (put 'beginning-of-buffer :advertised-binding "b")
fdeb777a 3968 (define-key map "d" 'Info-directory)
c869783d 3969 (define-key map "e" 'end-of-buffer)
fdeb777a
SM
3970 (define-key map "f" 'Info-follow-reference)
3971 (define-key map "g" 'Info-goto-node)
3972 (define-key map "h" 'Info-help)
3973 (define-key map "i" 'Info-index)
6a013a49 3974 (define-key map "I" 'Info-virtual-index)
fdeb777a
SM
3975 (define-key map "l" 'Info-history-back)
3976 (define-key map "L" 'Info-history)
3977 (define-key map "m" 'Info-menu)
3978 (define-key map "n" 'Info-next)
3979 (define-key map "p" 'Info-prev)
3980 (define-key map "q" 'Info-exit)
3981 (define-key map "r" 'Info-history-forward)
3982 (define-key map "s" 'Info-search)
3983 (define-key map "S" 'Info-search-case-sensitively)
fdeb777a
SM
3984 (define-key map "\M-n" 'clone-buffer)
3985 (define-key map "t" 'Info-top-node)
3986 (define-key map "T" 'Info-toc)
3987 (define-key map "u" 'Info-up)
3988 ;; `w' for consistency with `dired-copy-filename-as-kill'.
3989 (define-key map "w" 'Info-copy-current-node-name)
3990 (define-key map "c" 'Info-copy-current-node-name)
3991 ;; `^' for consistency with `dired-up-directory'.
3992 (define-key map "^" 'Info-up)
3993 (define-key map "," 'Info-index-next)
3994 (define-key map "\177" 'Info-scroll-down)
3995 (define-key map [mouse-2] 'Info-mouse-follow-nearest-node)
3996 (define-key map [follow-link] 'mouse-face)
3d10db47
SS
3997 (define-key map [XF86Back] 'Info-history-back)
3998 (define-key map [XF86Forward] 'Info-history-forward)
fdeb777a 3999 map)
a384cab3 4000 "Keymap containing Info commands.")
fdeb777a 4001
75a209d4
RS
4002
4003(defun Info-check-pointer (item)
fdf4b680 4004 "Non-nil if ITEM is present in this node."
75a209d4
RS
4005 (condition-case nil
4006 (Info-extract-pointer item)
4007 (error nil)))
4008
d4af987a
DL
4009(easy-menu-define
4010 Info-mode-menu Info-mode-map
185cff95 4011 "Menu for Info files."
d4af987a
DL
4012 '("Info"
4013 ["Up" Info-up :active (Info-check-pointer "up")
4014 :help "Go up in the Info tree"]
4015 ["Next" Info-next :active (Info-check-pointer "next")
4016 :help "Go to the next node"]
4017 ["Previous" Info-prev :active (Info-check-pointer "prev[ious]*")
4018 :help "Go to the previous node"]
4019 ["Backward" Info-backward-node
4020 :help "Go backward one node, considering all as a sequence"]
4021 ["Forward" Info-forward-node
4022 :help "Go forward one node, considering all as a sequence"]
b96dec83 4023 ["Beginning" beginning-of-buffer
7210b6f5 4024 :help "Go to beginning of this node"]
d4af987a
DL
4025 ["Top" Info-top-node
4026 :help "Go to top node of file"]
4027 ["Final Node" Info-final-node
4028 :help "Go to final node in this file"]
4029 ("Menu Item" ["You should never see this" report-emacs-bug t])
4030 ("Reference" ["You should never see this" report-emacs-bug t])
4031 ["Search..." Info-search
4032 :help "Search for regular expression in this Info file"]
8a7757f6
JL
4033 ["Search Next" Info-search-next
4034 :help "Search for another occurrence of regular expression"]
d1268e52 4035 ["Go to Node..." Info-goto-node
d4af987a 4036 :help "Go to a named node"]
424b9d3e
JL
4037 ["Back in history" Info-history-back :active Info-history
4038 :help "Go back in history to the last node you were at"]
4039 ["Forward in history" Info-history-forward :active Info-history-forward
4040 :help "Go forward in history"]
8a7757f6 4041 ["History" Info-history :active Info-history-list
bc224645 4042 :help "Go to menu of visited nodes"]
8a7757f6 4043 ["Table of Contents" Info-toc
bc224645 4044 :help "Go to table of contents"]
5938202c
JL
4045 ("Index"
4046 ["Lookup a String..." Info-index
d4af987a 4047 :help "Look for a string in the index items"]
5938202c 4048 ["Next Matching Item" Info-index-next :active Info-index-alternatives
ab2f22ad 4049 :help "Look for another occurrence of previous item"]
30760c8b
JL
4050 ["Lookup a string and display index of results..." Info-virtual-index
4051 :help "Look for a string in the index items and display node with results"]
5938202c 4052 ["Lookup a string in all indices..." info-apropos
ab2f22ad 4053 :help "Look for a string in the indices of all manuals"])
126f5d4d
MB
4054 ["Copy Node Name" Info-copy-current-node-name
4055 :help "Copy the name of the current node into the kill ring"]
8a7757f6
JL
4056 ["Clone Info buffer" clone-buffer
4057 :help "Create a twin copy of the current Info buffer."]
ec03f31e 4058 ["Exit" Info-exit :help "Stop reading Info"]))
75a209d4 4059
7210b6f5
DL
4060
4061(defvar info-tool-bar-map
b88e7560
CY
4062 (let ((map (make-sparse-keymap)))
4063 (tool-bar-local-item-from-menu 'Info-history-back "left-arrow" map Info-mode-map
f904c0f9 4064 :rtl "right-arrow"
d2bd5189
JD
4065 :label "Back"
4066 :vert-only t)
b88e7560 4067 (tool-bar-local-item-from-menu 'Info-history-forward "right-arrow" map Info-mode-map
f904c0f9 4068 :rtl "left-arrow"
d2bd5189
JD
4069 :label "Forward"
4070 :vert-only t)
94975270 4071 (define-key-after map [separator-1] menu-bar-separator)
b88e7560
CY
4072 (tool-bar-local-item-from-menu 'Info-prev "prev-node" map Info-mode-map
4073 :rtl "next-node")
4074 (tool-bar-local-item-from-menu 'Info-next "next-node" map Info-mode-map
4075 :rtl "prev-node")
d2bd5189
JD
4076 (tool-bar-local-item-from-menu 'Info-up "up-node" map Info-mode-map
4077 :vert-only t)
94975270 4078 (define-key-after map [separator-2] menu-bar-separator)
900503ae
CY
4079 (tool-bar-local-item-from-menu 'Info-top-node "home" map Info-mode-map
4080 :vert-only t)
b88e7560 4081 (tool-bar-local-item-from-menu 'Info-goto-node "jump-to" map Info-mode-map)
94975270 4082 (define-key-after map [separator-3] menu-bar-separator)
f904c0f9 4083 (tool-bar-local-item-from-menu 'Info-index "index" map Info-mode-map
900503ae
CY
4084 :label "Index")
4085 (tool-bar-local-item-from-menu 'Info-search "search" map Info-mode-map
4086 :vert-only t)
4087 (tool-bar-local-item-from-menu 'Info-exit "exit" map Info-mode-map
4088 :vert-only t)
b88e7560 4089 map))
7210b6f5 4090
75a209d4
RS
4091(defvar Info-menu-last-node nil)
4092;; Last node the menu was created for.
6d2c8e3e 4093;; Value is a list, (FILE-NAME NODE-NAME).
75a209d4
RS
4094
4095(defun Info-menu-update ()
fdf4b680 4096 "Update the Info menu for the current node."
75a209d4 4097 (condition-case nil
1b3b87df 4098 (if (or (not (derived-mode-p 'Info-mode))
6d2c8e3e
RS
4099 (equal (list Info-current-file Info-current-node)
4100 Info-menu-last-node))
75a209d4
RS
4101 ()
4102 ;; Update menu menu.
4103 (let* ((Info-complete-menu-buffer (current-buffer))
4104 (items (nreverse (condition-case nil
e4e8ee63 4105 (Info-complete-menu-item "" nil t)
75a209d4 4106 (error nil))))
399c88ad 4107 entries current
75a209d4
RS
4108 (number 0))
4109 (while (and items (< number 9))
4110 (setq current (car items)
4111 items (cdr items)
4112 number (1+ number))
399c88ad 4113 (setq entries (cons `[,current
75a209d4
RS
4114 (Info-menu ,current)
4115 :keys ,(format "%d" number)]
4116 entries)))
4117 (if items
4118 (setq entries (cons ["Other..." Info-menu t] entries)))
4119 (or entries
5d5845dc 4120 (setq entries (list ["No menu" nil nil] nil :active)))
d4af987a 4121 (easy-menu-change '("Info") "Menu Item" (nreverse entries)))
75a209d4
RS
4122 ;; Update reference menu. Code stolen from `Info-follow-reference'.
4123 (let ((items nil)
399c88ad 4124 str i entries current
1bcedb3b
RS
4125 (number 0)
4126 (case-fold-search t))
75a209d4
RS
4127 (save-excursion
4128 (goto-char (point-min))
8a7757f6 4129 (while (re-search-forward "\\*note[ \n\t]+\\([^:]*\\):" nil t)
c60c12be 4130 (setq str (match-string 1))
75a209d4
RS
4131 (setq i 0)
4132 (while (setq i (string-match "[ \n\t]+" str i))
4133 (setq str (concat (substring str 0 i) " "
4134 (substring str (match-end 0))))
4135 (setq i (1+ i)))
4136 (setq items
4137 (cons str items))))
4138 (while (and items (< number 9))
4139 (setq current (car items)
4140 items (cdr items)
4141 number (1+ number))
399c88ad 4142 (setq entries (cons `[,current
75a209d4
RS
4143 (Info-follow-reference ,current)
4144 t]
4145 entries)))
4146 (if items
4147 (setq entries (cons ["Other..." Info-follow-reference t]
4148 entries)))
4149 (or entries
5d5845dc 4150 (setq entries (list ["No references" nil nil] nil :active)))
75a209d4
RS
4151 (easy-menu-change '("Info") "Reference" (nreverse entries)))
4152 ;; Update last seen node.
6d2c8e3e 4153 (setq Info-menu-last-node (list Info-current-file Info-current-node)))
75a209d4
RS
4154 ;; Try to avoid entering infinite beep mode in case of errors.
4155 (error (ding))))
4156
a384cab3 4157\f
50163b00 4158(defun Info-copy-current-node-name (&optional arg)
185cff95
JL
4159 "Put the name of the current Info node into the kill ring.
4160The name of the Info file is prepended to the node name in parentheses.
50163b00
JL
4161With a zero prefix arg, put the name inside a function call to `info'."
4162 (interactive "P")
126f5d4d 4163 (unless Info-current-node
71873e2b 4164 (user-error "No current Info node"))
bec275ed 4165 (let ((node (if (stringp Info-current-file)
858aab4c
JL
4166 (concat "(" (file-name-sans-extension
4167 (file-name-nondirectory Info-current-file))
4168 ") "
bec275ed 4169 Info-current-node))))
50163b00
JL
4170 (if (zerop (prefix-numeric-value arg))
4171 (setq node (concat "(info \"" node "\")")))
bec275ed
JL
4172 (unless (stringp Info-current-file)
4173 (setq node (format "(Info-find-node '%S '%S)"
4174 Info-current-file Info-current-node)))
50163b00
JL
4175 (kill-new node)
4176 (message "%s" node)))
126f5d4d
MB
4177
4178\f
a384cab3 4179;; Info mode is suitable only for specially formatted data.
68bc119c 4180(put 'Info-mode 'mode-class 'special)
2fa8f8a4 4181(put 'Info-mode 'no-clone-indirect t)
a384cab3 4182
f4f2bca3 4183(defvar tool-bar-map)
e0385bf4 4184(defvar bookmark-make-record-function)
f4f2bca3 4185
72753f87
JL
4186(defvar Info-mode-syntax-table
4187 (let ((st (copy-syntax-table text-mode-syntax-table)))
4188 ;; Use punctuation syntax for apostrophe because of
4189 ;; extensive use of quotes like `this' in Info manuals.
4190 (modify-syntax-entry ?' "." st)
4191 st)
4192 "Syntax table used in `Info-mode'.")
4193
80123c9e
LH
4194;; Autoload cookie needed by desktop.el
4195;;;###autoload
528b9ea9 4196(define-derived-mode Info-mode nil "Info"
fdf4b680 4197 "Info mode provides commands for browsing through the Info documentation tree.
a384cab3
JB
4198Documentation in Info is divided into \"nodes\", each of which discusses
4199one topic and contains references to other nodes which discuss related
4200topics. Info has commands to follow the references and show you other nodes.
4201
fdf4b680 4202\\<Info-mode-map>\
a384cab3 4203\\[Info-help] Invoke the Info tutorial.
6b136ab9 4204\\[Info-exit] Quit Info: reselect previously selected buffer.
a384cab3
JB
4205
4206Selecting other nodes:
21d5959f
RS
4207\\[Info-mouse-follow-nearest-node]
4208 Follow a node reference you click on.
4209 This works with menu items, cross references, and
4210 the \"next\", \"previous\" and \"up\", depending on where you click.
6b136ab9 4211\\[Info-follow-nearest-node] Follow a node reference near point, like \\[Info-mouse-follow-nearest-node].
a384cab3 4212\\[Info-next] Move to the \"next\" node of this node.
bc2ada62 4213\\[Info-prev] Move to the \"previous\" node of this node.
a384cab3
JB
4214\\[Info-up] Move \"up\" from this node.
4215\\[Info-menu] Pick menu item specified by name (or abbreviation).
e8042313 4216 Picking a menu item causes another node to be selected.
aea2a8da 4217\\[Info-directory] Go to the Info directory node.
8300a5b5
JL
4218\\[Info-top-node] Go to the Top node of this file.
4219\\[Info-final-node] Go to the final node in this file.
4220\\[Info-backward-node] Go backward one node, considering all nodes as forming one sequence.
4221\\[Info-forward-node] Go forward one node, considering all nodes as forming one sequence.
4222\\[Info-next-reference] Move cursor to next cross-reference or menu item.
4223\\[Info-prev-reference] Move cursor to previous cross-reference or menu item.
a384cab3 4224\\[Info-follow-reference] Follow a cross reference. Reads name of reference.
424b9d3e
JL
4225\\[Info-history-back] Move back in history to the last node you were at.
4226\\[Info-history-forward] Move forward in history to the node you returned from after using \\[Info-history-back].
bc224645
JL
4227\\[Info-history] Go to menu of visited nodes.
4228\\[Info-toc] Go to table of contents of the current Info file.
a384cab3
JB
4229
4230Moving within a node:
177c3549 4231\\[Info-scroll-up] Normally, scroll forward a full screen.
e8042313
PJ
4232 Once you scroll far enough in a node that its menu appears on the
4233 screen but after point, the next scroll moves into its first
4234 subnode. When after all menu items (or if there is no menu),
4235 move up to the parent node.
177c3549 4236\\[Info-scroll-down] Normally, scroll backward. If the beginning of the buffer is
e8042313
PJ
4237 already visible, try to go to the previous menu entry, or up
4238 if there is none.
b96dec83 4239\\[beginning-of-buffer] Go to beginning of node.
a384cab3 4240
a384cab3 4241Advanced commands:
a384cab3 4242\\[Info-search] Search through this Info file for specified regexp,
e8042313 4243 and select the node in which the next occurrence is found.
bc224645 4244\\[Info-search-case-sensitively] Search through this Info file for specified regexp case-sensitively.
88e1d519 4245\\[isearch-forward], \\[isearch-forward-regexp] Use Isearch to search through multiple Info nodes.
9012c084 4246\\[Info-index] Search for a topic in this manual's Index and go to index entry.
8300a5b5 4247\\[Info-index-next] (comma) Move to the next match from a previous \\<Info-mode-map>\\[Info-index] command.
30760c8b 4248\\[Info-virtual-index] Look for a string and display the index node with results.
8300a5b5
JL
4249\\[info-apropos] Look for a string in the indices of all manuals.
4250\\[Info-goto-node] Move to node specified by name.
4251 You may include a filename as well, as (FILENAME)NODENAME.
42521 .. 9 Pick first ... ninth item in node's menu.
4253 Every third `*' is highlighted to help pick the right number.
4254\\[Info-copy-current-node-name] Put name of current Info node in the kill ring.
4255\\[clone-buffer] Select a new cloned Info buffer in another window.
4256\\[universal-argument] \\[info] Move to new Info file with completion.
4257\\[universal-argument] N \\[info] Select Info buffer with prefix number in the name *info*<N>."
72753f87 4258 :syntax-table Info-mode-syntax-table
528b9ea9 4259 :abbrev-table text-mode-abbrev-table
f73299f3 4260 (setq tab-width 8)
75a209d4 4261 (add-hook 'activate-menubar-hook 'Info-menu-update nil t)
a384cab3
JB
4262 (setq case-fold-search t)
4263 (setq buffer-read-only t)
a384cab3
JB
4264 (make-local-variable 'Info-current-file)
4265 (make-local-variable 'Info-current-subfile)
4266 (make-local-variable 'Info-current-node)
528b9ea9
JB
4267 (set (make-local-variable 'Info-tag-table-marker) (make-marker))
4268 (set (make-local-variable 'Info-tag-table-buffer) nil)
a384cab3 4269 (make-local-variable 'Info-history)
424b9d3e 4270 (make-local-variable 'Info-history-forward)
1143a6b0 4271 (make-local-variable 'Info-index-alternatives)
eb033d40
DR
4272 (if Info-use-header-line ; do not override global header lines
4273 (setq header-line-format
4274 '(:eval (get-text-property (point-min) 'header-line))))
7210b6f5 4275 (set (make-local-variable 'tool-bar-map) info-tool-bar-map)
93480d70 4276 ;; This is for the sake of the invisible text we use handling titles.
528b9ea9
JB
4277 (set (make-local-variable 'line-move-ignore-invisible) t)
4278 (set (make-local-variable 'desktop-save-buffer)
4279 'Info-desktop-buffer-misc-data)
4280 (set (make-local-variable 'widen-automatically) nil)
34d86208 4281 (add-hook 'kill-buffer-hook 'Info-kill-buffer nil t)
274bcfe0 4282 (add-hook 'clone-buffer-hook 'Info-clone-buffer nil t)
3d12b331 4283 (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
d457219d 4284 (add-hook 'isearch-mode-hook 'Info-isearch-start nil t)
0b02cda9
JL
4285 (set (make-local-variable 'isearch-search-fun-function)
4286 'Info-isearch-search)
4287 (set (make-local-variable 'isearch-wrap-function)
4288 'Info-isearch-wrap)
4289 (set (make-local-variable 'isearch-push-state-function)
4290 'Info-isearch-push-state)
dc6c0eda 4291 (set (make-local-variable 'isearch-filter-predicate) #'Info-isearch-filter)
e56f84d7
TTN
4292 (set (make-local-variable 'revert-buffer-function)
4293 'Info-revert-buffer-function)
a384cab3 4294 (Info-set-mode-line)
e0385bf4 4295 (set (make-local-variable 'bookmark-make-record-function)
528b9ea9 4296 'Info-bookmark-make-record))
a384cab3 4297
34d86208
JL
4298;; When an Info buffer is killed, make sure the associated tags buffer
4299;; is killed too.
4300(defun Info-kill-buffer ()
1b3b87df 4301 (and (derived-mode-p 'Info-mode)
34d86208
JL
4302 Info-tag-table-buffer
4303 (kill-buffer Info-tag-table-buffer)))
4304
274bcfe0
RS
4305;; Placed on `clone-buffer-hook'.
4306(defun Info-clone-buffer ()
4fceda3c
SM
4307 (when (bufferp Info-tag-table-buffer)
4308 (setq Info-tag-table-buffer
4ce5c223
SM
4309 (with-current-buffer Info-tag-table-buffer (clone-buffer))))
4310 (let ((m Info-tag-table-marker))
4311 (when (markerp m)
15533ae2 4312 (setq Info-tag-table-marker
4ce5c223 4313 (if (and (marker-position m) (bufferp Info-tag-table-buffer))
15533ae2
SM
4314 (with-current-buffer Info-tag-table-buffer
4315 (copy-marker (marker-position m)))
4316 (make-marker))))))
4fceda3c 4317
1b3b87df
SM
4318(define-obsolete-variable-alias 'Info-edit-map 'Info-edit-mode-map "24.1")
4319(defvar Info-edit-mode-map (let ((map (make-sparse-keymap)))
4320 (set-keymap-parent map text-mode-map)
4321 (define-key map "\C-c\C-c" 'Info-cease-edit)
4322 map)
a384cab3 4323 "Local keymap used within `e' command of Info.")
a384cab3 4324
5313bbc7
GM
4325(make-obsolete-variable 'Info-edit-map
4326 "editing Info nodes by hand is not recommended."
4327 "24.4")
4328
a384cab3 4329;; Info-edit mode is suitable only for specially formatted data.
68bc119c 4330(put 'Info-edit-mode 'mode-class 'special)
a384cab3 4331
1b3b87df 4332(define-derived-mode Info-edit-mode text-mode "Info Edit"
a384cab3 4333 "Major mode for editing the contents of an Info node.
a426b157 4334Like text mode with the addition of `Info-cease-edit'
a384cab3
JB
4335which returns to Info mode for browsing.
4336\\{Info-edit-map}"
a384cab3 4337 (setq buffer-read-only nil)
2c609f53 4338 (force-mode-line-update)
1b3b87df 4339 (buffer-enable-undo (current-buffer)))
e82c28f9 4340
5313bbc7
GM
4341(make-obsolete 'Info-edit-mode
4342 "editing Info nodes by hand is not recommended." "24.4")
4343
e82c28f9 4344(defun Info-edit ()
5313bbc7 4345 "Edit the contents of this Info node."
e82c28f9 4346 (interactive)
e82c28f9 4347 (Info-edit-mode)
8ab3e50b 4348 (message "%s" (substitute-command-keys
760d5cb3 4349 "Editing: Type \\<Info-edit-map>\\[Info-cease-edit] to return to info")))
a384cab3 4350
5313bbc7
GM
4351(put 'Info-edit 'disabled "Editing Info nodes by hand is not recommended.
4352This feature will be removed in future.")
4353
4354(make-obsolete 'Info-edit
4355 "editing Info nodes by hand is not recommended." "24.4")
4356
a384cab3
JB
4357(defun Info-cease-edit ()
4358 "Finish editing Info node; switch back to Info proper."
4359 (interactive)
4360 ;; Do this first, so nothing has changed if user C-g's at query.
4361 (and (buffer-modified-p)
4362 (y-or-n-p "Save the file? ")
4363 (save-buffer))
1b3b87df 4364 (Info-mode)
2c609f53 4365 (force-mode-line-update)
a384cab3
JB
4366 (and (marker-position Info-tag-table-marker)
4367 (buffer-modified-p)
4368 (message "Tags may have changed. Use Info-tagify if necessary")))
5313bbc7
GM
4369
4370(make-obsolete 'Info-cease-edit
4371 "editing Info nodes by hand is not recommended." "24.4")
f0a8a3f1 4372\f
f88ab1c9 4373(defvar Info-file-list-for-emacs
02c9f5cd 4374 '("ediff" "eudc" "forms" "gnus" "info" ("Info" . "info") ("mh" . "mh-e")
906b3163
EZ
4375 "sc" "message" ("dired" . "dired-x") "viper" "vip" "idlwave"
4376 ("c" . "ccmode") ("c++" . "ccmode") ("objc" . "ccmode")
4377 ("java" . "ccmode") ("idl" . "ccmode") ("pike" . "ccmode")
af718538
EZ
4378 ("skeleton" . "autotype") ("auto-insert" . "autotype")
4379 ("copyright" . "autotype") ("executable" . "autotype")
4380 ("time-stamp" . "autotype") ("quickurl" . "autotype")
4381 ("tempo" . "autotype") ("hippie-expand" . "autotype")
807378ad
EZ
4382 ("cvs" . "pcl-cvs") ("ada" . "ada-mode") "calc"
4383 ("calcAlg" . "calc") ("calcDigit" . "calc") ("calcVar" . "calc")
906b3163
EZ
4384 "ebrowse" "eshell" "cl" "reftex" "speedbar" "widget" "woman"
4385 ("mail-header" . "emacs-mime") ("mail-content" . "emacs-mime")
4386 ("mail-encode" . "emacs-mime") ("mail-decode" . "emacs-mime")
4387 ("rfc2045" . "emacs-mime")
4388 ("rfc2231" . "emacs-mime") ("rfc2047" . "emacs-mime")
4389 ("rfc2045" . "emacs-mime") ("rfc1843" . "emacs-mime")
4390 ("ietf-drums" . "emacs-mime") ("quoted-printable" . "emacs-mime")
4391 ("binhex" . "emacs-mime") ("uudecode" . "emacs-mime")
4392 ("mailcap" . "emacs-mime") ("mm" . "emacs-mime")
f24e0036
MA
4393 ("mml" . "emacs-mime")
4394 "tramp" "dbus")
f88ab1c9
RS
4395 "List of Info files that describe Emacs commands.
4396An element can be a file name, or a list of the form (PREFIX . FILE)
4397where PREFIX is a name prefix and FILE is the file to look in.
4398If the element is just a file name, the file name also serves as the prefix.")
4399
f0a8a3f1 4400(defun Info-find-emacs-command-nodes (command)
f88ab1c9 4401 "Return a list of locations documenting COMMAND.
f57b2cd8
RS
4402The `info-file' property of COMMAND says which Info manual to search.
4403If COMMAND has no property, the variable `Info-file-list-for-emacs'
4404defines heuristics for which Info manual to try.
9fc9a531 4405The locations are of the format used in the variable `Info-history', i.e.
6194c800 4406\(FILENAME NODENAME BUFFERPOS), where BUFFERPOS is the line number
02c9f5cd
JL
4407in the first element of the returned list (which is treated specially in
4408`Info-goto-emacs-command-node'), and 0 for the rest elements of a list."
4409 (let ((where '()) line-number
b37daea4 4410 (cmd-desc (concat "^\\* +" (regexp-quote (symbol-name command))
f254e21f 4411 "\\( <[0-9]+>\\)?:\\s *\\(.*\\)\\."
02c9f5cd 4412 "\\(?:[ \t\n]+(line +\\([0-9]+\\))\\)?"))
f88ab1c9 4413 (info-file "emacs")) ;default
185cff95 4414 ;; Determine which Info file this command is documented in.
f88ab1c9
RS
4415 (if (get command 'info-file)
4416 (setq info-file (get command 'info-file))
4417 ;; If it doesn't say explicitly, test its name against
4418 ;; various prefixes that we know.
4419 (let ((file-list Info-file-list-for-emacs))
4420 (while file-list
4421 (let* ((elt (car file-list))
4422 (name (if (consp elt)
4423 (car elt)
4424 elt))
4425 (file (if (consp elt) (cdr elt) elt))
cc3f6c32 4426 (case-fold-search nil)
f57b2cd8 4427 (regexp (concat "\\`" (regexp-quote name)
f88ab1c9
RS
4428 "\\(\\'\\|-\\)")))
4429 (if (string-match regexp (symbol-name command))
4430 (setq info-file file file-list nil))
4431 (setq file-list (cdr file-list))))))
218c2cc7 4432 (Info-find-node info-file "Top")
218c2cc7
EZ
4433 ;; Bind Info-history to nil, to prevent the index nodes from
4434 ;; getting into the node history.
4435 (let ((Info-history nil)
141b49f5
JL
4436 (Info-history-list nil)
4437 node (nodes (Info-index-nodes)))
4438 (Info-goto-node (car nodes))
218c2cc7
EZ
4439 (while
4440 (progn
4441 (goto-char (point-min))
4442 (while (re-search-forward cmd-desc nil t)
4443 (setq where
4444 (cons (list Info-current-file
4445 (match-string-no-properties 2)
760d5cb3 4446 0)
02c9f5cd
JL
4447 where))
4448 (setq line-number (and (match-beginning 3)
4449 (string-to-number (match-string 3)))))
141b49f5 4450 (and (setq nodes (cdr nodes) node (car nodes))))
218c2cc7 4451 (Info-goto-node node)))
02c9f5cd
JL
4452 (if (and line-number where)
4453 (cons (list (nth 0 (car where)) (nth 1 (car where)) line-number)
4454 (cdr where))
4455 where)))
f0a8a3f1 4456
6bdad9ae 4457;;;###autoload (put 'Info-goto-emacs-command-node 'info-file (purecopy "emacs"))
f0a8a3f1
RM
4458;;;###autoload
4459(defun Info-goto-emacs-command-node (command)
e0568e86 4460 "Go to the Info node in the Emacs manual for command COMMAND.
30db89f9 4461The command is found by looking up in Emacs manual's indices
f57b2cd8 4462or in another manual found via COMMAND's `info-file' property or
1ed6e0c3
JPW
4463the variable `Info-file-list-for-emacs'.
4464COMMAND must be a symbol or string."
f0a8a3f1 4465 (interactive "CFind documentation for command: ")
fafb00dc
MY
4466 ;; If command is given as a string, convert it to a symbol.
4467 (if (stringp command)
1ed6e0c3 4468 (setq command (intern command)))
f0a8a3f1
RM
4469 (or (commandp command)
4470 (signal 'wrong-type-argument (list 'commandp command)))
4471 (let ((where (Info-find-emacs-command-nodes command)))
4472 (if where
4473 (let ((num-matches (length where)))
4474 ;; Get Info running, and pop to it in another window.
4475 (save-window-excursion
4476 (info))
1b3b87df 4477 (or (derived-mode-p 'Info-mode) (pop-to-buffer "*info*"))
218c2cc7
EZ
4478 ;; Bind Info-history to nil, to prevent the last Index node
4479 ;; visited by Info-find-emacs-command-nodes from being
4480 ;; pushed onto the history.
02c9f5cd
JL
4481 (let ((Info-history nil) (Info-history-list nil)
4482 (line-number (nth 2 (car where))))
4483 (Info-find-node (nth 0 (car where)) (nth 1 (car where)))
4484 (if (and (integerp line-number) (> line-number 0))
4485 (forward-line (1- line-number))))
f0a8a3f1
RM
4486 (if (> num-matches 1)
4487 (progn
218c2cc7
EZ
4488 ;; (car where) will be pushed onto Info-history
4489 ;; when/if they go to another node. Put the other
4490 ;; nodes that were found on the history.
f0a8a3f1 4491 (setq Info-history (nconc (cdr where) Info-history))
8ab3e50b 4492 (message "Found %d other entr%s. Use %s to see %s."
cedb118c
RS
4493 (1- num-matches)
4494 (if (> num-matches 2) "ies" "y")
424b9d3e 4495 (substitute-command-keys "\\[Info-history-back]")
cedb118c 4496 (if (> num-matches 2) "them" "it")))))
e9b81433 4497 (error "Couldn't find documentation for %s" command))))
f0a8a3f1 4498
6bdad9ae 4499;;;###autoload (put 'Info-goto-emacs-key-command-node 'info-file (purecopy "emacs"))
f0a8a3f1
RM
4500;;;###autoload
4501(defun Info-goto-emacs-key-command-node (key)
30db89f9
EZ
4502 "Go to the node in the Emacs manual which describes the command bound to KEY.
4503KEY is a string.
fdf4b680 4504Interactively, if the binding is `execute-extended-command', a command is read.
30db89f9 4505The command is found by looking up in Emacs manual's indices
f57b2cd8
RS
4506or in another manual found via COMMAND's `info-file' property or
4507the variable `Info-file-list-for-emacs'."
ea33749b 4508 (interactive "kFind documentation for key: ")
f0a8a3f1
RM
4509 (let ((command (key-binding key)))
4510 (cond ((null command)
9e5c2f50 4511 (message "%s is undefined" (key-description key)))
32226619 4512 ((and (called-interactively-p 'interactive)
f0a8a3f1
RM
4513 (eq command 'execute-extended-command))
4514 (Info-goto-emacs-command-node
4515 (read-command "Find documentation for command: ")))
4516 (t
4517 (Info-goto-emacs-command-node command)))))
552775bd 4518\f
3c5d6dfb
JL
4519(defvar Info-link-keymap
4520 (let ((keymap (make-sparse-keymap)))
01ac65bd
CY
4521 (define-key keymap [header-line down-mouse-1] 'mouse-drag-header-line)
4522 (define-key keymap [header-line mouse-1] 'mouse-select-window)
3c5d6dfb 4523 (define-key keymap [header-line mouse-2] 'Info-mouse-follow-link)
3c5d6dfb
JL
4524 (define-key keymap [mouse-2] 'Info-mouse-follow-link)
4525 (define-key keymap [follow-link] 'mouse-face)
4526 keymap)
136e1c1d
CY
4527 "Keymap to put on Info links.
4528This is used for the \"Next\", \"Prev\", and \"Up\" links in the
4529first line or header line, and for breadcrumb links.")
3c5d6dfb
JL
4530
4531(defun Info-breadcrumbs ()
586f9284
JL
4532 (let ((nodes (Info-toc-nodes Info-current-file))
4533 (node Info-current-node)
fdeb777a 4534 (crumbs ())
3c5d6dfb
JL
4535 (depth Info-breadcrumbs-depth)
4536 line)
586f9284
JL
4537
4538 ;; Get ancestors from the cached parent-children node info
4539 (while (and (not (equal "Top" node)) (> depth 0))
4540 (setq node (nth 1 (assoc node nodes)))
4541 (if node (push node crumbs))
4542 (setq depth (1- depth)))
4543
4544 ;; Add bottom node.
4545 (when Info-use-header-line
4546 ;; Let it disappear if crumbs is nil.
4547 (nconc crumbs (list Info-current-node)))
4548 (when (or Info-use-header-line crumbs)
4549 ;; Add top node (and continuation if needed).
4550 (setq crumbs
4551 (cons "Top" (if (member (pop crumbs) '(nil "Top"))
4552 crumbs (cons nil crumbs))))
4553 ;; Eliminate duplicate.
4554 (forward-line 1)
4555 (dolist (node crumbs)
4556 (let ((text
4557 (if (not (equal node "Top")) node
4558 (format "(%s)Top"
4559 (if (stringp Info-current-file)
858aab4c
JL
4560 (file-name-sans-extension
4561 (file-name-nondirectory Info-current-file))
6a013a49 4562 ;; Some legacy code can still use a symbol.
586f9284 4563 Info-current-file)))))
3c5d6dfb
JL
4564 (setq line (concat
4565 line
4566 (if (null line) "" " > ")
4567 (cond
4568 ((null node) "...")
4569 ((equal node Info-current-node)
4570 ;; No point linking to ourselves.
4571 (propertize text 'font-lock-face 'info-header-node))
4572 (t
4573 (propertize text
4574 'mouse-face 'highlight
4575 'font-lock-face 'info-header-xref
4576 'help-echo "mouse-2: Go to node"
4577 'keymap Info-link-keymap
4578 'link-args text)))))))
4579 (setq line (concat line "\n")))
4580 ;; (font-lock-append-text-property 0 (length line)
4581 ;; 'font-lock-face 'header-line line)
4582 line))
fdeb777a 4583
552775bd 4584(defun Info-fontify-node ()
8a7757f6
JL
4585 "Fontify the node."
4586 (save-excursion
4587 (let* ((inhibit-read-only t)
4588 (case-fold-search t)
4589 paragraph-markers
4590 (not-fontified-p ; the node hasn't already been fontified
f9b27c85 4591 (not (let ((where (next-single-property-change (point-min)
499878f8 4592 'font-lock-face)))
8a7757f6
JL
4593 (and where (not (= where (point-max)))))))
4594 (fontify-visited-p ; visited nodes need to be re-fontified
4595 (and Info-fontify-visited-nodes
4596 ;; Don't take time to refontify visited nodes in huge nodes
3d0fc0b7 4597 Info-fontify-maximum-menu-size
e14105f6
TTN
4598 (< (- (point-max) (point-min)) Info-fontify-maximum-menu-size)))
4599 rbeg rend)
8a7757f6
JL
4600
4601 ;; Fontify header line
4602 (goto-char (point-min))
4603 (when (and not-fontified-p (looking-at "^\\(File: [^,: \t]+,?[ \t]+\\)?"))
4604 (goto-char (match-end 0))
4605 (while (looking-at "[ \t]*\\([^:, \t\n]+\\):[ \t]+\\([^:,\t\n]+\\),?")
4606 (goto-char (match-end 0))
4607 (let* ((nbeg (match-beginning 2))
4608 (nend (match-end 2))
4609 (tbeg (match-beginning 1))
4610 (tag (match-string 1)))
99315976 4611 (if (string-equal (downcase tag) "node")
8a7757f6
JL
4612 (put-text-property nbeg nend 'font-lock-face 'info-header-node)
4613 (put-text-property nbeg nend 'font-lock-face 'info-header-xref)
4614 (put-text-property tbeg nend 'mouse-face 'highlight)
4615 (put-text-property tbeg nend
4616 'help-echo
3c1498ac 4617 (concat "mouse-2: Go to node "
8a7757f6 4618 (buffer-substring nbeg nend)))
136e1c1d
CY
4619 ;; Set up the text property keymap. Depending on
4620 ;; `Info-use-header-line', it is either used in the
4621 ;; buffer, or copied to the header line. A symbol value
4622 ;; of the `link-args' property is handled specially by
4623 ;; `Info-mouse-follow-link'.
4624 (put-text-property tbeg nend 'keymap Info-link-keymap)
4625 (put-text-property tbeg nend 'link-args
4626 (intern (downcase tag))))))
3bfd723a 4627
3c5d6dfb
JL
4628 ;; (when (> Info-breadcrumbs-depth 0)
4629 ;; (insert (Info-breadcrumbs)))
3bfd723a 4630
fdeb777a 4631 ;; Treat header line.
8a7757f6
JL
4632 (when Info-use-header-line
4633 (goto-char (point-min))
de22f49c
SM
4634 (let* ((header-end (line-end-position))
4635 (header
4636 ;; If we find neither Next: nor Prev: link, show the entire
4637 ;; node header. Otherwise, don't show the File: and Node:
4638 ;; parts, to avoid wasting precious space on information that
4639 ;; is available in the mode line.
4640 (if (re-search-forward
4641 "\\(next\\|up\\|prev[ious]*\\): "
4642 header-end t)
4643 (progn
4644 (goto-char (match-beginning 1))
4645 (buffer-substring (point) header-end))
4646 (if (re-search-forward "node:[ \t]*[^ \t]+[ \t]*"
4647 header-end t)
8a7757f6 4648 (concat "No next, prev or up links -- "
de22f49c
SM
4649 (buffer-substring (point) header-end))
4650 (buffer-substring (point) header-end)))))
8a7757f6 4651 (put-text-property (point-min) (1+ (point-min))
69672704
JL
4652 'header-line
4653 (replace-regexp-in-string
4654 "%"
4655 ;; Preserve text properties on duplicated `%'.
4656 (lambda (s) (concat s s)) header))
8a7757f6
JL
4657 ;; Hide the part of the first line
4658 ;; that is in the header, if it is just part.
fdeb777a
SM
4659 (cond
4660 ((> Info-breadcrumbs-depth 0)
3c5d6dfb 4661 (let ((ov (make-overlay (point-min) (1+ header-end))))
e89dee79 4662 (overlay-put ov 'display (Info-breadcrumbs))
3c5d6dfb 4663 (overlay-put ov 'evaporate t)))
fdeb777a 4664 ((not (bobp))
8a7757f6
JL
4665 ;; Hide the punctuation at the end, too.
4666 (skip-chars-backward " \t,")
d1c0d176
JL
4667 (put-text-property (point) header-end 'invisible t)
4668 ;; Hide the suffix of the Info file name.
4669 (beginning-of-line)
4670 (if (re-search-forward
4671 (format "File: %s\\([^,\n\t]+\\),"
4672 (if (stringp Info-current-file)
858aab4c
JL
4673 (file-name-sans-extension
4674 (file-name-nondirectory Info-current-file))
d1c0d176
JL
4675 Info-current-file))
4676 header-end t)
4677 (put-text-property (match-beginning 1) (match-end 1)
4678 'invisible t)))))))
8a7757f6
JL
4679
4680 ;; Fontify titles
4681 (goto-char (point-min))
de22f49c
SM
4682 (when (and font-lock-mode not-fontified-p)
4683 (while (and (re-search-forward "\n\\([^ \t\n].+\\)\n\\(\\*\\*+\\|==+\\|--+\\|\\.\\.+\\)$"
4684 nil t)
4685 ;; Only consider it as an underlined title if the ASCII
4686 ;; underline has the same size as the text. A typical
4687 ;; counter example is when a continuation "..." is alone
4688 ;; on a line.
4dacf0ff
JL
4689 (= (string-width (match-string 1))
4690 (string-width (match-string 2))))
8a7757f6
JL
4691 (let* ((c (preceding-char))
4692 (face
a335c06e
MB
4693 (cond ((= c ?*) 'info-title-1)
4694 ((= c ?=) 'info-title-2)
4695 ((= c ?-) 'info-title-3)
4696 (t 'info-title-4))))
8a7757f6
JL
4697 (put-text-property (match-beginning 1) (match-end 1)
4698 'font-lock-face face))
4699 ;; This is a serious problem for trying to handle multiple
4700 ;; frame types at once. We want this text to be invisible
4701 ;; on frames that can display the font above.
9e2a2647 4702 (when (memq (framep (selected-frame)) '(x pc w32 ns))
8a7757f6
JL
4703 (add-text-properties (1- (match-beginning 2)) (match-end 2)
4704 '(invisible t front-sticky nil rear-nonsticky t)))))
4705
4706 ;; Fontify cross references
4707 (goto-char (point-min))
4708 (when (or not-fontified-p fontify-visited-p)
4709 (while (re-search-forward "\\(\\*Note[ \n\t]+\\)\\([^:]*\\)\\(:[ \t]*\\([^.,:(]*\\)\\(\\(([^)]*)\\)[^.,:]*\\)?[,:]?\n?\\)" nil t)
4710 (let ((start (match-beginning 0))
4711 (next (point))
4712 other-tag)
4713 (when not-fontified-p
4714 (when Info-hide-note-references
fdeb777a
SM
4715 (when (and (not (eq Info-hide-note-references 'hide))
4716 (> (line-number-at-pos) 4)) ; Skip breadcrumbs
fc11ddc8
JL
4717 ;; *Note is often used where *note should have been
4718 (goto-char start)
4719 (skip-syntax-backward " ")
d75baf12
RS
4720 (when (memq (char-before) '(?\( ?\[ ?\{))
4721 ;; Check whether the paren is preceded by
4722 ;; an end of sentence
4723 (skip-syntax-backward " ("))
fc11ddc8 4724 (setq other-tag
e8e6694b
RS
4725 (cond ((save-match-data (looking-back "\\<see"))
4726 "")
dc7ef9f0
CY
4727 ((save-match-data (looking-back "\\<in"))
4728 "")
e8e6694b 4729 ((memq (char-before) '(nil ?\. ?! ??))
fc11ddc8 4730 "See ")
d75baf12
RS
4731 ((save-match-data
4732 (save-excursion
4733 (search-forward "\n\n" start t)))
4734 "See ")
4735 (t "see "))))
8a7757f6
JL
4736 (goto-char next)
4737 (add-text-properties
4738 (match-beginning 1)
4739 (or (save-match-data
4740 ;; Don't hide \n after *Note
4741 (let ((start1 (match-beginning 1)))
4742 (if (string-match "\n" (match-string 1))
4743 (+ start1 (match-beginning 0)))))
4744 (match-end 1))
fc11ddc8 4745 (if other-tag
8a7757f6
JL
4746 `(display ,other-tag front-sticky nil rear-nonsticky t)
4747 '(invisible t front-sticky nil rear-nonsticky t))))
4748 (add-text-properties
4749 (match-beginning 2) (match-end 2)
4750 (list
4751 'help-echo (if (or (match-end 5)
4752 (not (equal (match-string 4) "")))
4753 (concat "mouse-2: go to " (or (match-string 5)
4754 (match-string 4)))
4755 "mouse-2: go to this node")
4756 'mouse-face 'highlight)))
4757 (when (or not-fontified-p fontify-visited-p)
e14105f6
TTN
4758 (setq rbeg (match-beginning 2)
4759 rend (match-end 2))
4760 (put-text-property
4761 rbeg rend
4762 'font-lock-face
4763 ;; Display visited nodes in a different face
4764 (if (and Info-fontify-visited-nodes
4765 (save-match-data
4766 (let* ((node (replace-regexp-in-string
4767 "^[ \t]+" ""
4768 (replace-regexp-in-string
4769 "[ \t\n]+" " "
bec275ed 4770 (or (match-string-no-properties 5)
e14105f6 4771 (and (not (equal (match-string 4) ""))
bec275ed
JL
4772 (match-string-no-properties 4))
4773 (match-string-no-properties 2)))))
d8fbba22
CY
4774 (external-link-p
4775 (string-match "(\\([^)]+\\))\\([^)]*\\)" node))
4776 (file (if external-link-p
4777 (file-name-nondirectory
bec275ed 4778 (match-string-no-properties 1 node))
d8fbba22 4779 Info-current-file))
e14105f6
TTN
4780 (hl Info-history-list)
4781 res)
d8fbba22
CY
4782 (if external-link-p
4783 (setq node (if (equal (match-string 2 node) "")
e14105f6 4784 "Top"
bec275ed 4785 (match-string-no-properties 2 node))))
d590dbd2
CY
4786 (while hl
4787 (if (and (string-equal node (nth 1 (car hl)))
bec275ed
JL
4788 (equal file
4789 (if (and external-link-p
4790 (stringp (caar hl)))
4791 (file-name-nondirectory
4792 (caar hl))
4793 (caar hl))))
d590dbd2
CY
4794 (setq res (car hl) hl nil)
4795 (setq hl (cdr hl))))
e14105f6
TTN
4796 res))) 'info-xref-visited 'info-xref))
4797 ;; For multiline ref, unfontify newline and surrounding whitespace
4798 (save-excursion
4799 (goto-char rbeg)
4800 (save-match-data
4801 (while (re-search-forward "\\s-*\n\\s-*" rend t nil)
4802 (remove-text-properties (match-beginning 0)
4803 (match-end 0)
4804 '(font-lock-face t))))))
8a7757f6
JL
4805 (when not-fontified-p
4806 (when (memq Info-hide-note-references '(t hide))
4807 (add-text-properties (match-beginning 3) (match-end 3)
4808 '(invisible t front-sticky nil rear-nonsticky t))
4809 ;; Unhide the file name of the external reference in parens
89b064a9 4810 (if (and (match-string 6) (not (eq Info-hide-note-references 'hide)))
8a7757f6
JL
4811 (remove-text-properties (match-beginning 6) (match-end 6)
4812 '(invisible t front-sticky nil rear-nonsticky t)))
4813 ;; Unhide newline because hidden newlines cause too long lines
4814 (save-match-data
89b064a9
JL
4815 (let ((beg3 (match-beginning 3))
4816 (end3 (match-end 3)))
4817 (if (and (string-match "\n[ \t]*" (match-string 3))
4818 (not (save-match-data
4819 (save-excursion
4820 (goto-char (1+ end3))
4821 (looking-at "[.)]*$")))))
4822 (remove-text-properties (+ beg3 (match-beginning 0))
4823 (+ beg3 (match-end 0))
8a7757f6
JL
4824 '(invisible t front-sticky nil rear-nonsticky t))))))
4825 (when (and Info-refill-paragraphs Info-hide-note-references)
4826 (push (set-marker (make-marker) start)
4827 paragraph-markers))))))
4828
4829 ;; Refill paragraphs (experimental feature)
4830 (when (and not-fontified-p
4831 Info-refill-paragraphs
4832 paragraph-markers)
4833 (let ((fill-nobreak-invisible t)
4834 (fill-individual-varying-indent nil)
4835 (paragraph-start "\f\\|[ \t]*[-*]\\|[ \t]*$")
4836 (paragraph-separate ".*\\.[ \t]*\n[ \t]\\|[ \t]*[-*]\\|[ \t\f]*$")
4837 (adaptive-fill-mode nil))
4838 (goto-char (point-max))
a73db543
SM
4839 (dolist (m paragraph-markers)
4840 (when (< m (point))
4841 (goto-char m)
4842 (beginning-of-line)
4843 (let ((beg (point)))
4844 (when (zerop (forward-paragraph))
4845 (fill-individual-paragraphs beg (point) nil nil)
4846 (goto-char beg))))
4847 (set-marker m nil))))
8a7757f6
JL
4848
4849 ;; Fontify menu items
4850 (goto-char (point-min))
4851 (when (and (or not-fontified-p fontify-visited-p)
4852 (search-forward "\n* Menu:" nil t)
8a7757f6 4853 ;; Don't take time to annotate huge menus
3d0fc0b7 4854 Info-fontify-maximum-menu-size
8a7757f6
JL
4855 (< (- (point-max) (point)) Info-fontify-maximum-menu-size))
4856 (let ((n 0)
4857 cont)
4858 (while (re-search-forward
1ecc5922
RS
4859 (concat "^\\* Menu:\\|\\(?:^\\* +\\(" Info-menu-entry-name-re "\\)\\(:"
4860 Info-node-spec-re "\\([ \t]*\\)\\)\\)")
8a7757f6 4861 nil t)
1ecc5922
RS
4862 (when (match-beginning 1)
4863 (when not-fontified-p
4864 (setq n (1+ n))
4865 (if (and (<= n 9) (zerop (% n 3))) ; visual aids to help with 1-9 keys
4866 (put-text-property (match-beginning 0)
4867 (1+ (match-beginning 0))
185cff95 4868 'font-lock-face 'info-menu-star)))
1ecc5922
RS
4869 (when not-fontified-p
4870 (add-text-properties
4871 (match-beginning 1) (match-end 1)
4872 (list
4873 'help-echo (if (and (match-end 3)
4874 (not (equal (match-string 3) "")))
4875 (concat "mouse-2: go to " (match-string 3))
4876 "mouse-2: go to this node")
4877 'mouse-face 'highlight)))
4878 (when (or not-fontified-p fontify-visited-p)
a73db543 4879 (put-text-property
1ecc5922 4880 (match-beginning 1) (match-end 1)
a73db543
SM
4881 'font-lock-face
4882 ;; Display visited menu items in a different face
4883 (if (and Info-fontify-visited-nodes
4884 (save-match-data
d8fbba22 4885 (let* ((node (if (equal (match-string 3) "")
bec275ed
JL
4886 (match-string-no-properties 1)
4887 (match-string-no-properties 3)))
d8fbba22
CY
4888 (external-link-p
4889 (string-match "(\\([^)]+\\))\\([^)]*\\)" node))
4890 (file (if external-link-p
4891 (file-name-nondirectory
bec275ed 4892 (match-string-no-properties 1 node))
d8fbba22
CY
4893 Info-current-file))
4894 (hl Info-history-list)
4895 res)
4896 (if external-link-p
4897 (setq node (if (equal (match-string 2 node) "")
a73db543 4898 "Top"
bec275ed 4899 (match-string-no-properties 2 node))))
d590dbd2
CY
4900 (while hl
4901 (if (and (string-equal node (nth 1 (car hl)))
bec275ed
JL
4902 (equal file
4903 (if (and external-link-p
4904 (stringp (caar hl)))
4905 (file-name-nondirectory
4906 (caar hl))
4907 (caar hl))))
d590dbd2
CY
4908 (setq res (car hl) hl nil)
4909 (setq hl (cdr hl))))
a73db543 4910 res))) 'info-xref-visited 'info-xref)))
0f218170
JL
4911 (when (and not-fontified-p
4912 (memq Info-hide-note-references '(t hide))
4913 (not (Info-index-node)))
1ecc5922
RS
4914 (put-text-property (match-beginning 2) (1- (match-end 6))
4915 'invisible t)
4916 ;; Unhide the file name in parens
4917 (if (and (match-end 4) (not (eq (char-after (match-end 4)) ?.)))
4918 (remove-text-properties (match-beginning 4) (match-end 4)
4919 '(invisible t)))
4920 ;; We need a stretchable space like :align-to but with
4921 ;; a minimum value.
4922 (put-text-property (1- (match-end 6)) (match-end 6) 'display
4923 (if (>= 22 (- (match-end 1)
4924 (match-beginning 0)))
4925 '(space :align-to 24)
4926 '(space :width 2)))
4927 (setq cont (looking-at "."))
4928 (while (and (= (forward-line 1) 0)
4929 (looking-at "\\([ \t]+\\)[^*\n]"))
4930 (put-text-property (match-beginning 1) (1- (match-end 1))
4931 'invisible t)
4932 (put-text-property (1- (match-end 1)) (match-end 1)
4933 'display
4934 (if cont
4935 '(space :align-to 26)
4936 '(space :align-to 24)))
4937 (setq cont t)))))))
8a7757f6
JL
4938
4939 ;; Fontify menu headers
4940 ;; Add the face `info-menu-header' to any header before a menu entry
4941 (goto-char (point-min))
4942 (when (and not-fontified-p (re-search-forward "^\\* Menu:" nil t))
4943 (put-text-property (match-beginning 0) (match-end 0)
4944 'font-lock-face 'info-menu-header)
4945 (while (re-search-forward "\n\n\\([^*\n ].*\\)\n\n?[*]" nil t)
4946 (put-text-property (match-beginning 1) (match-end 1)
4947 'font-lock-face 'info-menu-header)))
4948
836bb478
JL
4949 ;; Hide index line numbers
4950 (goto-char (point-min))
141b49f5 4951 (when (and not-fontified-p (Info-index-node))
836bb478
JL
4952 (while (re-search-forward "[ \t\n]*(line +[0-9]+)" nil t)
4953 (put-text-property (match-beginning 0) (match-end 0)
4954 'invisible t)))
4955
8a7757f6
JL
4956 ;; Fontify http and ftp references
4957 (goto-char (point-min))
4958 (when not-fontified-p
68b77b64
GM
4959 (while (re-search-forward "\\(https?\\|ftp\\)://[^ \t\n\"`({<>})']+"
4960 nil t)
8a7757f6
JL
4961 (add-text-properties (match-beginning 0) (match-end 0)
4962 '(font-lock-face info-xref
fdeb777a
SM
4963 mouse-face highlight
4964 help-echo "mouse-2: go to this URL"))))
8a7757f6 4965
afff09d0
JL
4966 ;; Fontify footnotes
4967 (goto-char (point-min))
4968 (when (and not-fontified-p (re-search-forward "^[ \t]*-+ Footnotes -+$" nil t))
4969 (let ((limit (point)))
4970 (goto-char (point-min))
4971 (while (re-search-forward "\\(([0-9]+)\\)" nil t)
4972 (add-text-properties (match-beginning 0) (match-end 0)
4973 `(font-lock-face info-xref
4974 link t
4975 mouse-face highlight
4976 help-echo
4977 ,(if (< (point) limit)
4978 "mouse-2: go to footnote definition"
4979 "mouse-2: go to footnote reference"))))))
4980
d44688e4
JL
4981 ;; Hide empty lines at the end of the node.
4982 (goto-char (point-max))
4983 (skip-chars-backward "\n")
68bf4e09
JL
4984 (when (< (point) (1- (point-max)))
4985 (put-text-property (point) (1- (point-max)) 'invisible t))
d44688e4 4986
8a7757f6 4987 (set-buffer-modified-p nil))))
c5fe2ff1 4988\f
3cb6768f
EL
4989;;; Speedbar support:
4990;; These functions permit speedbar to display the "tags" in the
185cff95 4991;; current Info node.
0cdffd7d 4992(eval-when-compile (require 'speedbar)) ; for speedbar-with-writable
3cb6768f 4993
d7fe6352
JB
4994(declare-function speedbar-add-expansion-list "speedbar" (new-list))
4995(declare-function speedbar-center-buffer-smartly "speedbar" ())
4996(declare-function speedbar-change-expand-button-char "speedbar" (char))
4997(declare-function speedbar-change-initial-expansion-list "speedbar" (new-default))
4998(declare-function speedbar-delete-subblock "speedbar" (indent))
4999(declare-function speedbar-make-specialized-keymap "speedbar" ())
5000(declare-function speedbar-make-tag-line "speedbar"
5001 (exp-button-type exp-button-char exp-button-function
5002 exp-button-data tag-button tag-button-function
5003 tag-button-data tag-button-face depth))
5004
96ee3f29 5005(defvar Info-speedbar-key-map nil
6194c800 5006 "Keymap used when in the Info display mode.")
3cb6768f 5007
96ee3f29
KH
5008(defun Info-install-speedbar-variables ()
5009 "Install those variables used by speedbar to enhance Info."
5010 (if Info-speedbar-key-map
5011 nil
5012 (setq Info-speedbar-key-map (speedbar-make-specialized-keymap))
5013
5014 ;; Basic tree features
5015 (define-key Info-speedbar-key-map "e" 'speedbar-edit-line)
5016 (define-key Info-speedbar-key-map "\C-m" 'speedbar-edit-line)
5017 (define-key Info-speedbar-key-map "+" 'speedbar-expand-line)
5018 (define-key Info-speedbar-key-map "-" 'speedbar-contract-line)
5019 )
5020
5021 (speedbar-add-expansion-list '("Info" Info-speedbar-menu-items
5022 Info-speedbar-key-map
5023 Info-speedbar-hierarchy-buttons)))
3cb6768f
EL
5024
5025(defvar Info-speedbar-menu-items
96ee3f29
KH
5026 '(["Browse Node" speedbar-edit-line t]
5027 ["Expand Node" speedbar-expand-line
5028 (save-excursion (beginning-of-line)
5029 (looking-at "[0-9]+: *.\\+. "))]
5030 ["Contract Node" speedbar-contract-line
5031 (save-excursion (beginning-of-line)
5032 (looking-at "[0-9]+: *.-. "))]
5033 )
3cb6768f
EL
5034 "Additional menu-items to add to speedbar frame.")
5035
96ee3f29
KH
5036;; Make sure our special speedbar major mode is loaded
5037(if (featurep 'speedbar)
5038 (Info-install-speedbar-variables)
5039 (add-hook 'speedbar-load-hook 'Info-install-speedbar-variables))
5040
5041;;; Info hierarchy display method
5042;;;###autoload
5043(defun Info-speedbar-browser ()
185cff95 5044 "Initialize speedbar to display an Info node browser.
96ee3f29
KH
5045This will add a speedbar major display mode."
5046 (interactive)
5047 (require 'speedbar)
5048 ;; Make sure that speedbar is active
5049 (speedbar-frame-mode 1)
5050 ;; Now, throw us into Info mode on speedbar.
5051 (speedbar-change-initial-expansion-list "Info")
5052 )
5053
0cdffd7d
GM
5054;; speedbar loads dframe at runtime.
5055(declare-function dframe-select-attached-frame "dframe" (&optional frame))
5056(declare-function dframe-current-frame "dframe" (frame-var desired-major-mode))
5057
6194c800 5058(defun Info-speedbar-hierarchy-buttons (_directory depth &optional node)
96ee3f29
KH
5059 "Display an Info directory hierarchy in speedbar.
5060DIRECTORY is the current directory in the attached frame.
5061DEPTH is the current indentation depth.
5062NODE is an optional argument that is used to represent the
5063specific node to expand."
5064 (if (and (not node)
5065 (save-excursion (goto-char (point-min))
1bcedb3b
RS
5066 (let ((case-fold-search t))
5067 (looking-at "Info Nodes:"))))
96ee3f29
KH
5068 ;; Update our "current node" maybe?
5069 nil
5070 ;; We cannot use the generic list code, that depends on all leaves
5071 ;; being known at creation time.
5072 (if (not node)
5073 (speedbar-with-writable (insert "Info Nodes:\n")))
24bbdbef
CY
5074 (let ((completions nil))
5075 (speedbar-select-attached-frame)
5fdc7997
EL
5076 (save-window-excursion
5077 (setq completions
5078 (Info-speedbar-fetch-file-nodes (or node '"(dir)top"))))
222a6c9b 5079 (select-frame (speedbar-current-frame))
96ee3f29
KH
5080 (if completions
5081 (speedbar-with-writable
dde7f979 5082 (dolist (completion completions)
96ee3f29 5083 (speedbar-make-tag-line 'bracket ?+ 'Info-speedbar-expand-node
dde7f979
SM
5084 (cdr completion)
5085 (car completion)
96ee3f29 5086 'Info-speedbar-goto-node
dde7f979
SM
5087 (cdr completion)
5088 'info-xref depth))
96ee3f29
KH
5089 t)
5090 nil))))
399c88ad 5091
6194c800 5092(defun Info-speedbar-goto-node (_text node _indent)
d1268e52 5093 "When user clicks on TEXT, go to an info NODE.
96ee3f29 5094The INDENT level is ignored."
24bbdbef 5095 (speedbar-select-attached-frame)
760d5cb3
GM
5096 (let* ((buff (or (get-buffer "*info*")
5097 (progn (info) (get-buffer "*info*"))))
5098 (bwin (get-buffer-window buff 0)))
5099 (if bwin
5100 (progn
5101 (select-window bwin)
5102 (raise-frame (window-frame bwin)))
5103 (if speedbar-power-click
37ac18a3 5104 (switch-to-buffer-other-frame buff)
24bbdbef 5105 (speedbar-select-attached-frame)
760d5cb3 5106 (switch-to-buffer buff)))
dde7f979
SM
5107 (if (not (string-match "^(\\([^)]+\\))\\([^.]+\\)$" node))
5108 (error "Invalid node %s" node)
5109 (Info-find-node (match-string 1 node) (match-string 2 node))
760d5cb3
GM
5110 ;; If we do a find-node, and we were in info mode, restore
5111 ;; the old default method. Once we are in info mode, it makes
5112 ;; sense to return to whatever method the user was using before.
5113 (if (string= speedbar-initial-expansion-list-name "Info")
5114 (speedbar-change-initial-expansion-list
5115 speedbar-previously-used-expansion-list-name)))))
96ee3f29
KH
5116
5117(defun Info-speedbar-expand-node (text token indent)
5118 "Expand the node the user clicked on.
5119TEXT is the text of the button we clicked on, a + or - item.
5120TOKEN is data related to this node (NAME . FILE).
5121INDENT is the current indentation depth."
5122 (cond ((string-match "+" text) ;we have to expand this file
5123 (speedbar-change-expand-button-char ?-)
5124 (if (speedbar-with-writable
760d5cb3
GM
5125 (save-excursion
5126 (end-of-line) (forward-char 1)
5127 (Info-speedbar-hierarchy-buttons nil (1+ indent) token)))
96ee3f29
KH
5128 (speedbar-change-expand-button-char ?-)
5129 (speedbar-change-expand-button-char ??)))
5130 ((string-match "-" text) ;we have to contract this node
5131 (speedbar-change-expand-button-char ?+)
5132 (speedbar-delete-subblock indent))
5133 (t (error "Ooops... not sure what to do")))
5134 (speedbar-center-buffer-smartly))
5135
5136(defun Info-speedbar-fetch-file-nodes (nodespec)
5137 "Fetch the subnodes from the info NODESPEC.
db90d225 5138NODESPEC is a string of the form: (file)node."
e8dab975
SM
5139 ;; Set up a buffer we can use to fake-out Info.
5140 (with-current-buffer (get-buffer-create " *info-browse-tmp*")
1b3b87df 5141 (if (not (derived-mode-p 'Info-mode))
96ee3f29
KH
5142 (Info-mode))
5143 ;; Get the node into this buffer
dde7f979
SM
5144 (if (not (string-match "^(\\([^)]+\\))\\([^.]+\\)$" nodespec))
5145 (error "Invalid node specification %s" nodespec)
5146 (Info-find-node (match-string 1 nodespec) (match-string 2 nodespec)))
96ee3f29
KH
5147 ;; Scan the created buffer
5148 (goto-char (point-min))
5149 (let ((completions nil)
1bcedb3b 5150 (case-fold-search t)
96ee3f29
KH
5151 (thisfile (progn (string-match "^(\\([^)]+\\))" nodespec)
5152 (match-string 1 nodespec))))
5153 ;; Always skip the first one...
5154 (re-search-forward "\n\\* \\([^:\t\n]*\\):" nil t)
5155 (while (re-search-forward "\n\\* \\([^:\t\n]*\\):" nil t)
5156 (let ((name (match-string 1)))
dde7f979
SM
5157 (push (cons name
5158 (if (looking-at " *\\(([^)]+)[^.\n]+\\)\\.")
5159 (match-string 1)
5160 (if (looking-at " *\\(([^)]+)\\)\\.")
5161 (concat (match-string 1) "Top")
5162 (concat "(" thisfile ")"
5163 (if (looking-at " \\([^.]+\\).")
5164 (match-string 1)
5165 name)))))
5166 completions)))
96ee3f29
KH
5167 (nreverse completions))))
5168
5169;;; Info mode node listing
24bbdbef 5170;; This is called by `speedbar-add-localized-speedbar-support'
6194c800 5171(defun Info-speedbar-buttons (_buffer)
3cb6768f
EL
5172 "Create a speedbar display to help navigation in an Info file.
5173BUFFER is the buffer speedbar is requesting buttons for."
96ee3f29 5174 (if (save-excursion (goto-char (point-min))
1bcedb3b
RS
5175 (let ((case-fold-search t))
5176 (not (looking-at "Info Nodes:"))))
96ee3f29 5177 (erase-buffer))
24bbdbef 5178 (Info-speedbar-hierarchy-buttons nil 0))
49116ac0 5179
71873e2b
SM
5180;; FIXME: Really? Why here?
5181(add-to-list 'debug-ignored-errors 'search-failed)
48e5b471 5182
f3a45db0
LH
5183;;;; Desktop support
5184
6194c800 5185(defun Info-desktop-buffer-misc-data (_desktop-dirname)
f3a45db0 5186 "Auxiliary information to be saved in desktop file."
221a0647
JL
5187 (list Info-current-file
5188 Info-current-node
5189 ;; Additional data as an association list.
5190 (delq nil (list
5191 (and Info-history
5192 (cons 'history Info-history))
5193 (and (Info-virtual-fun
5194 'slow Info-current-file Info-current-node)
5195 (cons 'slow t))))))
f3a45db0 5196
6194c800 5197(defun Info-restore-desktop-buffer (_desktop-buffer-file-name
f3a45db0
LH
5198 desktop-buffer-name
5199 desktop-buffer-misc)
185cff95 5200 "Restore an Info buffer specified in a desktop file."
221a0647
JL
5201 (let* ((file (nth 0 desktop-buffer-misc))
5202 (node (nth 1 desktop-buffer-misc))
5203 (data (nth 2 desktop-buffer-misc))
5204 (hist (assq 'history data))
5205 (slow (assq 'slow data)))
5206 ;; Don't restore nodes slow to regenerate.
5207 (unless slow
5208 (when (and file node)
5209 (when desktop-buffer-name
5210 (set-buffer (get-buffer-create desktop-buffer-name))
5211 (Info-mode))
5212 (Info-find-node file node)
5213 (when hist
5214 (setq Info-history (cdr hist)))
5215 (current-buffer)))))
f3a45db0 5216
9e7357b0
AS
5217(add-to-list 'desktop-buffer-mode-handlers
5218 '(Info-mode . Info-restore-desktop-buffer))
80123c9e 5219
23ceed9a 5220;;;; Bookmark support
e44fa724
KF
5221(declare-function bookmark-make-record-default
5222 "bookmark" (&optional no-file no-context posn))
43f8b275
SM
5223(declare-function bookmark-prop-get "bookmark" (bookmark prop))
5224(declare-function bookmark-default-handler "bookmark" (bmk))
5225(declare-function bookmark-get-bookmark-record "bookmark" (bmk))
e1af69b4 5226
32a091dd 5227(defun Info-bookmark-make-record ()
8559076d
KF
5228 "This implements the `bookmark-make-record-function' type (which see)
5229for Info nodes."
ce0fcefa 5230 (let* ((file (and (stringp Info-current-file)
858aab4c
JL
5231 (file-name-sans-extension
5232 (file-name-nondirectory Info-current-file))))
ce0fcefa
JL
5233 (bookmark-name (if file
5234 (concat "(" file ") " Info-current-node)
5235 Info-current-node))
5236 (defaults (delq nil (list bookmark-name file Info-current-node))))
5237 `(,bookmark-name
5238 ,@(bookmark-make-record-default 'no-file)
5239 (filename . ,Info-current-file)
5240 (info-node . ,Info-current-node)
5241 (handler . Info-bookmark-jump)
5242 (defaults . ,defaults))))
23ceed9a
TH
5243
5244;;;###autoload
5245(defun Info-bookmark-jump (bmk)
8559076d
KF
5246 "This implements the `handler' function interface for the record
5247type returned by `Info-bookmark-make-record', which see."
43f8b275
SM
5248 (let* ((file (bookmark-prop-get bmk 'filename))
5249 (info-node (bookmark-prop-get bmk 'info-node))
5250 (buf (save-window-excursion ;FIXME: doesn't work with frames!
5251 (Info-find-node file info-node) (current-buffer))))
5252 ;; Use bookmark-default-handler to move to the appropriate location
5253 ;; within the node.
5254 (bookmark-default-handler
348d1e60 5255 `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bmk)))))
23ceed9a 5256
0f0c1f27
EZ
5257\f
5258;;;###autoload
5259(defun info-display-manual (manual)
3faf4944
JL
5260 "Display an Info buffer displaying MANUAL.
5261If there is an existing Info buffer for MANUAL, display it.
5262Otherwise, visit the manual in a new Info buffer."
010db6da
JL
5263 (interactive
5264 (list
5265 (progn
5266 (info-initialize)
5267 (completing-read "Manual name: "
04b14f2b 5268 (info--manual-names)
010db6da 5269 nil t))))
0f0c1f27
EZ
5270 (let ((blist (buffer-list))
5271 (manual-re (concat "\\(/\\|\\`\\)" manual "\\(\\.\\|\\'\\)"))
5272 (case-fold-search t)
5273 found)
5274 (dolist (buffer blist)
5275 (with-current-buffer buffer
5276 (when (and (eq major-mode 'Info-mode)
5277 (stringp Info-current-file)
5278 (string-match manual-re Info-current-file))
5279 (setq found buffer
5280 blist nil))))
5281 (if found
37ac18a3 5282 (switch-to-buffer found)
0f0c1f27 5283 (info-initialize)
3faf4944
JL
5284 (info (Info-find-file manual)
5285 (generate-new-buffer-name "*info*")))))
0f0c1f27 5286
04b14f2b
CY
5287(defun info--manual-names ()
5288 (let (names)
5289 (dolist (buffer (buffer-list))
5290 (with-current-buffer buffer
5291 (and (eq major-mode 'Info-mode)
5292 (stringp Info-current-file)
8a2e287c 5293 (not (string= (substring (buffer-name) 0 1) " "))
04b14f2b
CY
5294 (push (file-name-sans-extension
5295 (file-name-nondirectory Info-current-file))
5296 names))))
5297 (delete-dups (append (nreverse names)
8a2e287c
JL
5298 (all-completions
5299 ""
5300 (apply-partially 'Info-read-node-name-2
5301 Info-directory-list
5302 (mapcar 'car Info-suffix-list)))))))
04b14f2b 5303
49116ac0
JB
5304(provide 'info)
5305
1a06eabd 5306;;; info.el ends here