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