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