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