(Finsert_file_contents): If REPLACE is non-nil, stop
[bpt/emacs.git] / lisp / info.el
CommitLineData
55535639 1;;; info.el --- info package for Emacs
e5167999 2
5b3ebb44
GM
3;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001
4;; Free Software Foundation, Inc.
3a801d0c 5
e5167999 6;; Maintainer: FSF
fd7fa35a 7;; Keywords: help
e5167999 8
a384cab3
JB
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
e5167999 13;; the Free Software Foundation; either version 2, or (at your option)
a384cab3
JB
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
b578f267
EN
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24;; Boston, MA 02111-1307, USA.
a384cab3 25
e5167999
ER
26;;; Commentary:
27
b578f267 28;; Note that nowadays we expect info files to be made using makeinfo.
e5167999
ER
29
30;;; Code:
31
bc6262c8
DL
32(eval-when-compile (require 'jka-compr))
33
ded3e3d8
RS
34(defgroup info nil
35 "Info subsystem"
36 :group 'help
37 :group 'docs)
38
39
a384cab3
JB
40(defvar Info-history nil
41 "List of info nodes user has visited.
42Each element of list is a list (FILENAME NODENAME BUFFERPOS).")
43
ded3e3d8 44(defcustom Info-enable-edit nil
d5913bf6 45 "*Non-nil means the \\<Info-mode-map>\\[Info-edit] command in Info can edit the current node.
ada0a60d
RS
46This is convenient if you want to write info files by hand.
47However, we recommend that you not do this.
48It is better to write a Texinfo file and generate the Info file from that,
ded3e3d8
RS
49because that gives you a printed manual as well."
50 :type 'boolean
51 :group 'info)
a384cab3 52
67f445d7 53(defvar Info-enable-active-nodes nil
a384cab3
JB
54 "Non-nil allows Info to execute Lisp code associated with nodes.
55The Lisp code is executed when the node is selected.")
67f445d7 56(put 'Info-enable-active-nodes 'risky-local-variable t)
a384cab3 57
ded3e3d8
RS
58(defcustom Info-fontify t
59 "*Non-nil enables highlighting and fonts in Info nodes."
60 :type 'boolean
61 :group 'info)
552775bd 62
93480d70 63(defface info-node
52cbdfbd
MB
64 '((((class color) (background light)) (:foreground "brown" :bold t :italic t))
65 (((class color) (background dark)) (:foreground "white" :bold t :italic t))
7a3abcd8 66 (t (:bold t :italic t)))
93480d70
RS
67 "Face for Info node names."
68 :group 'info)
69
70(defface info-menu-5
7a3abcd8
EZ
71 '((((class color)) (:foreground "red1"))
72 (t (:underline t)))
030de92f 73 "Face for the fifth and nineth `*' in an Info menu."
93480d70
RS
74 :group 'info)
75
76(defface info-xref
52cbdfbd
MB
77 '((((class color) (background light)) (:foreground "magenta4" :bold t))
78 (((class color) (background dark)) (:foreground "cyan" :bold t))
7a3abcd8 79 (t (:bold t)))
93480d70
RS
80 "Face for Info cross-references."
81 :group 'info)
82
88ef7f62 83(defcustom Info-fontify-maximum-menu-size 100000
ded3e3d8
RS
84 "*Maximum size of menu to fontify if `Info-fontify' is non-nil."
85 :type 'integer
86 :group 'info)
bdf62a4d 87
50ac70af
MB
88(defcustom Info-use-header-line t
89 "*Non-nil means to put the beginning-of-node links in an emacs header-line.
90A header-line does not scroll with the rest of the buffer."
91 :type 'boolean
92 :group 'info)
93
94(defface info-header-xref
52cbdfbd 95 '((t (:inherit info-xref)))
50ac70af
MB
96 "Face for Info cross-references in a node header."
97 :group 'info)
98
99(defface info-header-node
4ad6e379 100 '((t (:inherit info-node)))
50ac70af
MB
101 "Face for Info nodes in a node header."
102 :group 'info)
103
7d3766a8 104(defvar Info-directory-list nil
a384cab3 105 "List of directories to search for Info documentation files.
aea2a8da 106nil means not yet initialized. In this case, Info uses the environment
44c327f9 107variable INFOPATH to initialize it, or `Info-default-directory-list'
e5bd2125 108if there is no INFOPATH variable in the environment.
778911b9
EZ
109
110When `Info-directory-list' is initialized from the value of
4dddb0b7
EZ
111`Info-default-directory-list', and Emacs is installed in one of the
112standard directories, the directory of Info files that come with Emacs
113is put last (so that local Info files override standard ones).
114
115When `Info-directory-list' is initialized from the value of
116`Info-default-directory-list', and Emacs is not installed in one
117of the standard directories, the first element of the resulting
778911b9
EZ
118list is the directory where Emacs installs the Info files that
119come with it. This is so that Emacs's own manual, which suits the
4dddb0b7
EZ
120version of Emacs you are using, will always be found first. This
121is useful when you install an experimental version of Emacs without
122removing the standard installation.
123
124If you want to override the order of directories in
125`Info-default-directory-list', set INFOPATH in the environment.
5da0f945
RS
126
127If you run the Emacs executable from the `src' directory in the Emacs
778911b9
EZ
128source tree, and INFOPATH is not defined, the `info' directory in the
129source tree is used as the first element of `Info-directory-list', in
130place of the installation Info directory. This is useful when you run
131a version of Emacs without installing it.")
a384cab3 132
ded3e3d8 133(defcustom Info-additional-directory-list nil
bdf62a4d 134 "List of additional directories to search for Info documentation files.
4645bb68 135These directories are searched after those in `Info-directory-list', and
60322163 136they are not searched for merging the `dir' file."
ded3e3d8
RS
137 :type '(repeat directory)
138 :group 'info)
bdf62a4d 139
7a53d8c8
EZ
140(defcustom Info-scroll-prefer-subnodes t
141 "*If non-nil, \\<Info-mode-map>\\[Info-scroll-up] in a menu visits subnodes.
142If this is non-nil, and you scroll far enough in a node that its menu
143appears on the screen, the next \\<Info-mode-map>\\[Info-scroll-up]
144moves to a subnode indicated by the following menu item. This means
145that you visit a subnode before getting to the end of the menu.
146
147Setting this option to nil results in behavior similar to the stand-alone
148Info reader program, which visits the first subnode from the menu only
149when you hit the end of the current node."
150 :type 'boolean
151 :group 'info)
152
a384cab3 153(defvar Info-current-file nil
d6be34f3
RS
154 "Info file that Info is now looking at, or nil.
155This is the name that was specified in Info, not the actual file name.
4fceda3c
SM
156It doesn't contain directory names or file name extensions added by Info.
157Can also be t when using `Info-on-current-buffer'.")
a384cab3
JB
158
159(defvar Info-current-subfile nil
fdf4b680
DL
160 "Info subfile that is actually in the *info* buffer now.
161nil if current info file is not split into subfiles.")
a384cab3
JB
162
163(defvar Info-current-node nil
164 "Name of node that Info is now looking at, or nil.")
165
c5fe2ff1 166(defvar Info-tag-table-marker nil
a384cab3
JB
167 "Marker pointing at beginning of current Info file's tag table.
168Marker points nowhere if file has no tag table.")
169
c5fe2ff1
RS
170(defvar Info-tag-table-buffer nil
171 "Buffer used for indirect tag tables.")
172
552775bd
RS
173(defvar Info-current-file-completions nil
174 "Cached completion list for current Info file.")
175
1143a6b0 176(defvar Info-index-alternatives nil
fdf4b680 177 "List of possible matches for last `Info-index' command.")
1143a6b0 178
552775bd
RS
179(defvar Info-standalone nil
180 "Non-nil if Emacs was started solely as an Info browser.")
7d3766a8 181\f
bd0c9168 182(defvar Info-suffix-list
3c19e6c1
RS
183 ;; The MS-DOS list should work both when long file names are
184 ;; supported (Windows 9X), and when only 8+3 file names are available.
bd0c9168
RS
185 (if (eq system-type 'ms-dos)
186 '( (".gz" . "gunzip")
187 (".z" . "gunzip")
544e210f 188 (".bz2" . ("bzip2" "-dc"))
3c19e6c1
RS
189 (".inz" . "gunzip")
190 (".igz" . "gunzip")
191 (".info.Z" . "gunzip")
192 (".info.gz" . "gunzip")
193 ("-info.Z" . "gunzip")
194 ("-info.gz" . "gunzip")
195 ("/index.gz". "gunzip")
196 ("/index.z" . "gunzip")
9b842cab 197 (".inf" . nil)
3c19e6c1
RS
198 (".info" . nil)
199 ("-info" . nil)
200 ("/index" . nil)
bd0c9168 201 ("" . nil))
a70dc410
RS
202 '( (".info.Z". "uncompress")
203 (".info.Y". "unyabba")
204 (".info.gz". "gunzip")
205 (".info.z". "gunzip")
544e210f 206 (".info.bz2" . ("bzip2" "-dc"))
a70dc410
RS
207 (".info". nil)
208 ("-info.Z". "uncompress")
209 ("-info.Y". "unyabba")
210 ("-info.gz". "gunzip")
544e210f 211 ("-info.bz2" . ("bzip2" "-dc"))
a70dc410
RS
212 ("-info.z". "gunzip")
213 ("-info". nil)
214 ("/index.Z". "uncompress")
215 ("/index.Y". "unyabba")
216 ("/index.gz". "gunzip")
217 ("/index.z". "gunzip")
544e210f 218 ("/index.bz2". ("bzip2" "-dc"))
a70dc410
RS
219 ("/index". nil)
220 (".Z". "uncompress")
221 (".Y". "unyabba")
222 (".gz". "gunzip")
223 (".z". "gunzip")
544e210f 224 (".bz2" . ("bzip2" "-dc"))
a70dc410 225 ("". nil)))
1143a6b0
ER
226 "List of file name suffixes and associated decoding commands.
227Each entry should be (SUFFIX . STRING); the file is given to
544e210f
KH
228the command as standard input.
229
230STRING may be a list of strings. In that case, the first element is
231the command name, and the rest are arguments to that command.
232
233If STRING is nil, no decoding is done.
97f99202
KH
234Because the SUFFIXes are tried in order, the empty string should
235be last in the list.")
1143a6b0 236
c8e9dd54 237;; Concatenate SUFFIX onto FILENAME. SUFFIX should start with a dot.
e0c1e774
EZ
238;; First, on MS-DOS with no long file names support, delete some of
239;; the extension in FILENAME to make room.
240(defun info-insert-file-contents-1 (filename suffix lfn)
241 (if lfn ; long file names are supported
bd0c9168
RS
242 (concat filename suffix)
243 (let* ((sans-exts (file-name-sans-extension filename))
c8e9dd54
RS
244 ;; How long is the extension in FILENAME (not counting the dot).
245 (ext-len (max 0 (- (length filename) (length sans-exts) 1)))
246 ext-left)
9b842cab 247 ;; SUFFIX starts with a dot. If FILENAME already has one,
1583fe94 248 ;; get rid of the one in SUFFIX (unless suffix is empty).
c8e9dd54 249 (or (and (<= ext-len 0)
9b842cab 250 (not (eq (aref filename (1- (length filename))) ?.)))
1583fe94 251 (= (length suffix) 0)
9b842cab 252 (setq suffix (substring suffix 1)))
c8e9dd54
RS
253 ;; How many chars of that extension should we keep?
254 (setq ext-left (min ext-len (max 0 (- 3 (length suffix)))))
bd0c9168
RS
255 ;; Get rid of the rest of the extension, and add SUFFIX.
256 (concat (substring filename 0 (- (length filename)
257 (- ext-len ext-left)))
258 suffix))))
259
9c7924d5
RS
260(defun info-file-exists-p (filename)
261 (and (file-exists-p filename)
262 (not (file-directory-p filename))))
263
1143a6b0
ER
264(defun info-insert-file-contents (filename &optional visit)
265 "Insert the contents of an info file in the current buffer.
266Do the right thing if the file has been compressed or zipped."
e0c1e774
EZ
267 (let* ((tail Info-suffix-list)
268 (lfn (or (not (fboundp 'msdos-long-file-names))
269 (msdos-long-file-names)))
270 (check-short (and (fboundp 'msdos-long-file-names)
271 lfn))
272 fullname decoder done)
b8fa4e87 273 (if (info-file-exists-p filename)
bd0c9168
RS
274 ;; FILENAME exists--see if that name contains a suffix.
275 ;; If so, set DECODE accordingly.
97f99202
KH
276 (progn
277 (while (and tail
278 (not (string-match
279 (concat (regexp-quote (car (car tail))) "$")
280 filename)))
281 (setq tail (cdr tail)))
282 (setq fullname filename
283 decoder (cdr (car tail))))
bd0c9168 284 ;; Try adding suffixes to FILENAME and see if we can find something.
e0c1e774
EZ
285 (while (and tail (not done))
286 (setq fullname (info-insert-file-contents-1 filename
287 (car (car tail)) lfn))
288 (if (info-file-exists-p fullname)
289 (setq done t
290 ;; If we found a file with a suffix, set DECODER
291 ;; according to the suffix.
292 decoder (cdr (car tail)))
293 ;; When the MS-DOS port runs on Windows, we need to check
294 ;; the short variant of a long file name as well.
295 (when check-short
296 (setq fullname (info-insert-file-contents-1 filename
297 (car (car tail)) nil))
298 (if (info-file-exists-p fullname)
299 (setq done t
300 decoder (cdr (car tail))))))
97f99202 301 (setq tail (cdr tail)))
97f99202 302 (or tail
bd0c9168 303 (error "Can't find %s or any compressed version of it" filename)))
e175bda2
RS
304 ;; check for conflict with jka-compr
305 (if (and (featurep 'jka-compr)
306 (jka-compr-installed-p)
307 (jka-compr-get-compression-info fullname))
308 (setq decoder nil))
97f99202 309 (if decoder
3c19e6c1
RS
310 (progn
311 (insert-file-contents-literally fullname visit)
312 (let ((buffer-read-only nil)
313 (coding-system-for-write 'no-conversion)
314 (default-directory (or (file-name-directory fullname)
315 default-directory)))
544e210f
KH
316 (or (consp decoder)
317 (setq decoder (list decoder)))
318 (apply 'call-process-region (point-min) (point-max)
319 (car decoder) t t nil (cdr decoder))))
3c19e6c1 320 (insert-file-contents fullname visit))))
7d3766a8 321\f
7d3766a8 322(defun info-initialize ()
fdf4b680 323 "Initialize `Info-directory-list', if that hasn't been done yet."
7d3766a8
RS
324 (unless Info-directory-list
325 (let ((path (getenv "INFOPATH"))
326 (source (expand-file-name "info/" source-directory))
327 (sibling (if installation-directory
2c366083 328 (expand-file-name "info/" installation-directory)
fecd556a 329 (if invocation-directory
2c366083
EZ
330 (let ((infodir (expand-file-name
331 "../info/"
332 invocation-directory)))
333 (if (file-exists-p infodir)
334 infodir
335 (setq infodir (expand-file-name
336 "../../../info/"
337 invocation-directory))
338 (and (file-exists-p infodir)
339 infodir))))))
7d3766a8
RS
340 alternative)
341 (setq Info-directory-list
78e7e8a0
MB
342 (prune-directory-list
343 (if path
344 (split-string path (regexp-quote path-separator))
345 (if (and sibling (file-exists-p sibling))
346 ;; Uninstalled, Emacs builddir != srcdir.
347 (setq alternative sibling)
348 ;; Uninstalled, builddir == srcdir
349 (setq alternative source))
350 (if (or (member alternative Info-default-directory-list)
351 ;; On DOS/NT, we use movable executables always,
352 ;; and we must always find the Info dir at run time.
353 (if (memq system-type '(ms-dos windows-nt))
354 nil
355 ;; Use invocation-directory for Info
356 ;; only if we used it for exec-directory also.
357 (not (string= exec-directory
358 (expand-file-name "lib-src/"
359 installation-directory))))
360 (not (file-exists-p alternative)))
361 Info-default-directory-list
362 ;; `alternative' contains the Info files that came with this
363 ;; version, so we should look there first. `Info-insert-dir'
364 ;; currently expects to find `alternative' first on the list.
365 (cons alternative
366 (reverse (cdr (reverse Info-default-directory-list)))))))))))
1143a6b0 367
a6e4564e
RS
368;;;###autoload
369(defun info-other-window (&optional file)
370 "Like `info' but show the Info buffer in another window."
371 (interactive (if current-prefix-arg
372 (list (read-file-name "Info file name: " nil nil t))))
373 (let (same-window-buffer-names)
374 (info file)))
399c88ad 375
d282974b 376;;;###autoload (add-hook 'same-window-buffer-names "*info*")
211d6309 377
a384cab3
JB
378;;;###autoload
379(defun info (&optional file)
380 "Enter Info, the documentation browser.
381Optional argument FILE specifies the file to examine;
382the default is the top-level directory of Info.
83d5c772
DL
383Called from a program, FILE may specify an Info node of the form
384`(FILENAME)NODENAME'.
a384cab3
JB
385
386In interactive use, a prefix argument directs this command
e341dab2
RS
387to read a file name from the minibuffer.
388
389The search path for Info files is in the variable `Info-directory-list'.
399c88ad 390The top-level Info directory is made by combining all the files named `dir'
e341dab2 391in all the directories in that path."
a384cab3
JB
392 (interactive (if current-prefix-arg
393 (list (read-file-name "Info file name: " nil nil t))))
a384cab3 394 (if file
c613e27e
KH
395 (progn
396 (pop-to-buffer "*info*")
397 ;; If argument already contains parentheses, don't add another set
398 ;; since the argument will then be parsed improperly. This also
399 ;; has the added benefit of allowing node names to be included
400 ;; following the parenthesized filename.
401 (if (and (stringp file) (string-match "(.*)" file))
402 (Info-goto-node file)
403 (Info-goto-node (concat "(" file ")"))))
35d2d241
RS
404 (if (get-buffer "*info*")
405 (pop-to-buffer "*info*")
406 (Info-directory))))
a384cab3 407
552775bd
RS
408;;;###autoload
409(defun info-standalone ()
410 "Run Emacs as a standalone Info reader.
411Usage: emacs -f info-standalone [filename]
412In standalone mode, \\<Info-mode-map>\\[Info-exit] exits Emacs itself."
413 (setq Info-standalone t)
414 (if (and command-line-args-left
415 (not (string-match "^-" (car command-line-args-left))))
416 (condition-case err
417 (progn
418 (info (car command-line-args-left))
419 (setq command-line-args-left (cdr command-line-args-left)))
420 (error (send-string-to-terminal
421 (format "%s\n" (if (eq (car-safe err) 'error)
422 (nth 1 err) err)))
423 (save-buffers-kill-emacs)))
424 (info)))
7d3766a8 425\f
983dfbf8 426;; See if the accessible portion of the buffer begins with a node
11638562
EZ
427;; delimiter, and the node header line which follows matches REGEXP.
428;; Typically, this test will be followed by a loop that examines the
429;; rest of the buffer with (search-forward "\n\^_"), and it's a pity
430;; to have the overhead of this special test inside the loop.
431
432;; This function changes match-data, but supposedly the caller might
433;; want to use the results of re-search-backward.
434
435;; The return value is the value of point at the beginning of matching
983dfbf8 436;; REGEXP, if the function succeeds, nil otherwise.
11638562 437(defun Info-node-at-bob-matching (regexp)
760d5cb3
GM
438 (and (bobp) ; are we at beginning of buffer?
439 (looking-at "\^_") ; does it begin with node delimiter?
11638562
EZ
440 (let (beg)
441 (forward-line 1)
442 (setq beg (point))
760d5cb3 443 (forward-line 1) ; does the line after delimiter match REGEXP?
11638562
EZ
444 (re-search-backward regexp beg t))))
445
a384cab3 446(defun Info-find-node (filename nodename &optional no-going-back)
fdf4b680
DL
447 "Go to an info node specified as separate FILENAME and NODENAME.
448NO-GOING-BACK is non-nil if recovering from an error in this function;
449it says do not attempt further (recursive) error recovery."
d0e41cba 450 (info-initialize)
a384cab3
JB
451 ;; Convert filename to lower case if not found as specified.
452 ;; Expand it.
4fceda3c 453 (if (stringp filename)
a384cab3 454 (let (temp temp-downcase found)
37a3ff5b
RS
455 (setq filename (substitute-in-file-name filename))
456 (if (string= (downcase filename) "dir")
457 (setq found t)
458 (let ((dirs (if (string-match "^\\./" filename)
459 ;; If specified name starts with `./'
460 ;; then just try current directory.
461 '("./")
462 (if (file-name-absolute-p filename)
463 ;; No point in searching for an
464 ;; absolute file name
465 '(nil)
466 (if Info-additional-directory-list
467 (append Info-directory-list
468 Info-additional-directory-list)
469 Info-directory-list)))))
470 ;; Search the directory list for file FILENAME.
471 (while (and dirs (not found))
472 (setq temp (expand-file-name filename (car dirs)))
473 (setq temp-downcase
474 (expand-file-name (downcase filename) (car dirs)))
475 ;; Try several variants of specified name.
e0c1e774
EZ
476 (let ((suffix-list Info-suffix-list)
477 (lfn (or (not (fboundp 'msdos-long-file-names))
478 (msdos-long-file-names))))
37a3ff5b
RS
479 (while (and suffix-list (not found))
480 (cond ((info-file-exists-p
481 (info-insert-file-contents-1
e0c1e774 482 temp (car (car suffix-list)) lfn))
37a3ff5b
RS
483 (setq found temp))
484 ((info-file-exists-p
485 (info-insert-file-contents-1
e0c1e774
EZ
486 temp-downcase (car (car suffix-list)) lfn))
487 (setq found temp-downcase))
488 ((and (fboundp 'msdos-long-file-names)
489 lfn
490 (info-file-exists-p
491 (info-insert-file-contents-1
492 temp (car (car suffix-list)) nil)))
493 (setq found temp)))
37a3ff5b
RS
494 (setq suffix-list (cdr suffix-list))))
495 (setq dirs (cdr dirs)))))
496 (if found
497 (setq filename found)
498 (error "Info file %s does not exist" filename))))
499 ;; Record the node we are leaving.
500 (if (and Info-current-file (not no-going-back))
501 (setq Info-history
502 (cons (list Info-current-file Info-current-node (point))
503 Info-history)))
a384cab3 504 ;; Go into info buffer.
c5fe2ff1 505 (or (eq major-mode 'Info-mode) (pop-to-buffer "*info*"))
4fceda3c
SM
506 (Info-find-node-2 filename nodename no-going-back))
507
508(defun Info-on-current-buffer (&optional nodename)
509 "Use the `Info-mode' to browse the current info buffer.
510If a prefix arg is provided, it queries for the NODENAME which
511else defaults to `Top'."
512 (interactive
513 (list (if current-prefix-arg
514 (completing-read "Node name: " (Info-build-node-completions)
515 nil t "Top")
516 "Top")))
75296efc 517 (info-initialize)
4fceda3c
SM
518 (Info-mode)
519 (set (make-local-variable 'Info-current-file) t)
520 (Info-find-node-2 nil nodename))
521
357d11de
GM
522(defun Info-find-in-tag-table-1 (marker regexp case-fold)
523 "Find a node in a tag table.
524MARKER specifies the buffer and position to start searching at.
525REGEXP is a regular expression matching nodes or references. Its first
526group should match `Node:' or `Ref:'.
527CASE-FOLD t means search for a case-insensitive match.
528If a match was found, value is a list (FOUND-ANCHOR POS MODE), where
529FOUND-ANCHOR is non-nil if a `Ref:' was matched, POS is the position
530where the match was found, and MODE is `major-mode' of the buffer in
531which the match was found."
532 (let ((case-fold-search case-fold)
533 found-mode guesspos found-anchor)
534 (save-excursion
535 (set-buffer (marker-buffer marker))
536 (goto-char marker)
537
538 ;; Search tag table
539 (beginning-of-line)
540 (when (re-search-forward regexp nil t)
541 (list (string-equal "Ref:" (match-string 1))
542 (1+ (read (current-buffer)))
543 major-mode)))))
544
545(defun Info-find-in-tag-table (marker regexp)
546 "Find a node in a tag table.
547MARKER specifies the buffer and position to start searching at.
548REGEXP is a regular expression matching nodes or references. Its first
549group should match `Node:' or `Ref:'.
550If a match was found, value is a list (FOUND-ANCHOR POS MODE), where
551FOUND-ANCHOR is non-nil if a `Ref:' was matched, POS is the position
552where the match was found, and MODE is `major-mode' of the buffer in
553which the match was found.
554This function tries to find a case-sensitive match first, then a
555case-insensitive match is tried."
556 (let ((result (Info-find-in-tag-table-1 marker regexp nil)))
557 (when (null (car result))
558 (setq result (Info-find-in-tag-table-1 marker regexp t)))
559 result))
560
561(defun Info-find-node-in-buffer-1 (regexp case-fold)
562 "Find a node or anchor in the current buffer.
563REGEXP is a regular expression matching nodes or references. Its first
564group should match `Node:' or `Ref:'.
565CASE-FOLD t means search for a case-insensitive match.
566Value is the position at which a match was found, or nil if not found."
567 (let ((case-fold-search case-fold)
568 found)
569 (save-excursion
570 (when (Info-node-at-bob-matching regexp)
571 (setq found (point)))
572 (while (and (not found)
573 (search-forward "\n\^_" nil t))
574 (forward-line 1)
575 (let ((beg (point)))
576 (forward-line 1)
577 (when (re-search-backward regexp beg t)
578 (beginning-of-line)
579 (setq found (point)))))
580 found)))
581
582(defun Info-find-node-in-buffer (regexp)
583 "Find a node or anchor in the current buffer.
584REGEXP is a regular expression matching nodes or references. Its first
585group should match `Node:' or `Ref:'.
586Value is the position at which a match was found, or nil if not found.
587This function looks for a case-sensitive match first. If none is found,
588a case-insensitive match is tried."
589 (or (Info-find-node-in-buffer-1 regexp nil)
590 (Info-find-node-in-buffer-1 regexp t)))
591
4fceda3c 592(defun Info-find-node-2 (filename nodename &optional no-going-back)
9e5c2f50 593 (buffer-disable-undo (current-buffer))
a384cab3
JB
594 (or (eq major-mode 'Info-mode)
595 (Info-mode))
596 (widen)
597 (setq Info-current-node nil)
598 (unwind-protect
8bdf4b20
KH
599 (let ((case-fold-search t)
600 anchorpos)
37a3ff5b
RS
601 ;; Switch files if necessary
602 (or (null filename)
603 (equal Info-current-file filename)
604 (let ((buffer-read-only nil))
605 (setq Info-current-file nil
606 Info-current-subfile nil
607 Info-current-file-completions nil
608 buffer-file-name nil)
609 (erase-buffer)
610 (if (eq filename t)
611 (Info-insert-dir)
612 (info-insert-file-contents filename t)
613 (setq default-directory (file-name-directory filename)))
614 (set-buffer-modified-p nil)
615 ;; See whether file has a tag table. Record the location if yes.
616 (goto-char (point-max))
617 (forward-line -8)
618 ;; Use string-equal, not equal, to ignore text props.
619 (if (not (or (string-equal nodename "*")
620 (not
621 (search-forward "\^_\nEnd tag table\n" nil t))))
622 (let (pos)
623 ;; We have a tag table. Find its beginning.
624 ;; Is this an indirect file?
625 (search-backward "\nTag table:\n")
626 (setq pos (point))
627 (if (save-excursion
628 (forward-line 2)
629 (looking-at "(Indirect)\n"))
630 ;; It is indirect. Copy it to another buffer
631 ;; and record that the tag table is in that buffer.
632 (let ((buf (current-buffer))
633 (tagbuf
634 (or Info-tag-table-buffer
635 (generate-new-buffer " *info tag table*"))))
636 (setq Info-tag-table-buffer tagbuf)
637 (save-excursion
638 (set-buffer tagbuf)
9e5c2f50 639 (buffer-disable-undo (current-buffer))
37a3ff5b
RS
640 (setq case-fold-search t)
641 (erase-buffer)
642 (insert-buffer-substring buf))
643 (set-marker Info-tag-table-marker
644 (match-end 0) tagbuf))
645 (set-marker Info-tag-table-marker pos)))
646 (set-marker Info-tag-table-marker nil))
647 (setq Info-current-file
648 (if (eq filename t) "dir" filename))))
649 ;; Use string-equal, not equal, to ignore text props.
650 (if (string-equal nodename "*")
651 (progn (setq Info-current-node nodename)
652 (Info-set-mode-line))
653 ;; Possibilities:
654 ;;
655 ;; 1. Anchor found in tag table
656 ;; 2. Anchor *not* in tag table
657 ;;
658 ;; 3. Node found in tag table
659 ;; 4. Node *not* found in tag table, but found in file
660 ;; 5. Node *not* in tag table, and *not* in file
661 ;;
662 ;; *Or* the same, but in an indirect subfile.
663
664 ;; Search file for a suitable node.
8bdf4b20 665 (let ((guesspos (point-min))
357d11de 666 (regexp (concat "\\(Node:\\|Ref:\\) *\\("
4ce5c223 667 (if (stringp nodename)
dd31e4e8
GM
668 (regexp-quote nodename)
669 "")
357d11de 670 "\\) *[,\t\n\177]"))
8bdf4b20 671 (nodepos nil))
37a3ff5b 672
82172606 673 (catch 'foo
357d11de 674
82172606 675 ;; First, search a tag table, if any
357d11de
GM
676 (when (marker-position Info-tag-table-marker)
677 (let* ((m Info-tag-table-marker)
678 (found (Info-find-in-tag-table m regexp)))
679
680 (when found
681 ;; FOUND is (ANCHOR POS MODE).
682 (setq guesspos (nth 1 found))
683
684 ;; If this is an indirect file, determine which
685 ;; file really holds this node and read it in.
686 (unless (eq (nth 2 found) 'Info-mode)
687 ;; Note that the current buffer must be the
688 ;; *info* buffer on entry to
689 ;; Info-read-subfile. Thus the hackery above.
690 (setq guesspos (Info-read-subfile guesspos)))
82172606
DL
691
692 ;; Handle anchor
357d11de
GM
693 (when (nth 0 found)
694 (goto-char (setq anchorpos guesspos))
695 (throw 'foo t)))))
82172606
DL
696
697 ;; Else we may have a node, which we search for:
698 (goto-char (max (point-min)
699 (- (byte-to-position guesspos) 1000)))
357d11de
GM
700
701 ;; Now search from our advised position (or from beg of
702 ;; buffer) to find the actual node. First, check
703 ;; whether the node is right where we are, in case the
704 ;; buffer begins with a node.
705 (let ((pos (Info-find-node-in-buffer regexp)))
706 (when pos
707 (goto-char pos)
708 (throw 'foo t))
709 (error "No such anchor in tag table or node in tag table or file: %s"
710 nodename)))
82172606
DL
711
712 (Info-select-node)
713 (goto-char (or anchorpos (point-min))))))
a384cab3
JB
714 ;; If we did not finish finding the specified node,
715 ;; go back to the previous one.
4db579ab 716 (or Info-current-node no-going-back (null Info-history)
37a3ff5b
RS
717 (let ((hist (car Info-history)))
718 (setq Info-history (cdr Info-history))
719 (Info-find-node (nth 0 hist) (nth 1 hist) t)
720 (goto-char (nth 2 hist))))))
a384cab3 721
44c327f9
JB
722;; Cache the contents of the (virtual) dir file, once we have merged
723;; it for the first time, so we can save time subsequently.
7ea13762
RS
724(defvar Info-dir-contents nil)
725
44c327f9
JB
726;; Cache for the directory we decided to use for the default-directory
727;; of the merged dir text.
728(defvar Info-dir-contents-directory nil)
729
c142ab2d
RS
730;; Record the file attributes of all the files from which we
731;; constructed Info-dir-contents.
732(defvar Info-dir-file-attributes nil)
733
4fba3b2c
RS
734(defvar Info-dir-file-name nil)
735
7ea13762 736;; Construct the Info directory node by merging the files named `dir'
44c327f9
JB
737;; from various directories. Set the *info* buffer's
738;; default-directory to the first directory we actually get any text
739;; from.
7ea13762 740(defun Info-insert-dir ()
c142ab2d
RS
741 (if (and Info-dir-contents Info-dir-file-attributes
742 ;; Verify that none of the files we used has changed
743 ;; since we used it.
744 (eval (cons 'and
b461e32d
SM
745 (mapcar (lambda (elt)
746 (let ((curr (file-attributes
747 ;; Handle symlinks
748 (file-truename (car elt)))))
749
750 ;; Don't compare the access time.
751 (if curr (setcar (nthcdr 4 curr) 0))
752 (setcar (nthcdr 4 (cdr elt)) 0)
753 (equal (cdr elt) curr)))
c142ab2d 754 Info-dir-file-attributes))))
4fba3b2c
RS
755 (progn
756 (insert Info-dir-contents)
757 (goto-char (point-min)))
dd31e4e8
GM
758 (let ((dirs (if Info-additional-directory-list
759 (append Info-directory-list
760 Info-additional-directory-list)
761 Info-directory-list))
1bcedb3b
RS
762 ;; Bind this in case the user sets it to nil.
763 (case-fold-search t)
4fba3b2c
RS
764 ;; This is set non-nil if we find a problem in some input files.
765 problems
f4008b6e 766 buffers buffer others nodes dirs-done)
44c327f9 767
825d6f08
RS
768 (setq Info-dir-file-attributes nil)
769
44c327f9 770 ;; Search the directory list for the directory file.
7ea13762 771 (while dirs
8d1abb42
RS
772 (let ((truename (file-truename (expand-file-name (car dirs)))))
773 (or (member truename dirs-done)
774 (member (directory-file-name truename) dirs-done)
775 ;; Try several variants of specified name.
776 ;; Try upcasing, appending `.info', or both.
825d6f08
RS
777 (let* (file
778 (attrs
779 (or
780 (progn (setq file (expand-file-name "dir" truename))
781 (file-attributes file))
782 (progn (setq file (expand-file-name "DIR" truename))
783 (file-attributes file))
784 (progn (setq file (expand-file-name "dir.info" truename))
785 (file-attributes file))
786 (progn (setq file (expand-file-name "DIR.INFO" truename))
787 (file-attributes file)))))
8d1abb42
RS
788 (setq dirs-done
789 (cons truename
790 (cons (directory-file-name truename)
791 dirs-done)))
825d6f08
RS
792 (if attrs
793 (save-excursion
794 (or buffers
795 (message "Composing main Info directory..."))
2d41cf59 796 (set-buffer (generate-new-buffer " info dir"))
9d499629
RS
797 (condition-case nil
798 (progn
799 (insert-file-contents file)
4fba3b2c
RS
800 (make-local-variable 'Info-dir-file-name)
801 (setq Info-dir-file-name file)
9d499629
RS
802 (setq buffers (cons (current-buffer) buffers)
803 Info-dir-file-attributes
804 (cons (cons file attrs)
805 Info-dir-file-attributes)))
806 (error (kill-buffer (current-buffer))))))))
3296453b
KH
807 (or (cdr dirs) (setq Info-dir-contents-directory
808 (file-name-as-directory (car dirs))))
825d6f08 809 (setq dirs (cdr dirs))))
399c88ad 810
4db579ab 811 (or buffers
81e14cb2 812 (error "Can't find the Info directory node"))
44c327f9 813 ;; Distinguish the dir file that comes with Emacs from all the
f4008b6e 814 ;; others. Yes, that is really what this is supposed to do.
f601cd3e
DL
815 ;; The definition of `Info-directory-list' puts it first on that
816 ;; list and so last in `buffers' at this point.
817 (setq buffer (car (last buffers))
818 others (delq buffer buffers))
44c327f9 819
debcea0c
KH
820 ;; Insert the entire original dir file as a start; note that we've
821 ;; already saved its default directory to use as the default
822 ;; directory for the whole concatenation.
7ea13762 823 (insert-buffer buffer)
44c327f9 824
7ea13762
RS
825 ;; Look at each of the other buffers one by one.
826 (while others
4fba3b2c 827 (let ((other (car others))
760d5cb3
GM
828 ;; Bind this in case the user sets it to nil.
829 (case-fold-search t)
4fba3b2c 830 this-buffer-nodes)
7ea13762
RS
831 ;; In each, find all the menus.
832 (save-excursion
833 (set-buffer other)
834 (goto-char (point-min))
835 ;; Find each menu, and add an elt to NODES for it.
836 (while (re-search-forward "^\\* Menu:" nil t)
837 (let (beg nodename end)
838 (forward-line 1)
fb163355
MB
839 (while (and (eolp) (not (eobp)))
840 (forward-line 1))
7ea13762 841 (setq beg (point))
ba42ce14
EZ
842 (or (search-backward "\n\^_" nil 'move)
843 (looking-at "\^_")
844 (signal 'search-failed (list "\n\^_")))
7ea13762
RS
845 (search-forward "Node: ")
846 (setq nodename (Info-following-node-name))
3a6ade8a 847 (search-forward "\n\^_" nil 'move)
7ea13762
RS
848 (beginning-of-line)
849 (setq end (point))
4fba3b2c
RS
850 (setq this-buffer-nodes
851 (cons (list nodename other beg end)
852 this-buffer-nodes))))
853 (if (assoc-ignore-case "top" this-buffer-nodes)
854 (setq nodes (nconc this-buffer-nodes nodes))
855 (setq problems t)
856 (message "No `top' node in %s" Info-dir-file-name))))
7ea13762 857 (setq others (cdr others)))
fdf4b680
DL
858 ;; Add to the main menu a menu item for each other node.
859 (let ((case-fold-search t)
760d5cb3 860 (re-search-forward "^\\* Menu:")))
7ea13762
RS
861 (forward-line 1)
862 (let ((menu-items '("top"))
863 (nodes nodes)
864 (case-fold-search t)
3a6ade8a 865 (end (save-excursion (search-forward "\^_" nil t) (point))))
7ea13762
RS
866 (while nodes
867 (let ((nodename (car (car nodes))))
c3a29d70
RS
868 (save-excursion
869 (or (member (downcase nodename) menu-items)
b37daea4 870 (re-search-forward (concat "^\\* +"
c3a29d70
RS
871 (regexp-quote nodename)
872 "::")
873 end t)
874 (progn
875 (insert "* " nodename "::" "\n")
876 (setq menu-items (cons nodename menu-items))))))
7ea13762
RS
877 (setq nodes (cdr nodes))))
878 ;; Now take each node of each of the other buffers
879 ;; and merge it into the main buffer.
880 (while nodes
760d5cb3
GM
881 (let ((case-fold-search t)
882 (nodename (car (car nodes))))
7ea13762
RS
883 (goto-char (point-min))
884 ;; Find the like-named node in the main buffer.
ba42ce14 885 (if (re-search-forward (concat "^\^_.*\n.*Node: "
7ea13762
RS
886 (regexp-quote nodename)
887 "[,\n\t]")
888 nil t)
889 (progn
3a6ade8a 890 (search-forward "\n\^_" nil 'move)
25869acf
RS
891 (beginning-of-line)
892 (insert "\n"))
7ea13762
RS
893 ;; If none exists, add one.
894 (goto-char (point-max))
dfbf6104 895 (insert "\^_\nFile: dir\tNode: " nodename "\n\n* Menu:\n\n"))
7ea13762
RS
896 ;; Merge the text from the other buffer's menu
897 ;; into the menu in the like-named node in the main buffer.
25869acf 898 (apply 'insert-buffer-substring (cdr (car nodes))))
7ea13762
RS
899 (setq nodes (cdr nodes)))
900 ;; Kill all the buffers we just made.
901 (while buffers
902 (kill-buffer (car buffers))
825d6f08 903 (setq buffers (cdr buffers)))
973a3104 904 (if Info-fontify (Info-fontify-menu-headers))
4fba3b2c
RS
905 (goto-char (point-min))
906 (if problems
907 (message "Composing main Info directory...problems encountered, see `*Messages*'")
908 (message "Composing main Info directory...done")))
44c327f9
JB
909 (setq Info-dir-contents (buffer-string)))
910 (setq default-directory Info-dir-contents-directory))
7ea13762 911
c5fe2ff1
RS
912;; Note that on entry to this function the current-buffer must be the
913;; *info* buffer; not the info tags buffer.
a384cab3 914(defun Info-read-subfile (nodepos)
a361deba
RS
915 ;; NODEPOS is either a position (in the Info file as a whole,
916 ;; not relative to a subfile) or the name of a subfile.
a384cab3
JB
917 (let (lastfilepos
918 lastfilename)
a361deba
RS
919 (if (numberp nodepos)
920 (save-excursion
921 (set-buffer (marker-buffer Info-tag-table-marker))
922 (goto-char (point-min))
ba42ce14
EZ
923 (or (looking-at "\^_")
924 (search-forward "\n\^_"))
a361deba
RS
925 (forward-line 2)
926 (catch 'foo
927 (while (not (looking-at "\^_"))
928 (if (not (eolp))
929 (let ((beg (point))
930 thisfilepos thisfilename)
931 (search-forward ": ")
932 (setq thisfilename (buffer-substring beg (- (point) 2)))
933 (setq thisfilepos (read (current-buffer)))
934 ;; read in version 19 stops at the end of number.
935 ;; Advance to the next line.
936 (forward-line 1)
937 (if (> thisfilepos nodepos)
938 (throw 'foo t))
939 (setq lastfilename thisfilename)
940 (setq lastfilepos thisfilepos))
941 (forward-line 1)))))
942 (setq lastfilename nodepos)
943 (setq lastfilepos 0))
c5fe2ff1
RS
944 ;; Assume previous buffer is in Info-mode.
945 ;; (set-buffer (get-buffer "*info*"))
a384cab3
JB
946 (or (equal Info-current-subfile lastfilename)
947 (let ((buffer-read-only nil))
948 (setq buffer-file-name nil)
949 (widen)
950 (erase-buffer)
1143a6b0 951 (info-insert-file-contents lastfilename)
a384cab3
JB
952 (set-buffer-modified-p nil)
953 (setq Info-current-subfile lastfilename)))
b0e52598
RS
954 ;; Widen in case we are in the same subfile as before.
955 (widen)
a384cab3 956 (goto-char (point-min))
ba42ce14
EZ
957 (if (looking-at "\^_")
958 (forward-char 1)
959 (search-forward "\n\^_"))
a361deba
RS
960 (if (numberp nodepos)
961 (+ (- nodepos lastfilepos) (point)))))
a384cab3 962
50ac70af
MB
963(defvar Info-header-line nil
964 "If the info node header is hidden, the text of the header.")
965
a384cab3 966(defun Info-select-node ()
fdf4b680
DL
967"Select the info node that point is in.
968Bind this in case the user sets it to nil."
1bcedb3b
RS
969 (let ((case-fold-search t))
970 (save-excursion
760d5cb3
GM
971 ;; Find beginning of node.
972 (if (search-backward "\n\^_" nil 'move)
973 (forward-line 2)
974 (if (looking-at "\^_")
975 (forward-line 1)
976 (signal 'search-failed (list "\n\^_"))))
977 ;; Get nodename spelled as it is in the node.
978 (re-search-forward "Node:[ \t]*")
979 (setq Info-current-node
980 (buffer-substring-no-properties (point)
981 (progn
982 (skip-chars-forward "^,\t\n")
983 (point))))
984 (Info-set-mode-line)
985 ;; Find the end of it, and narrow.
986 (beginning-of-line)
987 (let (active-expression)
50ac70af 988 ;; Narrow to the node contents
760d5cb3
GM
989 (narrow-to-region (point)
990 (if (re-search-forward "\n[\^_\f]" nil t)
991 (prog1
992 (1- (point))
993 (if (looking-at "[\n\^_\f]*execute: ")
994 (progn
995 (goto-char (match-end 0))
996 (setq active-expression
997 (read (current-buffer))))))
998 (point-max)))
999 (if Info-enable-active-nodes (eval active-expression))
1000 (if Info-fontify (Info-fontify-node))
50ac70af
MB
1001 (if Info-use-header-line
1002 (Info-setup-header-line)
1003 (setq Info-header-line nil))
760d5cb3 1004 (run-hooks 'Info-selection-hook)))))
a384cab3
JB
1005
1006(defun Info-set-mode-line ()
1007 (setq mode-line-buffer-identification
313fe58a 1008 (nconc (propertized-buffer-identification "%b")
918e364a
MB
1009 (list
1010 (concat " ("
1011 (file-name-nondirectory
1012 (if (stringp Info-current-file)
1013 Info-current-file
1014 (or buffer-file-name "")))
1015 ") "
1016 (or Info-current-node ""))))))
a384cab3 1017\f
50ac70af
MB
1018;; Skip the node header and make it into a header-line. This function
1019;; should be called when the node is already narrowed.
1020(defun Info-setup-header-line ()
1021 (goto-char (point-min))
6e961dcd
EZ
1022 (let* ((case-fold-search t)
1023 (header-end (save-excursion (forward-line 1) (1- (point))))
1024 ;; If we find neither Next: nor Prev: link, show the entire
1025 ;; node header. Otherwise, don't show the File: and Node:
1026 ;; parts, to avoid wasting precious space on information that
1027 ;; is available in the mode line.
1028 (header-beg (if (re-search-forward
1029 "\\(next\\|prev[ious]*\\): "
1030 header-end t)
1031 (match-beginning 1)
1032 (point))))
1033 (set (make-local-variable 'Info-header-line)
1034 (buffer-substring header-beg header-end))
1035 (setq header-line-format 'Info-header-line)
1036 (narrow-to-region (1+ header-end) (point-max))))
50ac70af 1037\f
a384cab3
JB
1038;; Go to an info node specified with a filename-and-nodename string
1039;; of the sort that is found in pointers in nodes.
1040
4fceda3c 1041(defun Info-goto-node (nodename &optional fork)
cfc697a2 1042 "Go to info node named NODENAME. Give just NODENAME or (FILENAME)NODENAME.
dc414be1
EZ
1043If NODENAME is of the form (FILENAME)NODENAME, the node is in the Info file
1044FILENAME; otherwise, NODENAME should be in the current Info file (or one of
1045its sub-files).
1046Completion is available, but only for node names in the current Info file.
7210b6f5
DL
1047If FORK is non-nil (interactively with a prefix arg), show the node in
1048a new info buffer.
4fceda3c 1049If FORK is a string, it is the name to use for the new buffer."
d1268e52 1050 (interactive (list (Info-read-node-name "Go to node: ") current-prefix-arg))
d0e41cba 1051 (info-initialize)
4fceda3c 1052 (if fork
760d5cb3
GM
1053 (set-buffer
1054 (clone-buffer (concat "*info-" (if (stringp fork) fork nodename) "*") t)))
a384cab3
JB
1055 (let (filename)
1056 (string-match "\\s *\\((\\s *\\([^\t)]*\\)\\s *)\\s *\\|\\)\\(.*\\)"
1057 nodename)
1058 (setq filename (if (= (match-beginning 1) (match-end 1))
1059 ""
1060 (substring nodename (match-beginning 2) (match-end 2)))
1061 nodename (substring nodename (match-beginning 3) (match-end 3)))
1062 (let ((trim (string-match "\\s *\\'" filename)))
1063 (if trim (setq filename (substring filename 0 trim))))
1064 (let ((trim (string-match "\\s *\\'" nodename)))
1065 (if trim (setq nodename (substring nodename 0 trim))))
e579232c 1066 (if transient-mark-mode (deactivate-mark))
a384cab3
JB
1067 (Info-find-node (if (equal filename "") nil filename)
1068 (if (equal nodename "") "Top" nodename))))
552775bd 1069
ddf89211
RS
1070(defvar Info-read-node-completion-table)
1071
03524be6 1072;; This function is used as the "completion table" while reading a node name.
ddf89211 1073;; It does completion using the alist in Info-read-node-completion-table
03524be6
RS
1074;; unless STRING starts with an open-paren.
1075(defun Info-read-node-name-1 (string predicate code)
1076 (let ((no-completion (and (> (length string) 0) (eq (aref string 0) ?\())))
1077 (cond ((eq code nil)
1078 (if no-completion
1079 string
ddf89211 1080 (try-completion string Info-read-node-completion-table predicate)))
03524be6
RS
1081 ((eq code t)
1082 (if no-completion
1083 nil
ddf89211 1084 (all-completions string Info-read-node-completion-table predicate)))
03524be6
RS
1085 ((eq code 'lambda)
1086 (if no-completion
1087 t
ddf89211 1088 (assoc string Info-read-node-completion-table))))))
03524be6 1089
552775bd
RS
1090(defun Info-read-node-name (prompt &optional default)
1091 (let* ((completion-ignore-case t)
ddf89211 1092 (Info-read-node-completion-table (Info-build-node-completions))
b6d61ffa 1093 (nodename (completing-read prompt 'Info-read-node-name-1 nil t)))
552775bd
RS
1094 (if (equal nodename "")
1095 (or default
1096 (Info-read-node-name prompt))
1097 nodename)))
1098
1099(defun Info-build-node-completions ()
1100 (or Info-current-file-completions
1bcedb3b
RS
1101 (let ((compl nil)
1102 ;; Bind this in case the user sets it to nil.
11638562
EZ
1103 (case-fold-search t)
1104 (node-regexp "Node: *\\([^,\n]*\\) *[,\n\t]"))
552775bd
RS
1105 (save-excursion
1106 (save-restriction
1107 (if (marker-buffer Info-tag-table-marker)
c5fe2ff1
RS
1108 (let ((marker Info-tag-table-marker))
1109 (set-buffer (marker-buffer marker))
cedb118c 1110 (widen)
c5fe2ff1 1111 (goto-char marker)
fdf4b680 1112 (while (re-search-forward "\n\\(Node\\|Ref\\): \\(.*\\)\177" nil t)
552775bd 1113 (setq compl
fdf4b680 1114 (cons (list (match-string-no-properties 2))
552775bd
RS
1115 compl))))
1116 (widen)
1117 (goto-char (point-min))
11638562
EZ
1118 ;; If the buffer begins with a node header, process that first.
1119 (if (Info-node-at-bob-matching node-regexp)
110d4e80 1120 (setq compl (list (match-string-no-properties 1))))
11638562 1121 ;; Now for the rest of the nodes.
552775bd
RS
1122 (while (search-forward "\n\^_" nil t)
1123 (forward-line 1)
1124 (let ((beg (point)))
1125 (forward-line 1)
11638562 1126 (if (re-search-backward node-regexp beg t)
399c88ad 1127 (setq compl
110d4e80 1128 (cons (list (match-string-no-properties 1))
552775bd 1129 compl))))))))
87d2b5a2 1130 (setq compl (cons '("*") compl))
07b1b912 1131 (set (make-local-variable 'Info-current-file-completions) compl))))
a384cab3 1132\f
aea2a8da
JB
1133(defun Info-restore-point (hl)
1134 "If this node has been visited, restore the point value when we left."
cedb118c
RS
1135 (while hl
1136 (if (and (equal (nth 0 (car hl)) Info-current-file)
e90d1271
RS
1137 ;; Use string-equal, not equal, to ignore text props.
1138 (string-equal (nth 1 (car hl)) Info-current-node))
cedb118c 1139 (progn
d96504df
KH
1140 (goto-char (nth 2 (car hl)))
1141 (setq hl nil)) ;terminate the while at next iter
cedb118c 1142 (setq hl (cdr hl)))))
aea2a8da 1143\f
2c80a618
GM
1144(defvar Info-search-history nil
1145 "The history list for `Info-search'.")
a384cab3
JB
1146
1147(defun Info-search (regexp)
1148 "Search for REGEXP, starting from point, and select node it's found in."
bbc96600
EZ
1149 (interactive (list (read-string
1150 (if Info-search-history
1151 (format "Regexp search (default `%s'): "
1152 (car Info-search-history))
1153 "Regexp search: ")
1154 nil 'Info-search-history)))
2c80a618
GM
1155 (when transient-mark-mode
1156 (deactivate-mark))
1157 (when (equal regexp "")
1158 (setq regexp (car Info-search-history)))
c47b5bbe
DL
1159 (when regexp
1160 (let ((found ()) current
1161 (onode Info-current-node)
1162 (ofile Info-current-file)
1163 (opoint (point))
1164 (ostart (window-start))
1165 (osubfile Info-current-subfile))
1166 (save-excursion
1167 (save-restriction
1168 (widen)
1169 (if (null Info-current-subfile)
a384cab3 1170 (progn (re-search-forward regexp) (setq found (point)))
c47b5bbe
DL
1171 (condition-case err
1172 (progn (re-search-forward regexp) (setq found (point)))
1173 (search-failed nil)))))
760d5cb3 1174 (if (not found) ;can only happen in subfile case -- else would have erred
c47b5bbe
DL
1175 (unwind-protect
1176 (let ((list ()))
1177 (save-excursion
1178 (set-buffer (marker-buffer Info-tag-table-marker))
c5fe2ff1 1179 (goto-char (point-min))
c47b5bbe
DL
1180 (search-forward "\n\^_\nIndirect:")
1181 (save-restriction
1182 (narrow-to-region (point)
1183 (progn (search-forward "\n\^_")
1184 (1- (point))))
1185 (goto-char (point-min))
1186 (search-forward (concat "\n" osubfile ": "))
1187 (beginning-of-line)
1188 (while (not (eobp))
1189 (re-search-forward "\\(^.*\\): [0-9]+$")
1190 (goto-char (+ (match-end 1) 2))
1191 (setq list (cons (cons (read (current-buffer))
110d4e80 1192 (match-string-no-properties 1))
c47b5bbe
DL
1193 list))
1194 (goto-char (1+ (match-end 0))))
1195 (setq list (nreverse list)
1196 current (car (car list))
1197 list (cdr list))))
1198 (while list
1199 (message "Searching subfile %s..." (cdr (car list)))
1200 (Info-read-subfile (car (car list)))
1201 (setq list (cdr list))
c47b5bbe
DL
1202 (if (re-search-forward regexp nil t)
1203 (setq found (point) list ())))
1204 (if found
1205 (message "")
1206 (signal 'search-failed (list regexp))))
1207 (if (not found)
1208 (progn (Info-read-subfile osubfile)
1209 (goto-char opoint)
1210 (Info-select-node)
1211 (set-window-start (selected-window) ostart)))))
760d5cb3
GM
1212 (widen)
1213 (goto-char found)
1214 (Info-select-node)
1215 ;; Use string-equal, not equal, to ignore text props.
1216 (or (and (string-equal onode Info-current-node)
1217 (equal ofile Info-current-file))
1218 (setq Info-history (cons (list ofile onode opoint)
1219 Info-history))))))
a384cab3 1220\f
a384cab3 1221(defun Info-extract-pointer (name &optional errorname)
fdf4b680
DL
1222 "Extract the value of the node-pointer named NAME.
1223If there is none, use ERRORNAME in the error message;
1224if ERRORNAME is nil, just return nil.
1225Bind this in case the user sets it to nil."
1bcedb3b
RS
1226 (let ((case-fold-search t))
1227 (save-excursion
50ac70af
MB
1228 (save-restriction
1229 (goto-char (point-min))
1230 (when Info-header-line
1231 ;; expose the header line in the buffer
c1699282
SM
1232 (widen)
1233 (forward-line -1))
50ac70af
MB
1234 (let ((bound (point)))
1235 (forward-line 1)
c1699282 1236 (cond ((re-search-backward (concat name ":") bound t)
0cb39153
MB
1237 (goto-char (match-end 0))
1238 (Info-following-node-name))
50ac70af
MB
1239 ((not (eq errorname t))
1240 (error "Node has no %s"
1241 (capitalize (or errorname name))))))))))
a384cab3
JB
1242
1243(defun Info-following-node-name (&optional allowedchars)
fdf4b680
DL
1244 "Return the node name in the buffer following point.
1245ALLOWEDCHARS, if non-nil, goes within [...] to make a regexp
1246saying which chars may appear in the node name."
a384cab3 1247 (skip-chars-forward " \t")
70d78eb6 1248 (buffer-substring-no-properties
a384cab3
JB
1249 (point)
1250 (progn
1251 (while (looking-at (concat "[" (or allowedchars "^,\t\n") "]"))
1252 (skip-chars-forward (concat (or allowedchars "^,\t\n") "("))
1253 (if (looking-at "(")
1254 (skip-chars-forward "^)")))
1255 (skip-chars-backward " ")
1256 (point))))
1257
1258(defun Info-next ()
1259 "Go to the next node of this node."
1260 (interactive)
1261 (Info-goto-node (Info-extract-pointer "next")))
1262
1263(defun Info-prev ()
1264 "Go to the previous node of this node."
1265 (interactive)
1266 (Info-goto-node (Info-extract-pointer "prev[ious]*" "previous")))
1267
5dab2fb4
RS
1268(defun Info-up (&optional same-file)
1269 "Go to the superior node of this node.
1270If SAME-FILE is non-nil, do not move to a different Info file."
a384cab3 1271 (interactive)
5dab2fb4 1272 (let ((node (Info-extract-pointer "up")))
4fceda3c 1273 (and (or same-file (not (stringp Info-current-file)))
5dab2fb4
RS
1274 (string-match "^(" node)
1275 (error "Up node is in another Info file"))
1276 (Info-goto-node node))
aea2a8da 1277 (Info-restore-point Info-history))
a384cab3
JB
1278
1279(defun Info-last ()
1280 "Go back to the last node visited."
1281 (interactive)
1282 (or Info-history
1283 (error "This is the first Info node you looked at"))
1284 (let (filename nodename opoint)
1285 (setq filename (car (car Info-history)))
1286 (setq nodename (car (cdr (car Info-history))))
1287 (setq opoint (car (cdr (cdr (car Info-history)))))
1288 (setq Info-history (cdr Info-history))
1289 (Info-find-node filename nodename)
1290 (setq Info-history (cdr Info-history))
1291 (goto-char opoint)))
1292
48e5b471 1293;;;###autoload
a384cab3
JB
1294(defun Info-directory ()
1295 "Go to the Info directory node."
1296 (interactive)
1297 (Info-find-node "dir" "top"))
1298\f
1299(defun Info-follow-reference (footnotename)
fdf4b680
DL
1300 "Follow cross reference named FOOTNOTENAME to the node it refers to.
1301FOOTNOTENAME may be an abbreviation of the reference name."
a384cab3
JB
1302 (interactive
1303 (let ((completion-ignore-case t)
1bcedb3b 1304 (case-fold-search t)
67bc89ab 1305 completions default alt-default (start-point (point)) str i bol eol)
a384cab3 1306 (save-excursion
67bc89ab
RS
1307 ;; Store end and beginning of line.
1308 (end-of-line)
1309 (setq eol (point))
1310 (beginning-of-line)
1311 (setq bol (point))
1312
a384cab3
JB
1313 (goto-char (point-min))
1314 (while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t)
110d4e80 1315 (setq str (buffer-substring-no-properties
a384cab3
JB
1316 (match-beginning 1)
1317 (1- (point))))
1318 ;; See if this one should be the default.
1319 (and (null default)
1f179e27 1320 (<= (match-beginning 0) start-point)
a384cab3
JB
1321 (<= start-point (point))
1322 (setq default t))
67bc89ab
RS
1323 ;; See if this one should be the alternate default.
1324 (and (null alt-default)
1325 (and (<= bol (match-beginning 0))
1326 (<= (point) eol))
1327 (setq alt-default t))
a384cab3
JB
1328 (setq i 0)
1329 (while (setq i (string-match "[ \n\t]+" str i))
1330 (setq str (concat (substring str 0 i) " "
1331 (substring str (match-end 0))))
1332 (setq i (1+ i)))
1333 ;; Record as a completion and perhaps as default.
1334 (if (eq default t) (setq default str))
67bc89ab 1335 (if (eq alt-default t) (setq alt-default str))
ec6d29af
KH
1336 ;; Don't add this string if it's a duplicate.
1337 ;; We use a loop instead of "(assoc str completions)" because
1338 ;; we want to do a case-insensitive compare.
1339 (let ((tail completions)
1340 (tem (downcase str)))
1341 (while (and tail
1342 (not (string-equal tem (downcase (car (car tail))))))
1343 (setq tail (cdr tail)))
1344 (or tail
1345 (setq completions
1346 (cons (cons str nil)
1347 completions))))))
67bc89ab
RS
1348 ;; If no good default was found, try an alternate.
1349 (or default
1350 (setq default alt-default))
1351 ;; If only one cross-reference found, then make it default.
1352 (if (eq (length completions) 1)
1353 (setq default (car (car completions))))
a384cab3 1354 (if completions
b0ebdfe5
RS
1355 (let ((input (completing-read (if default
1356 (concat "Follow reference named: ("
1357 default ") ")
1358 "Follow reference named: ")
1359 completions nil t)))
1360 (list (if (equal input "")
1361 default input)))
a384cab3 1362 (error "No cross-references in this node"))))
ebf8f7e1
RS
1363
1364 (unless footnotename
1365 (error "No reference was specified"))
1366
1bcedb3b
RS
1367 (let (target beg i (str (concat "\\*note " (regexp-quote footnotename)))
1368 (case-fold-search t))
a384cab3
JB
1369 (while (setq i (string-match " " str i))
1370 (setq str (concat (substring str 0 i) "[ \t\n]+" (substring str (1+ i))))
1371 (setq i (+ i 6)))
1372 (save-excursion
1373 (goto-char (point-min))
1374 (or (re-search-forward str nil t)
1375 (error "No cross-reference named %s" footnotename))
1376 (goto-char (+ (match-beginning 0) 5))
1377 (setq target
1378 (Info-extract-menu-node-name "Bad format cross reference" t)))
1379 (while (setq i (string-match "[ \t\n]+" target i))
1380 (setq target (concat (substring target 0 i) " "
1381 (substring target (match-end 0))))
1382 (setq i (+ i 1)))
1383 (Info-goto-node target)))
1384
1385(defun Info-extract-menu-node-name (&optional errmessage multi-line)
1386 (skip-chars-forward " \t\n")
1387 (let ((beg (point))
1388 str i)
1389 (skip-chars-forward "^:")
1390 (forward-char 1)
1391 (setq str
1392 (if (looking-at ":")
70d78eb6 1393 (buffer-substring-no-properties beg (1- (point)))
a384cab3
JB
1394 (skip-chars-forward " \t\n")
1395 (Info-following-node-name (if multi-line "^.,\t" "^.,\t\n"))))
1396 (while (setq i (string-match "\n" str i))
1397 (aset str i ?\ ))
2e52ff59
RS
1398 ;; Collapse multiple spaces.
1399 (while (string-match " +" str)
1400 (setq str (replace-match " " t t str)))
a384cab3
JB
1401 str))
1402
e8adde3f 1403;; No one calls this.
9e5c2f50
RS
1404;;(defun Info-menu-item-sequence (list)
1405;; (while list
e8adde3f 1406;; (Info-menu (car list))
9e5c2f50 1407;; (setq list (cdr list))))
a384cab3 1408
6356e646
RS
1409(defvar Info-complete-menu-buffer)
1410
e8adde3f 1411(defun Info-complete-menu-item (string predicate action)
760d5cb3
GM
1412 (let ((completion-ignore-case t)
1413 (case-fold-search t))
e8adde3f
RS
1414 (cond ((eq action nil)
1415 (let (completions
b37daea4 1416 (pattern (concat "\n\\* +\\("
e8adde3f
RS
1417 (regexp-quote string)
1418 "[^:\t\n]*\\):")))
1419 (save-excursion
1420 (set-buffer Info-complete-menu-buffer)
1421 (goto-char (point-min))
763da090 1422 (search-forward "\n* Menu:")
e8adde3f 1423 (while (re-search-forward pattern nil t)
110d4e80
DL
1424 (setq completions
1425 (cons (cons (match-string-no-properties 1)
1426 (match-beginning 1))
1427 completions))))
e8adde3f
RS
1428 (try-completion string completions predicate)))
1429 ((eq action t)
1430 (let (completions
b37daea4 1431 (pattern (concat "\n\\* +\\("
e8adde3f
RS
1432 (regexp-quote string)
1433 "[^:\t\n]*\\):")))
1434 (save-excursion
1435 (set-buffer Info-complete-menu-buffer)
1436 (goto-char (point-min))
763da090 1437 (search-forward "\n* Menu:")
e8adde3f 1438 (while (re-search-forward pattern nil t)
110d4e80
DL
1439 (setq completions (cons (cons
1440 (match-string-no-properties 1)
1441 (match-beginning 1))
e8adde3f
RS
1442 completions))))
1443 (all-completions string completions predicate)))
1444 (t
1445 (save-excursion
1446 (set-buffer Info-complete-menu-buffer)
1447 (goto-char (point-min))
763da090 1448 (search-forward "\n* Menu:")
b37daea4 1449 (re-search-forward (concat "\n\\* +"
e8adde3f
RS
1450 (regexp-quote string)
1451 ":")
1452 nil t))))))
1453
1454
4fceda3c 1455(defun Info-menu (menu-item &optional fork)
dc414be1
EZ
1456 "Go to the node pointed to by the menu item named (or abbreviated) MENU-ITEM.
1457The menu item should one of those listed in the current node's menu.
1458Completion is allowed, and the default menu item is the one point is on.
7210b6f5
DL
1459If FORK is non-nil (interactively with a prefix arg), show the node in
1460a new info buffer. If FORK is a string, it is the name to use for the
1461new buffer."
a384cab3
JB
1462 (interactive
1463 (let ((completions '())
1464 ;; If point is within a menu item, use that item as the default
1465 (default nil)
1466 (p (point))
211d6309 1467 beg
760d5cb3
GM
1468 (last nil)
1469 (case-fold-search t))
a384cab3
JB
1470 (save-excursion
1471 (goto-char (point-min))
1472 (if (not (search-forward "\n* menu:" nil t))
1473 (error "No menu in this node"))
e8adde3f
RS
1474 (setq beg (point))
1475 (and (< (point) p)
1476 (save-excursion
1477 (goto-char p)
1478 (end-of-line)
4fc14e5a 1479 (if (re-search-backward "\n\\* +\\([^:\t\n]*\\):" beg t)
110d4e80 1480 (setq default (match-string-no-properties 1))))))
a384cab3
JB
1481 (let ((item nil))
1482 (while (null item)
e8adde3f
RS
1483 (setq item (let ((completion-ignore-case t)
1484 (Info-complete-menu-buffer (current-buffer)))
a384cab3
JB
1485 (completing-read (if default
1486 (format "Menu item (default %s): "
1487 default)
760d5cb3 1488 "Menu item: ")
e8adde3f 1489 'Info-complete-menu-item nil t)))
aea2a8da
JB
1490 ;; we rely on the fact that completing-read accepts an input
1491 ;; of "" even when the require-match argument is true and ""
1492 ;; is not a valid possibility
a384cab3
JB
1493 (if (string= item "")
1494 (if default
1495 (setq item default)
760d5cb3
GM
1496 ;; ask again
1497 (setq item nil))))
4fceda3c 1498 (list item current-prefix-arg))))
a384cab3
JB
1499 ;; there is a problem here in that if several menu items have the same
1500 ;; name you can only go to the node of the first with this command.
4fceda3c 1501 (Info-goto-node (Info-extract-menu-item menu-item) (if fork menu-item)))
399c88ad 1502
a384cab3
JB
1503(defun Info-extract-menu-item (menu-item)
1504 (setq menu-item (regexp-quote menu-item))
1bcedb3b
RS
1505 (let ((case-fold-search t))
1506 (save-excursion
760d5cb3
GM
1507 (let ((case-fold-search t))
1508 (goto-char (point-min))
1509 (or (search-forward "\n* menu:" nil t)
1510 (error "No menu in this node"))
1511 (or (re-search-forward (concat "\n\\* +" menu-item ":") nil t)
1512 (re-search-forward (concat "\n\\* +" menu-item) nil t)
1513 (error "No such item in menu"))
1514 (beginning-of-line)
1515 (forward-char 2)
1516 (Info-extract-menu-node-name)))))
a384cab3
JB
1517
1518;; If COUNT is nil, use the last item in the menu.
1519(defun Info-extract-menu-counting (count)
1bcedb3b
RS
1520 (let ((case-fold-search t))
1521 (save-excursion
760d5cb3
GM
1522 (let ((case-fold-search t))
1523 (goto-char (point-min))
1524 (or (search-forward "\n* menu:" nil t)
1525 (error "No menu in this node"))
1526 (if count
1527 (or (search-forward "\n* " nil t count)
1528 (error "Too few items in menu"))
1529 (while (search-forward "\n* " nil t)
1530 nil))
1531 (Info-extract-menu-node-name)))))
a384cab3 1532
e38e7367
RM
1533(defun Info-nth-menu-item ()
1534 "Go to the node of the Nth menu item.
1535N is the digit argument used to invoke this command."
a384cab3 1536 (interactive)
e38e7367
RM
1537 (Info-goto-node
1538 (Info-extract-menu-counting
1539 (- (aref (this-command-keys) (1- (length (this-command-keys)))) ?0))))
a384cab3
JB
1540
1541(defun Info-top-node ()
1542 "Go to the Top node of this file."
1543 (interactive)
1544 (Info-goto-node "Top"))
1545
1546(defun Info-final-node ()
1547 "Go to the final node in this file."
1548 (interactive)
1549 (Info-goto-node "Top")
760d5cb3
GM
1550 (let ((Info-history nil)
1551 (case-fold-search t))
a384cab3
JB
1552 ;; Go to the last node in the menu of Top.
1553 (Info-goto-node (Info-extract-menu-counting nil))
1554 ;; If the last node in the menu is not last in pointer structure,
399c88ad 1555 ;; move forward until we can't go any farther.
a384cab3
JB
1556 (while (Info-forward-node t t) nil)
1557 ;; Then keep moving down to last subnode, unless we reach an index.
1558 (while (and (not (string-match "\\<index\\>" Info-current-node))
1559 (save-excursion (search-forward "\n* Menu:" nil t)))
1560 (Info-goto-node (Info-extract-menu-counting nil)))))
1561
1562(defun Info-forward-node (&optional not-down no-error)
1563 "Go forward one node, considering all nodes as forming one sequence."
1564 (interactive)
1565 (goto-char (point-min))
1566 (forward-line 1)
760d5cb3
GM
1567 (let ((case-fold-search t))
1568 ;; three possibilities, in order of priority:
1569 ;; 1. next node is in a menu in this node (but not in an index)
1570 ;; 2. next node is next at same level
1571 ;; 3. next node is up and next
1572 (cond ((and (not not-down)
1573 (save-excursion (search-forward "\n* menu:" nil t))
1574 (not (string-match "\\<index\\>" Info-current-node)))
1575 (Info-goto-node (Info-extract-menu-counting 1))
1576 t)
b24e84ab
EZ
1577 ((save-excursion
1578 (save-restriction
1579 (let (limit)
1580 (when Info-header-line
1581 (goto-char (point-min))
1582 (widen)
1583 (forward-line -1)
1584 (setq limit (point))
1585 (forward-line 1))
1586 (search-backward "next:" limit t))))
760d5cb3
GM
1587 (Info-next)
1588 t)
b24e84ab
EZ
1589 ((and (save-excursion
1590 (save-restriction
1591 (let (limit)
1592 (when Info-header-line
1593 (goto-char (point-min))
1594 (widen)
1595 (forward-line -1)
1596 (setq limit (point))
1597 (forward-line 1))
1598 (search-backward "up:" limit t))))
760d5cb3
GM
1599 ;; Use string-equal, not equal, to ignore text props.
1600 (not (string-equal (downcase (Info-extract-pointer "up"))
1601 "top")))
1602 (let ((old-node Info-current-node))
1603 (Info-up)
1604 (let (Info-history success)
1605 (unwind-protect
1606 (setq success (Info-forward-node t no-error))
1607 (or success (Info-goto-node old-node))))))
1608 (no-error nil)
1609 (t (error "No pointer forward from this node")))))
a384cab3
JB
1610
1611(defun Info-backward-node ()
1612 "Go backward one node, considering all nodes as forming one sequence."
1613 (interactive)
1614 (let ((prevnode (Info-extract-pointer "prev[ious]*" t))
760d5cb3
GM
1615 (upnode (Info-extract-pointer "up" t))
1616 (case-fold-search t))
a384cab3
JB
1617 (cond ((and upnode (string-match "(" upnode))
1618 (error "First node in file"))
1619 ((and upnode (or (null prevnode)
e90d1271
RS
1620 ;; Use string-equal, not equal,
1621 ;; to ignore text properties.
1622 (string-equal (downcase prevnode)
1623 (downcase upnode))))
a384cab3
JB
1624 (Info-up))
1625 (prevnode
1626 ;; If we move back at the same level,
1627 ;; go down to find the last subnode*.
1628 (Info-prev)
1629 (let (Info-history)
1630 (while (and (not (string-match "\\<index\\>" Info-current-node))
1631 (save-excursion (search-forward "\n* Menu:" nil t)))
1632 (Info-goto-node (Info-extract-menu-counting nil)))))
1633 (t
1634 (error "No pointer backward from this node")))))
1635
1636(defun Info-exit ()
1637 "Exit Info by selecting some other buffer."
1638 (interactive)
552775bd
RS
1639 (if Info-standalone
1640 (save-buffers-kill-emacs)
4643e92f 1641 (quit-window)))
a384cab3 1642
253db917
ER
1643(defun Info-next-menu-item ()
1644 (interactive)
fdf4b680 1645 ;; Bind this in case the user sets it to nil.
760d5cb3
GM
1646 (let* ((case-fold-search t)
1647 (node
1648 (save-excursion
1649 (forward-line -1)
1650 (search-forward "\n* menu:" nil t)
1651 (and (search-forward "\n* " nil t)
1652 (Info-extract-menu-node-name)))))
fadfb77f
RS
1653 (if node (Info-goto-node node)
1654 (error "No more items in menu"))))
253db917
ER
1655
1656(defun Info-last-menu-item ()
1657 (interactive)
1658 (save-excursion
1659 (forward-line 1)
fdf4b680 1660 ;; Bind this in case the user sets it to nil.
760d5cb3
GM
1661 (let* ((case-fold-search t)
1662 (beg (save-excursion
1663 (and (search-backward "\n* menu:" nil t)
1664 (point)))))
0a56332b
RS
1665 (or (and beg (search-backward "\n* " beg t))
1666 (error "No previous items in menu")))
1667 (Info-goto-node (save-excursion
1668 (goto-char (match-end 0))
1669 (Info-extract-menu-node-name)))))
253db917 1670
552775bd 1671(defmacro Info-no-error (&rest body)
253db917
ER
1672 (list 'condition-case nil (cons 'progn (append body '(t))) '(error nil)))
1673
1674(defun Info-next-preorder ()
3c9179ea
RS
1675 "Go to the next subnode or the next node, or go up a level."
1676 (interactive)
1677 (cond ((Info-no-error (Info-next-menu-item)))
1678 ((Info-no-error (Info-next)))
5dab2fb4 1679 ((Info-no-error (Info-up t))
ed690657
KH
1680 ;; Since we have already gone thru all the items in this menu,
1681 ;; go up to the end of this node.
b54d0f0e
RS
1682 (goto-char (point-max))
1683 ;; Since logically we are done with the node with that menu,
1684 ;; move on from it.
1685 (Info-next-preorder))
3c9179ea
RS
1686 (t
1687 (error "No more nodes"))))
253db917
ER
1688
1689(defun Info-last-preorder ()
1690 "Go to the last node, popping up a level if there is none."
1691 (interactive)
0a56332b
RS
1692 (cond ((Info-no-error
1693 (Info-last-menu-item)
1694 ;; If we go down a menu item, go to the end of the node
1695 ;; so we can scroll back through it.
ed690657 1696 (goto-char (point-max)))
b54d0f0e
RS
1697 ;; Keep going down, as long as there are nested menu nodes.
1698 (while (Info-no-error
1699 (Info-last-menu-item)
1700 ;; If we go down a menu item, go to the end of the node
1701 ;; so we can scroll back through it.
1702 (goto-char (point-max))))
ed690657 1703 (recenter -1))
c2def7a0
MB
1704 ((and (Info-no-error (Info-extract-pointer "prev"))
1705 (not (equal (Info-extract-pointer "up")
5dab2fb4
RS
1706 (Info-extract-pointer "prev"))))
1707 (Info-no-error (Info-prev))
ed690657 1708 (goto-char (point-max))
b54d0f0e
RS
1709 (while (Info-no-error
1710 (Info-last-menu-item)
1711 ;; If we go down a menu item, go to the end of the node
1712 ;; so we can scroll back through it.
1713 (goto-char (point-max))))
ed690657 1714 (recenter -1))
5dab2fb4 1715 ((Info-no-error (Info-up t))
ed690657 1716 (goto-char (point-min))
760d5cb3
GM
1717 (let ((case-fold-search t))
1718 (or (search-forward "\n* Menu:" nil t)
1719 (goto-char (point-max)))))
ed690657 1720 (t (error "No previous nodes"))))
253db917
ER
1721
1722(defun Info-scroll-up ()
3f32dc86 1723 "Scroll one screenful forward in Info, considering all nodes as one sequence.
280d11ed 1724Once you scroll far enough in a node that its menu appears on the screen
7a53d8c8
EZ
1725but after point, the next scroll moves into its first subnode, unless
1726`Info-scroll-prefer-subnodes' is nil.
280d11ed 1727
7a53d8c8
EZ
1728When you scroll past the end of a node, that goes to the next node if
1729`Info-scroll-prefer-subnodes' is non-nil and to the first subnode otherwise;
1730if this node has no successor, it moves to the parent node's successor,
1731and so on. If `Info-scroll-prefer-subnodes' is non-nil and point is inside
1732the menu of a node, it moves to subnode indicated by the following menu
1733item. (That case won't normally result from this command, but can happen
1734in other ways.)"
280d11ed 1735
253db917 1736 (interactive)
0a56332b
RS
1737 (if (or (< (window-start) (point-min))
1738 (> (window-start) (point-max)))
1739 (set-window-start (selected-window) (point)))
760d5cb3
GM
1740 (let* ((case-fold-search t)
1741 (virtual-end (save-excursion
1742 (goto-char (point-min))
7a53d8c8
EZ
1743 (if (and Info-scroll-prefer-subnodes
1744 (search-forward "\n* Menu:" nil t))
760d5cb3
GM
1745 (point)
1746 (point-max)))))
0a56332b
RS
1747 (if (or (< virtual-end (window-start))
1748 (pos-visible-in-window-p virtual-end))
7a53d8c8
EZ
1749 (cond
1750 (Info-scroll-prefer-subnodes (Info-next-preorder))
1751 ((Info-no-error (Info-goto-node (Info-extract-menu-counting 1))))
1752 (t (Info-next-preorder)))
0a56332b 1753 (scroll-up))))
253db917
ER
1754
1755(defun Info-scroll-down ()
3f32dc86 1756 "Scroll one screenful back in Info, considering all nodes as one sequence.
c2def7a0
MB
1757If point is within the menu of a node, and `Info-scroll-prefer-subnodes'
1758is non-nil, this goes to its last subnode. When you scroll past the
1759beginning of a node, that goes to the previous node or back up to the
1760parent node."
253db917 1761 (interactive)
0a56332b
RS
1762 (if (or (< (window-start) (point-min))
1763 (> (window-start) (point-max)))
1764 (set-window-start (selected-window) (point)))
760d5cb3
GM
1765 (let* ((case-fold-search t)
1766 (current-point (point))
c2def7a0
MB
1767 (virtual-end
1768 (and Info-scroll-prefer-subnodes
1769 (save-excursion
1770 (beginning-of-line)
1771 (setq current-point (point))
1772 (goto-char (point-min))
1773 (search-forward "\n* Menu:"
1774 current-point
1775 t)))))
5b3ebb44 1776 (if (or virtual-end
7afe24e3 1777 (pos-visible-in-window-p (point-min) nil t))
0a56332b
RS
1778 (Info-last-preorder)
1779 (scroll-down))))
253db917 1780
56cda6f5 1781(defun Info-next-reference (&optional recur)
552775bd
RS
1782 "Move cursor to the next cross-reference or menu item in the node."
1783 (interactive)
1784 (let ((pat "\\*note[ \n\t]*\\([^:]*\\):\\|^\\* .*:")
1bcedb3b
RS
1785 (old-pt (point))
1786 (case-fold-search t))
552775bd
RS
1787 (or (eobp) (forward-char 1))
1788 (or (re-search-forward pat nil t)
1789 (progn
1790 (goto-char (point-min))
1791 (or (re-search-forward pat nil t)
1792 (progn
1793 (goto-char old-pt)
1794 (error "No cross references in this node")))))
1795 (goto-char (match-beginning 0))
1796 (if (looking-at "\\* Menu:")
56cda6f5
RS
1797 (if recur
1798 (error "No cross references in this node")
1799 (Info-next-reference t)))))
552775bd 1800
56cda6f5 1801(defun Info-prev-reference (&optional recur)
552775bd
RS
1802 "Move cursor to the previous cross-reference or menu item in the node."
1803 (interactive)
1804 (let ((pat "\\*note[ \n\t]*\\([^:]*\\):\\|^\\* .*:")
1bcedb3b
RS
1805 (old-pt (point))
1806 (case-fold-search t))
552775bd
RS
1807 (or (re-search-backward pat nil t)
1808 (progn
1809 (goto-char (point-max))
1810 (or (re-search-backward pat nil t)
1811 (progn
1812 (goto-char old-pt)
1813 (error "No cross references in this node")))))
1814 (goto-char (match-beginning 0))
1815 (if (looking-at "\\* Menu:")
56cda6f5
RS
1816 (if recur
1817 (error "No cross references in this node")
1818 (Info-prev-reference t)))))
552775bd 1819
1143a6b0 1820(defun Info-index (topic)
fdf4b680 1821 "Look up a string TOPIC in the index for this file.
1143a6b0
ER
1822The index is defined as the first node in the top-level menu whose
1823name contains the word \"Index\", plus any immediately following
1824nodes whose names also contain the word \"Index\".
1825If there are no exact matches to the specified topic, this chooses
1826the first match which is a case-insensitive substring of a topic.
1827Use the `,' command to see the other matches.
1828Give a blank topic name to go to the Index node itself."
1829 (interactive "sIndex topic: ")
1830 (let ((orignode Info-current-node)
1831 (rnode nil)
b37daea4 1832 (pattern (format "\n\\* +\\([^\n:]*%s[^\n:]*\\):[ \t]*\\([^.\n]*\\)\\.[ \t]*\\([0-9]*\\)"
1143a6b0 1833 (regexp-quote topic)))
1bcedb3b
RS
1834 node
1835 (case-fold-search t))
1143a6b0
ER
1836 (Info-goto-node "Top")
1837 (or (search-forward "\n* menu:" nil t)
1838 (error "No index"))
1839 (or (re-search-forward "\n\\* \\(.*\\<Index\\>\\)" nil t)
1840 (error "No index"))
1841 (goto-char (match-beginning 1))
c696ac76
RS
1842 ;; Here, and subsequently in this function,
1843 ;; we bind Info-history to nil for internal node-switches
1844 ;; so that we don't put junk in the history.
1845 ;; In the first Info-goto-node call, above, we do update the history
1846 ;; because that is what the user's previous node choice into it.
1847 (let ((Info-history nil))
1143a6b0
ER
1848 (Info-goto-node (Info-extract-menu-node-name)))
1849 (or (equal topic "")
1850 (let ((matches nil)
1851 (exact nil)
c696ac76 1852 (Info-history nil)
1143a6b0
ER
1853 found)
1854 (while
1855 (progn
1856 (goto-char (point-min))
1857 (while (re-search-forward pattern nil t)
983dfbf8
SM
1858 (push (list (match-string-no-properties 1)
1859 (match-string-no-properties 2)
1860 Info-current-node
1861 (string-to-int (concat "0"
1862 (match-string 3))))
1863 matches))
1143a6b0
ER
1864 (and (setq node (Info-extract-pointer "next" t))
1865 (string-match "\\<Index\\>" node)))
1866 (Info-goto-node node))
1867 (or matches
1868 (progn
81e14cb2 1869 (Info-goto-node orignode)
920bdaab 1870 (error "No `%s' in index" topic)))
1143a6b0
ER
1871 ;; Here it is a feature that assoc is case-sensitive.
1872 (while (setq found (assoc topic matches))
1873 (setq exact (cons found exact)
1874 matches (delq found matches)))
1875 (setq Info-index-alternatives (nconc exact (nreverse matches)))
1876 (Info-index-next 0)))))
1877
1878(defun Info-index-next (num)
1879 "Go to the next matching index item from the last `i' command."
1880 (interactive "p")
1881 (or Info-index-alternatives
882e61bf 1882 (error "No previous `i' command"))
1143a6b0
ER
1883 (while (< num 0)
1884 (setq num (+ num (length Info-index-alternatives))))
1885 (while (> num 0)
1886 (setq Info-index-alternatives
1887 (nconc (cdr Info-index-alternatives)
1888 (list (car Info-index-alternatives)))
1889 num (1- num)))
1890 (Info-goto-node (nth 1 (car Info-index-alternatives)))
1891 (if (> (nth 3 (car Info-index-alternatives)) 0)
1892 (forward-line (nth 3 (car Info-index-alternatives)))
760d5cb3 1893 (forward-line 3) ; don't search in headers
1143a6b0 1894 (let ((name (car (car Info-index-alternatives))))
920bdaab
RS
1895 (Info-find-index-name name)))
1896 (message "Found `%s' in %s. %s"
1143a6b0
ER
1897 (car (car Info-index-alternatives))
1898 (nth 2 (car Info-index-alternatives))
1899 (if (cdr Info-index-alternatives)
1900 "(Press `,' for more)"
1901 "(Only match)")))
1902
920bdaab
RS
1903(defun Info-find-index-name (name)
1904 "Move point to the place within the current node where NAME is defined."
1bcedb3b
RS
1905 (let ((case-fold-search t))
1906 (if (or (re-search-forward (format
1907 "[a-zA-Z]+: %s\\( \\|$\\)"
1908 (regexp-quote name)) nil t)
1909 (search-forward (format "`%s'" name) nil t)
1910 (and (string-match "\\`.*\\( (.*)\\)\\'" name)
1911 (search-forward
1912 (format "`%s'" (substring name 0 (match-beginning 1)))
1913 nil t))
1914 (search-forward name nil t))
1915 (beginning-of-line)
1916 (goto-char (point-min)))))
920bdaab 1917
a384cab3
JB
1918(defun Info-undefined ()
1919 "Make command be undefined in Info."
1920 (interactive)
1921 (ding))
1922
1923(defun Info-help ()
1924 "Enter the Info tutorial."
1925 (interactive)
1926 (delete-other-windows)
1927 (Info-find-node "info"
1928 (if (< (window-height) 23)
1929 "Help-Small-Screen"
1930 "Help")))
1931
1932(defun Info-summary ()
1933 "Display a brief summary of all Info commands."
1934 (interactive)
1935 (save-window-excursion
1936 (switch-to-buffer "*Help*")
881c84c7 1937 (setq buffer-read-only nil)
a384cab3
JB
1938 (erase-buffer)
1939 (insert (documentation 'Info-mode))
9d29f94c 1940 (help-mode)
a384cab3
JB
1941 (goto-char (point-min))
1942 (let (ch flag)
1943 (while (progn (setq flag (not (pos-visible-in-window-p (point-max))))
1944 (message (if flag "Type Space to see more"
1945 "Type Space to return to Info"))
1614c867 1946 (if (not (eq ?\ (setq ch (read-event))))
dbc4e1c1 1947 (progn (setq unread-command-events (list ch)) nil)
a384cab3 1948 flag))
552775bd
RS
1949 (scroll-up)))
1950 (bury-buffer "*Help*")))
a384cab3
JB
1951\f
1952(defun Info-get-token (pos start all &optional errorstring)
fdf4b680 1953 "Return the token around POS.
a384cab3
JB
1954POS must be somewhere inside the token
1955START is a regular expression which will match the
1956 beginning of the tokens delimited string
1957ALL is a regular expression with a single
90a715f0 1958 parenthesized subpattern which is the token to be
fdf4b680 1959 returned. E.g. '{\(.*\)}' would return any string
a384cab3 1960 enclosed in braces around POS.
fdf4b680 1961ERRORSTRING optional fourth argument, controls action on no match
a384cab3
JB
1962 nil: return nil
1963 t: beep
1964 a string: signal an error, using that string."
1bcedb3b
RS
1965 (let ((case-fold-search t))
1966 (save-excursion
1967 (goto-char pos)
1968 ;; First look for a match for START that goes across POS.
1969 (while (and (not (bobp)) (> (point) (- pos (length start)))
1970 (not (looking-at start)))
1971 (forward-char -1))
1972 ;; If we did not find one, search back for START
1973 ;; (this finds only matches that end at or before POS).
1974 (or (looking-at start)
1975 (progn
1976 (goto-char pos)
1977 (re-search-backward start (max (point-min) (- pos 200)) 'yes)))
1978 (let (found)
1979 (while (and (re-search-forward all (min (point-max) (+ pos 200)) 'yes)
1980 (not (setq found (and (<= (match-beginning 0) pos)
1981 (> (match-end 0) pos))))))
1982 (if (and found (<= (match-beginning 0) pos)
1983 (> (match-end 0) pos))
110d4e80 1984 (match-string-no-properties 1)
1bcedb3b
RS
1985 (cond ((null errorstring)
1986 nil)
1987 ((eq errorstring t)
1988 (beep)
1989 nil)
1990 (t
1991 (error "No %s around position %d" errorstring pos))))))))
a384cab3 1992
981947af 1993(defun Info-mouse-follow-nearest-node (click)
f9969361
RS
1994 "\\<Info-mode-map>Follow a node reference near point.
1995Like \\[Info-menu], \\[Info-follow-reference], \\[Info-next], \\[Info-prev] or \\[Info-up] command, depending on where you click.
981947af 1996At end of the node's text, moves to the next node, or up if none."
f9969361 1997 (interactive "e")
d1268e52 1998 (mouse-set-point click)
981947af
KH
1999 (and (not (Info-try-follow-nearest-node))
2000 (save-excursion (forward-line 1) (eobp))
ed690657 2001 (Info-next-preorder)))
981947af
KH
2002
2003(defun Info-follow-nearest-node ()
2004 "\\<Info-mode-map>Follow a node reference near point.
2005Like \\[Info-menu], \\[Info-follow-reference], \\[Info-next], \\[Info-prev] or \\[Info-up] command, depending on where point is.
2006If no reference to follow, moves to the next node, or up if none."
2007 (interactive)
2008 (or (Info-try-follow-nearest-node)
ed690657 2009 (Info-next-preorder)))
981947af
KH
2010
2011;; Common subroutine.
2012(defun Info-try-follow-nearest-node ()
2013 "Follow a node reference near point. Return non-nil if successful."
a384cab3
JB
2014 (let (node)
2015 (cond
981947af
KH
2016 ((setq node (Info-get-token (point) "\\*note[ \n]"
2017 "\\*note[ \n]\\([^:]*\\):"))
a384cab3 2018 (Info-follow-reference node))
b37daea4 2019 ((setq node (Info-get-token (point) "\\* +" "\\* +\\([^:]*\\)::"))
a384cab3 2020 (Info-goto-node node))
631ba13e
RS
2021 ((Info-get-token (point) "\\* +" "\\* +\\([^:]*\\):")
2022 (beginning-of-line)
2023 (forward-char 2)
2024 (setq node (Info-extract-menu-node-name))
2025 (Info-goto-node node))
bc2ada62 2026 ((setq node (Info-get-token (point) "Up: " "Up: \\([^,\n\t]*\\)"))
a384cab3 2027 (Info-goto-node node))
bc2ada62 2028 ((setq node (Info-get-token (point) "Next: " "Next: \\([^,\n\t]*\\)"))
a384cab3 2029 (Info-goto-node node))
bc2ada62 2030 ((setq node (Info-get-token (point) "File: " "File: \\([^,\n\t]*\\)"))
a384cab3 2031 (Info-goto-node "Top"))
bc2ada62 2032 ((setq node (Info-get-token (point) "Prev: " "Prev: \\([^,\n\t]*\\)"))
981947af
KH
2033 (Info-goto-node node)))
2034 node))
a384cab3
JB
2035\f
2036(defvar Info-mode-map nil
2037 "Keymap containing Info commands.")
2038(if Info-mode-map
2039 nil
2040 (setq Info-mode-map (make-keymap))
2041 (suppress-keymap Info-mode-map)
2042 (define-key Info-mode-map "." 'beginning-of-buffer)
253db917 2043 (define-key Info-mode-map " " 'Info-scroll-up)
981947af 2044 (define-key Info-mode-map "\C-m" 'Info-follow-nearest-node)
552775bd
RS
2045 (define-key Info-mode-map "\t" 'Info-next-reference)
2046 (define-key Info-mode-map "\e\t" 'Info-prev-reference)
e38e7367
RM
2047 (define-key Info-mode-map "1" 'Info-nth-menu-item)
2048 (define-key Info-mode-map "2" 'Info-nth-menu-item)
2049 (define-key Info-mode-map "3" 'Info-nth-menu-item)
2050 (define-key Info-mode-map "4" 'Info-nth-menu-item)
2051 (define-key Info-mode-map "5" 'Info-nth-menu-item)
2052 (define-key Info-mode-map "6" 'Info-nth-menu-item)
2053 (define-key Info-mode-map "7" 'Info-nth-menu-item)
2054 (define-key Info-mode-map "8" 'Info-nth-menu-item)
2055 (define-key Info-mode-map "9" 'Info-nth-menu-item)
82a4c008 2056 (define-key Info-mode-map "0" 'undefined)
a384cab3
JB
2057 (define-key Info-mode-map "?" 'Info-summary)
2058 (define-key Info-mode-map "]" 'Info-forward-node)
2059 (define-key Info-mode-map "[" 'Info-backward-node)
2060 (define-key Info-mode-map "<" 'Info-top-node)
2061 (define-key Info-mode-map ">" 'Info-final-node)
2062 (define-key Info-mode-map "b" 'beginning-of-buffer)
2063 (define-key Info-mode-map "d" 'Info-directory)
2064 (define-key Info-mode-map "e" 'Info-edit)
2065 (define-key Info-mode-map "f" 'Info-follow-reference)
2066 (define-key Info-mode-map "g" 'Info-goto-node)
2067 (define-key Info-mode-map "h" 'Info-help)
1143a6b0 2068 (define-key Info-mode-map "i" 'Info-index)
a384cab3
JB
2069 (define-key Info-mode-map "l" 'Info-last)
2070 (define-key Info-mode-map "m" 'Info-menu)
2071 (define-key Info-mode-map "n" 'Info-next)
2072 (define-key Info-mode-map "p" 'Info-prev)
2073 (define-key Info-mode-map "q" 'Info-exit)
2074 (define-key Info-mode-map "s" 'Info-search)
47fc33ca
RS
2075 ;; For consistency with Rmail.
2076 (define-key Info-mode-map "\M-s" 'Info-search)
4fceda3c 2077 (define-key Info-mode-map "\M-n" 'clone-buffer)
db0c9809 2078 (define-key Info-mode-map "t" 'Info-top-node)
a384cab3 2079 (define-key Info-mode-map "u" 'Info-up)
1143a6b0 2080 (define-key Info-mode-map "," 'Info-index-next)
803eaf50 2081 (define-key Info-mode-map "\177" 'Info-scroll-down)
981947af 2082 (define-key Info-mode-map [mouse-2] 'Info-mouse-follow-nearest-node)
aea2a8da 2083 )
75a209d4
RS
2084
2085(defun Info-check-pointer (item)
fdf4b680 2086 "Non-nil if ITEM is present in this node."
75a209d4
RS
2087 (condition-case nil
2088 (Info-extract-pointer item)
2089 (error nil)))
2090
d4af987a
DL
2091(easy-menu-define
2092 Info-mode-menu Info-mode-map
2093 "Menu for info files."
2094 '("Info"
2095 ["Up" Info-up :active (Info-check-pointer "up")
2096 :help "Go up in the Info tree"]
2097 ["Next" Info-next :active (Info-check-pointer "next")
2098 :help "Go to the next node"]
2099 ["Previous" Info-prev :active (Info-check-pointer "prev[ious]*")
2100 :help "Go to the previous node"]
2101 ["Backward" Info-backward-node
2102 :help "Go backward one node, considering all as a sequence"]
2103 ["Forward" Info-forward-node
2104 :help "Go forward one node, considering all as a sequence"]
7210b6f5
DL
2105 ["Beginning" beginning-of-buffer
2106 :help "Go to beginning of this node"]
d4af987a
DL
2107 ["Top" Info-top-node
2108 :help "Go to top node of file"]
2109 ["Final Node" Info-final-node
2110 :help "Go to final node in this file"]
2111 ("Menu Item" ["You should never see this" report-emacs-bug t])
2112 ("Reference" ["You should never see this" report-emacs-bug t])
2113 ["Search..." Info-search
2114 :help "Search for regular expression in this Info file"]
d1268e52 2115 ["Go to Node..." Info-goto-node
d4af987a 2116 :help "Go to a named node"]
ec03f31e 2117 ["Last" Info-last :active Info-history
d4af987a
DL
2118 :help "Go to the last node you were at"]
2119 ("Index..."
2120 ["Lookup a String" Info-index
2121 :help "Look for a string in the index items"]
2122 ["Next Matching Item" Info-index-next
2123 :help "Look for another occurrence of previous item"])
7210b6f5
DL
2124 ["Edit" Info-edit :help "Edit contents of this node"
2125 :active Info-enable-edit]
126f5d4d
MB
2126 ["Copy Node Name" Info-copy-current-node-name
2127 :help "Copy the name of the current node into the kill ring"]
ec03f31e 2128 ["Exit" Info-exit :help "Stop reading Info"]))
75a209d4 2129
7210b6f5
DL
2130
2131(defvar info-tool-bar-map
2132 (if (display-graphic-p)
2133 (let ((tool-bar-map (make-sparse-keymap)))
2134 (tool-bar-add-item-from-menu 'Info-exit "close" Info-mode-map)
2135 (tool-bar-add-item-from-menu 'Info-prev "left_arrow" Info-mode-map)
2136 (tool-bar-add-item-from-menu 'Info-next "right_arrow" Info-mode-map)
2137 (tool-bar-add-item-from-menu 'Info-up "up_arrow" Info-mode-map)
ec03f31e 2138 (tool-bar-add-item-from-menu 'Info-last "undo" Info-mode-map)
7210b6f5
DL
2139 (tool-bar-add-item-from-menu 'Info-top-node "home" Info-mode-map)
2140 (tool-bar-add-item-from-menu 'Info-index "index" Info-mode-map)
2141 (tool-bar-add-item-from-menu 'Info-goto-node "jump_to" Info-mode-map)
2142 (tool-bar-add-item-from-menu 'Info-search "search" Info-mode-map)
2143 tool-bar-map)))
2144
75a209d4
RS
2145(defvar Info-menu-last-node nil)
2146;; Last node the menu was created for.
6d2c8e3e 2147;; Value is a list, (FILE-NAME NODE-NAME).
75a209d4
RS
2148
2149(defun Info-menu-update ()
fdf4b680 2150 "Update the Info menu for the current node."
75a209d4
RS
2151 (condition-case nil
2152 (if (or (not (eq major-mode 'Info-mode))
6d2c8e3e
RS
2153 (equal (list Info-current-file Info-current-node)
2154 Info-menu-last-node))
75a209d4
RS
2155 ()
2156 ;; Update menu menu.
2157 (let* ((Info-complete-menu-buffer (current-buffer))
2158 (items (nreverse (condition-case nil
2159 (Info-complete-menu-item
2160 "" (lambda (e) t) t)
2161 (error nil))))
399c88ad 2162 entries current
75a209d4
RS
2163 (number 0))
2164 (while (and items (< number 9))
2165 (setq current (car items)
2166 items (cdr items)
2167 number (1+ number))
399c88ad 2168 (setq entries (cons `[,current
75a209d4
RS
2169 (Info-menu ,current)
2170 :keys ,(format "%d" number)]
2171 entries)))
2172 (if items
2173 (setq entries (cons ["Other..." Info-menu t] entries)))
2174 (or entries
5d5845dc 2175 (setq entries (list ["No menu" nil nil] nil :active)))
d4af987a 2176 (easy-menu-change '("Info") "Menu Item" (nreverse entries)))
75a209d4
RS
2177 ;; Update reference menu. Code stolen from `Info-follow-reference'.
2178 (let ((items nil)
399c88ad 2179 str i entries current
1bcedb3b
RS
2180 (number 0)
2181 (case-fold-search t))
75a209d4
RS
2182 (save-excursion
2183 (goto-char (point-min))
2184 (while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t)
2185 (setq str (buffer-substring
2186 (match-beginning 1)
2187 (1- (point))))
2188 (setq i 0)
2189 (while (setq i (string-match "[ \n\t]+" str i))
2190 (setq str (concat (substring str 0 i) " "
2191 (substring str (match-end 0))))
2192 (setq i (1+ i)))
2193 (setq items
2194 (cons str items))))
2195 (while (and items (< number 9))
2196 (setq current (car items)
2197 items (cdr items)
2198 number (1+ number))
399c88ad 2199 (setq entries (cons `[,current
75a209d4
RS
2200 (Info-follow-reference ,current)
2201 t]
2202 entries)))
2203 (if items
2204 (setq entries (cons ["Other..." Info-follow-reference t]
2205 entries)))
2206 (or entries
5d5845dc 2207 (setq entries (list ["No references" nil nil] nil :active)))
75a209d4
RS
2208 (easy-menu-change '("Info") "Reference" (nreverse entries)))
2209 ;; Update last seen node.
6d2c8e3e 2210 (setq Info-menu-last-node (list Info-current-file Info-current-node)))
75a209d4
RS
2211 ;; Try to avoid entering infinite beep mode in case of errors.
2212 (error (ding))))
2213
a384cab3 2214\f
126f5d4d
MB
2215(defun Info-copy-current-node-name ()
2216 "Put the name of the current info node into the kill ring.
2217The name of the info file is prepended to the node name in parentheses."
2218 (interactive)
2219 (unless Info-current-node
2220 (error "No current info node"))
2221 (kill-new
2222 (concat "("
2223 (file-name-nondirectory
2224 (if (stringp Info-current-file)
2225 Info-current-file
2226 (or buffer-file-name "")))
2227 ")"
2228 Info-current-node)))
2229
2230\f
a384cab3 2231;; Info mode is suitable only for specially formatted data.
68bc119c 2232(put 'Info-mode 'mode-class 'special)
a384cab3
JB
2233
2234(defun Info-mode ()
fdf4b680 2235 "Info mode provides commands for browsing through the Info documentation tree.
a384cab3
JB
2236Documentation in Info is divided into \"nodes\", each of which discusses
2237one topic and contains references to other nodes which discuss related
2238topics. Info has commands to follow the references and show you other nodes.
2239
fdf4b680 2240\\<Info-mode-map>\
a384cab3 2241\\[Info-help] Invoke the Info tutorial.
6b136ab9 2242\\[Info-exit] Quit Info: reselect previously selected buffer.
a384cab3
JB
2243
2244Selecting other nodes:
21d5959f
RS
2245\\[Info-mouse-follow-nearest-node]
2246 Follow a node reference you click on.
2247 This works with menu items, cross references, and
2248 the \"next\", \"previous\" and \"up\", depending on where you click.
6b136ab9 2249\\[Info-follow-nearest-node] Follow a node reference near point, like \\[Info-mouse-follow-nearest-node].
a384cab3 2250\\[Info-next] Move to the \"next\" node of this node.
bc2ada62 2251\\[Info-prev] Move to the \"previous\" node of this node.
a384cab3
JB
2252\\[Info-up] Move \"up\" from this node.
2253\\[Info-menu] Pick menu item specified by name (or abbreviation).
2254 Picking a menu item causes another node to be selected.
aea2a8da 2255\\[Info-directory] Go to the Info directory node.
a384cab3
JB
2256\\[Info-follow-reference] Follow a cross reference. Reads name of reference.
2257\\[Info-last] Move to the last node you were at.
1143a6b0
ER
2258\\[Info-index] Look up a topic in this file's Index and move to that node.
2259\\[Info-index-next] (comma) Move to the next match from a previous `i' command.
6b136ab9
DL
2260\\[Info-top-node] Go to the Top node of this file.
2261\\[Info-final-node] Go to the final node in this file.
2262\\[Info-backward-node] Go backward one node, considering all nodes as forming one sequence.
2263\\[Info-forward-node] Go forward one node, considering all nodes as forming one sequence.
a384cab3
JB
2264
2265Moving within a node:
177c3549
RS
2266\\[Info-scroll-up] Normally, scroll forward a full screen.
2267Once you scroll far enough in a node that its menu appears on the screen
2268but after point, the next scroll moves into its first subnode.
2269When after all menu items (or if their is no menu), move up to
2270the parent node.
2271\\[Info-scroll-down] Normally, scroll backward. If the beginning of the buffer is
803eaf50 2272already visible, try to go to the previous menu entry, or up if there is none.
399c88ad 2273\\[beginning-of-buffer] Go to beginning of node.
a384cab3 2274
a384cab3
JB
2275Advanced commands:
2276\\[Info-exit] Quit Info: reselect previously selected buffer.
2277\\[Info-edit] Edit contents of selected node.
22781 Pick first item in node's menu.
22792, 3, 4, 5 Pick second ... fifth item in node's menu.
2280\\[Info-goto-node] Move to node specified by name.
2281 You may include a filename as well, as (FILENAME)NODENAME.
552775bd 2282\\[universal-argument] \\[info] Move to new Info file with completion.
a384cab3 2283\\[Info-search] Search through this Info file for specified regexp,
803eaf50 2284 and select the node in which the next occurrence is found.
552775bd
RS
2285\\[Info-next-reference] Move cursor to next cross-reference or menu item.
2286\\[Info-prev-reference] Move cursor to previous cross-reference or menu item."
a384cab3
JB
2287 (kill-all-local-variables)
2288 (setq major-mode 'Info-mode)
2289 (setq mode-name "Info")
f73299f3 2290 (setq tab-width 8)
a384cab3 2291 (use-local-map Info-mode-map)
75a209d4 2292 (add-hook 'activate-menubar-hook 'Info-menu-update nil t)
a384cab3
JB
2293 (set-syntax-table text-mode-syntax-table)
2294 (setq local-abbrev-table text-mode-abbrev-table)
2295 (setq case-fold-search t)
2296 (setq buffer-read-only t)
a384cab3
JB
2297 (make-local-variable 'Info-current-file)
2298 (make-local-variable 'Info-current-subfile)
2299 (make-local-variable 'Info-current-node)
2300 (make-local-variable 'Info-tag-table-marker)
c5fe2ff1
RS
2301 (setq Info-tag-table-marker (make-marker))
2302 (make-local-variable 'Info-tag-table-buffer)
2303 (setq Info-tag-table-buffer nil)
a384cab3 2304 (make-local-variable 'Info-history)
1143a6b0 2305 (make-local-variable 'Info-index-alternatives)
7210b6f5 2306 (set (make-local-variable 'tool-bar-map) info-tool-bar-map)
93480d70
RS
2307 ;; This is for the sake of the invisible text we use handling titles.
2308 (make-local-variable 'line-move-ignore-invisible)
2309 (setq line-move-ignore-invisible t)
b7aeabeb 2310 (add-hook 'clone-buffer-hook 'Info-clone-buffer-hook nil t)
a384cab3
JB
2311 (Info-set-mode-line)
2312 (run-hooks 'Info-mode-hook))
2313
4fceda3c
SM
2314(defun Info-clone-buffer-hook ()
2315 (when (bufferp Info-tag-table-buffer)
2316 (setq Info-tag-table-buffer
4ce5c223
SM
2317 (with-current-buffer Info-tag-table-buffer (clone-buffer))))
2318 (let ((m Info-tag-table-marker))
2319 (when (markerp m)
15533ae2 2320 (setq Info-tag-table-marker
4ce5c223 2321 (if (and (marker-position m) (bufferp Info-tag-table-buffer))
15533ae2
SM
2322 (with-current-buffer Info-tag-table-buffer
2323 (copy-marker (marker-position m)))
2324 (make-marker))))))
4fceda3c 2325
7210b6f5
DL
2326(defvar Info-edit-map (let ((map (make-sparse-keymap)))
2327 (set-keymap-parent map text-mode-map)
2328 (define-key map "\C-c\C-c" 'Info-cease-edit)
2329 map)
a384cab3 2330 "Local keymap used within `e' command of Info.")
a384cab3
JB
2331
2332;; Info-edit mode is suitable only for specially formatted data.
68bc119c 2333(put 'Info-edit-mode 'mode-class 'special)
a384cab3
JB
2334
2335(defun Info-edit-mode ()
2336 "Major mode for editing the contents of an Info node.
a426b157 2337Like text mode with the addition of `Info-cease-edit'
a384cab3
JB
2338which returns to Info mode for browsing.
2339\\{Info-edit-map}"
a384cab3
JB
2340 (use-local-map Info-edit-map)
2341 (setq major-mode 'Info-edit-mode)
2342 (setq mode-name "Info Edit")
2343 (kill-local-variable 'mode-line-buffer-identification)
2344 (setq buffer-read-only nil)
2c609f53 2345 (force-mode-line-update)
e82c28f9
KH
2346 (buffer-enable-undo (current-buffer))
2347 (run-hooks 'Info-edit-mode-hook))
2348
2349(defun Info-edit ()
2350 "Edit the contents of this Info node.
2351Allowed only if variable `Info-enable-edit' is non-nil."
2352 (interactive)
2353 (or Info-enable-edit
2354 (error "Editing info nodes is not enabled"))
2355 (Info-edit-mode)
8ab3e50b 2356 (message "%s" (substitute-command-keys
760d5cb3 2357 "Editing: Type \\<Info-edit-map>\\[Info-cease-edit] to return to info")))
a384cab3
JB
2358
2359(defun Info-cease-edit ()
2360 "Finish editing Info node; switch back to Info proper."
2361 (interactive)
2362 ;; Do this first, so nothing has changed if user C-g's at query.
2363 (and (buffer-modified-p)
2364 (y-or-n-p "Save the file? ")
2365 (save-buffer))
2366 (use-local-map Info-mode-map)
2367 (setq major-mode 'Info-mode)
2368 (setq mode-name "Info")
2369 (Info-set-mode-line)
2370 (setq buffer-read-only t)
2c609f53 2371 (force-mode-line-update)
a384cab3
JB
2372 (and (marker-position Info-tag-table-marker)
2373 (buffer-modified-p)
2374 (message "Tags may have changed. Use Info-tagify if necessary")))
f0a8a3f1 2375\f
f88ab1c9 2376(defvar Info-file-list-for-emacs
906b3163
EZ
2377 '("ediff" "eudc" "forms" "gnus" "info" ("mh" . "mh-e")
2378 "sc" "message" ("dired" . "dired-x") "viper" "vip" "idlwave"
2379 ("c" . "ccmode") ("c++" . "ccmode") ("objc" . "ccmode")
2380 ("java" . "ccmode") ("idl" . "ccmode") ("pike" . "ccmode")
af718538
EZ
2381 ("skeleton" . "autotype") ("auto-insert" . "autotype")
2382 ("copyright" . "autotype") ("executable" . "autotype")
2383 ("time-stamp" . "autotype") ("quickurl" . "autotype")
2384 ("tempo" . "autotype") ("hippie-expand" . "autotype")
906b3163
EZ
2385 ("cvs" . "pcl-cvs") ("ada" . "ada-mode")
2386 "ebrowse" "eshell" "cl" "reftex" "speedbar" "widget" "woman"
2387 ("mail-header" . "emacs-mime") ("mail-content" . "emacs-mime")
2388 ("mail-encode" . "emacs-mime") ("mail-decode" . "emacs-mime")
2389 ("rfc2045" . "emacs-mime")
2390 ("rfc2231" . "emacs-mime") ("rfc2047" . "emacs-mime")
2391 ("rfc2045" . "emacs-mime") ("rfc1843" . "emacs-mime")
2392 ("ietf-drums" . "emacs-mime") ("quoted-printable" . "emacs-mime")
2393 ("binhex" . "emacs-mime") ("uudecode" . "emacs-mime")
2394 ("mailcap" . "emacs-mime") ("mm" . "emacs-mime")
2395 ("mml" . "emacs-mime"))
f88ab1c9
RS
2396 "List of Info files that describe Emacs commands.
2397An element can be a file name, or a list of the form (PREFIX . FILE)
2398where PREFIX is a name prefix and FILE is the file to look in.
2399If the element is just a file name, the file name also serves as the prefix.")
2400
f0a8a3f1 2401(defun Info-find-emacs-command-nodes (command)
f88ab1c9 2402 "Return a list of locations documenting COMMAND.
f57b2cd8
RS
2403The `info-file' property of COMMAND says which Info manual to search.
2404If COMMAND has no property, the variable `Info-file-list-for-emacs'
2405defines heuristics for which Info manual to try.
fdf4b680 2406The locations are of the format used in `Info-history', i.e.
f0a8a3f1 2407\(FILENAME NODENAME BUFFERPOS\)."
f0a8a3f1 2408 (let ((where '())
b37daea4 2409 (cmd-desc (concat "^\\* +" (regexp-quote (symbol-name command))
218c2cc7 2410 "\\( <[0-9]+>\\)?:\\s *\\(.*\\)\\.$"))
f88ab1c9
RS
2411 (info-file "emacs")) ;default
2412 ;; Determine which info file this command is documented in.
2413 (if (get command 'info-file)
2414 (setq info-file (get command 'info-file))
2415 ;; If it doesn't say explicitly, test its name against
2416 ;; various prefixes that we know.
2417 (let ((file-list Info-file-list-for-emacs))
2418 (while file-list
2419 (let* ((elt (car file-list))
2420 (name (if (consp elt)
2421 (car elt)
2422 elt))
2423 (file (if (consp elt) (cdr elt) elt))
f57b2cd8 2424 (regexp (concat "\\`" (regexp-quote name)
f88ab1c9
RS
2425 "\\(\\'\\|-\\)")))
2426 (if (string-match regexp (symbol-name command))
2427 (setq info-file file file-list nil))
2428 (setq file-list (cdr file-list))))))
218c2cc7
EZ
2429 (Info-find-node info-file "Top")
2430 (or (and (search-forward "\n* menu:" nil t)
2431 (re-search-forward "\n\\* \\(.*\\<Index\\>\\)" nil t))
2432 (error "Info file `%s' appears to lack an index" info-file))
2433 (goto-char (match-beginning 1))
2434 ;; Bind Info-history to nil, to prevent the index nodes from
2435 ;; getting into the node history.
2436 (let ((Info-history nil)
2437 (exact nil)
2438 node found)
2439 (Info-goto-node (Info-extract-menu-node-name))
2440 (while
2441 (progn
2442 (goto-char (point-min))
2443 (while (re-search-forward cmd-desc nil t)
2444 (setq where
2445 (cons (list Info-current-file
2446 (match-string-no-properties 2)
760d5cb3
GM
2447 0)
2448 where)))
218c2cc7
EZ
2449 (and (setq node (Info-extract-pointer "next" t))
2450 (string-match "\\<Index\\>" node)))
2451 (Info-goto-node node)))
2452 where))
f0a8a3f1
RM
2453
2454;;;###autoload
2455(defun Info-goto-emacs-command-node (command)
e0568e86 2456 "Go to the Info node in the Emacs manual for command COMMAND.
30db89f9 2457The command is found by looking up in Emacs manual's indices
f57b2cd8
RS
2458or in another manual found via COMMAND's `info-file' property or
2459the variable `Info-file-list-for-emacs'."
f0a8a3f1
RM
2460 (interactive "CFind documentation for command: ")
2461 (or (commandp command)
2462 (signal 'wrong-type-argument (list 'commandp command)))
2463 (let ((where (Info-find-emacs-command-nodes command)))
2464 (if where
2465 (let ((num-matches (length where)))
2466 ;; Get Info running, and pop to it in another window.
2467 (save-window-excursion
2468 (info))
c5fe2ff1
RS
2469 ;; FIXME It would be cool if this could use a buffer other
2470 ;; than *info*.
f0a8a3f1 2471 (pop-to-buffer "*info*")
218c2cc7
EZ
2472 ;; Bind Info-history to nil, to prevent the last Index node
2473 ;; visited by Info-find-emacs-command-nodes from being
2474 ;; pushed onto the history.
2475 (let ((Info-history nil))
2476 (Info-find-node (car (car where))
2477 (car (cdr (car where)))))
f0a8a3f1
RM
2478 (if (> num-matches 1)
2479 (progn
218c2cc7
EZ
2480 ;; (car where) will be pushed onto Info-history
2481 ;; when/if they go to another node. Put the other
2482 ;; nodes that were found on the history.
f0a8a3f1 2483 (setq Info-history (nconc (cdr where) Info-history))
8ab3e50b 2484 (message "Found %d other entr%s. Use %s to see %s."
cedb118c
RS
2485 (1- num-matches)
2486 (if (> num-matches 2) "ies" "y")
8ab3e50b 2487 (substitute-command-keys "\\[Info-last]")
cedb118c 2488 (if (> num-matches 2) "them" "it")))))
e9b81433 2489 (error "Couldn't find documentation for %s" command))))
f0a8a3f1
RM
2490
2491;;;###autoload
2492(defun Info-goto-emacs-key-command-node (key)
30db89f9
EZ
2493 "Go to the node in the Emacs manual which describes the command bound to KEY.
2494KEY is a string.
fdf4b680 2495Interactively, if the binding is `execute-extended-command', a command is read.
30db89f9 2496The command is found by looking up in Emacs manual's indices
f57b2cd8
RS
2497or in another manual found via COMMAND's `info-file' property or
2498the variable `Info-file-list-for-emacs'."
ea33749b 2499 (interactive "kFind documentation for key: ")
f0a8a3f1
RM
2500 (let ((command (key-binding key)))
2501 (cond ((null command)
9e5c2f50 2502 (message "%s is undefined" (key-description key)))
f0a8a3f1
RM
2503 ((and (interactive-p)
2504 (eq command 'execute-extended-command))
2505 (Info-goto-emacs-command-node
2506 (read-command "Find documentation for command: ")))
2507 (t
2508 (Info-goto-emacs-command-node command)))))
552775bd 2509\f
bbed5c3f 2510(defface Info-title-1-face
b250866f 2511 '((((type tty pc) (class color)) (:foreground "yellow" :weight bold))
333cd59e 2512 (t (:height 1.2 :inherit Info-title-2-face)))
bbed5c3f
GM
2513 "Face for Info titles at level 1."
2514 :group 'info)
2515
2516(defface Info-title-2-face
b250866f 2517 '((((type tty pc) (class color)) (:foreground "lightblue" :weight bold))
333cd59e 2518 (t (:height 1.2 :inherit Info-title-3-face)))
bbed5c3f
GM
2519 "Face for Info titles at level 2."
2520 :group 'info)
2521
2522(defface Info-title-3-face
b250866f 2523 '((((type tty pc) (class color)) (:weight bold))
a8b883c2 2524 (t (:height 1.2 :inherit Info-title-4-face)))
bbed5c3f
GM
2525 "Face for Info titles at level 3."
2526 :group 'info)
2527
a8b883c2
MB
2528(defface Info-title-4-face
2529 '((((type tty pc) (class color)) (:weight bold))
2530 (t (:weight bold :inherit variable-pitch)))
2531 "Face for Info titles at level 4."
2532 :group 'info)
2533
973a3104
MB
2534(defface info-menu-header
2535 '((((type tty pc))
42121c23
SZ
2536 :underline t
2537 :weight bold)
973a3104 2538 (t
42121c23
SZ
2539 :inherit variable-pitch
2540 :weight bold))
973a3104
MB
2541 "Face for headers in Info menus."
2542 :group 'info)
2543
2544(defun Info-fontify-menu-headers ()
2545 "Add the face `info-menu-header' to any header before a menu entry."
2546 (save-excursion
2547 (goto-char (point-min))
2548 (when (re-search-forward "\\* Menu:" nil t)
2549 (put-text-property (match-beginning 0) (match-end 0)
2550 'face 'info-menu-header)
2551 (while (re-search-forward "\n\n\\([^*\n ].*\\)\n\n?[*]" nil t)
2552 (put-text-property (match-beginning 1) (match-end 1)
2553 'face 'info-menu-header)))))
2554
552775bd
RS
2555(defun Info-fontify-node ()
2556 (save-excursion
1bcedb3b
RS
2557 (let ((buffer-read-only nil)
2558 (case-fold-search t))
552775bd 2559 (goto-char (point-min))
35d2d241
RS
2560 (when (looking-at "^File: [^,: \t]+,?[ \t]+")
2561 (goto-char (match-end 0))
50ac70af 2562 (while (looking-at "[ \t]*\\([^:, \t\n]+\\):[ \t]+\\([^:,\t\n]+\\),?")
35d2d241 2563 (goto-char (match-end 0))
50ac70af
MB
2564 (let* ((nbeg (match-beginning 2))
2565 (nend (match-end 2))
2566 (tbeg (match-beginning 1))
2567 (tag (buffer-substring tbeg (match-end 1))))
2568 (if (string-equal tag "Node")
2569 (put-text-property nbeg nend 'face 'info-header-node)
2570 (put-text-property nbeg nend 'face 'info-header-xref)
2571 (put-text-property nbeg nend 'mouse-face 'highlight)
2572 (put-text-property tbeg nend
2573 'help-echo
d1268e52 2574 (concat "Go to node "
50ac70af
MB
2575 (buffer-substring nbeg nend)))
2576 (let ((fun (cdr (assoc tag '(("Prev" . Info-prev)
2577 ("Next" . Info-next)
2578 ("Up" . Info-up))))))
2579 (when fun
2580 (let ((keymap (make-sparse-keymap)))
2581 (define-key keymap [header-line mouse-1] fun)
2582 (define-key keymap [header-line mouse-2] fun)
2583 (put-text-property tbeg nend 'local-map keymap))))
2584 ))))
552775bd 2585 (goto-char (point-min))
a8b883c2 2586 (while (re-search-forward "\n\\([^ \t\n].+\\)\n\\(\\*+\\|=+\\|-+\\|\\.+\\)$"
760d5cb3 2587 nil t)
bbed5c3f
GM
2588 (let ((c (preceding-char))
2589 face)
2590 (cond ((= c ?*) (setq face 'Info-title-1-face))
2591 ((= c ?=) (setq face 'Info-title-2-face))
a8b883c2
MB
2592 ((= c ?-) (setq face 'Info-title-3-face))
2593 (t (setq face 'Info-title-4-face)))
bbed5c3f
GM
2594 (put-text-property (match-beginning 1) (match-end 1)
2595 'face face))
93480d70
RS
2596 ;; This is a serious problem for trying to handle multiple
2597 ;; frame types at once. We want this text to be invisible
2598 ;; on frames that can display the font above.
3828218c
GM
2599 (when (memq (framep (selected-frame)) '(x pc w32 mac))
2600 (add-text-properties (match-end 1) (match-end 2)
2601 '(invisible t intangible t))
2602 (add-text-properties (1- (match-end 1)) (match-end 2)
2603 '(intangible t))))
98d8273c 2604 (goto-char (point-min))
7757c476 2605 (while (re-search-forward "\\*Note[ \n\t]+\\([^:]*\\):" nil t)
552775bd
RS
2606 (if (= (char-after (1- (match-beginning 0))) ?\") ; hack
2607 nil
d1268e52
DL
2608 (add-text-properties (match-beginning 1) (match-end 1)
2609 '(face info-xref
2610 mouse-face highlight
2611 help-echo "mouse-2: go to this node"))))
552775bd
RS
2612 (goto-char (point-min))
2613 (if (and (search-forward "\n* Menu:" nil t)
2614 (not (string-match "\\<Index\\>" Info-current-node))
2615 ;; Don't take time to annotate huge menus
34a0a4ee 2616 (< (- (point-max) (point)) Info-fontify-maximum-menu-size))
552775bd 2617 (let ((n 0))
b37daea4 2618 (while (re-search-forward "^\\* +\\([^:\t\n]*\\):" nil t)
552775bd 2619 (setq n (1+ n))
760d5cb3 2620 (if (memq n '(5 9)) ; visual aids to help with 1-9 keys
552775bd
RS
2621 (put-text-property (match-beginning 0)
2622 (1+ (match-beginning 0))
2623 'face 'info-menu-5))
f7902bdc
DL
2624 (add-text-properties (match-beginning 1) (match-end 1)
2625 '(face info-xref
2626 mouse-face highlight
2627 help-echo "mouse-2: go to this node")))))
973a3104 2628 (Info-fontify-menu-headers)
552775bd 2629 (set-buffer-modified-p nil))))
c5fe2ff1
RS
2630\f
2631
2632;; When an Info buffer is killed, make sure the associated tags buffer
2633;; is killed too.
2634(defun Info-kill-buffer ()
2635 (and (eq major-mode 'Info-mode)
2636 Info-tag-table-buffer
2637 (kill-buffer Info-tag-table-buffer)))
2638
2639(add-hook 'kill-buffer-hook 'Info-kill-buffer)
3cb6768f
EL
2640
2641;;; Speedbar support:
2642;; These functions permit speedbar to display the "tags" in the
2643;; current info node.
96ee3f29 2644(eval-when-compile (require 'speedbar))
3cb6768f 2645
96ee3f29
KH
2646(defvar Info-speedbar-key-map nil
2647 "Keymap used when in the info display mode.")
3cb6768f 2648
96ee3f29
KH
2649(defun Info-install-speedbar-variables ()
2650 "Install those variables used by speedbar to enhance Info."
2651 (if Info-speedbar-key-map
2652 nil
2653 (setq Info-speedbar-key-map (speedbar-make-specialized-keymap))
2654
2655 ;; Basic tree features
2656 (define-key Info-speedbar-key-map "e" 'speedbar-edit-line)
2657 (define-key Info-speedbar-key-map "\C-m" 'speedbar-edit-line)
2658 (define-key Info-speedbar-key-map "+" 'speedbar-expand-line)
2659 (define-key Info-speedbar-key-map "-" 'speedbar-contract-line)
2660 )
2661
2662 (speedbar-add-expansion-list '("Info" Info-speedbar-menu-items
2663 Info-speedbar-key-map
2664 Info-speedbar-hierarchy-buttons)))
3cb6768f
EL
2665
2666(defvar Info-speedbar-menu-items
96ee3f29
KH
2667 '(["Browse Node" speedbar-edit-line t]
2668 ["Expand Node" speedbar-expand-line
2669 (save-excursion (beginning-of-line)
2670 (looking-at "[0-9]+: *.\\+. "))]
2671 ["Contract Node" speedbar-contract-line
2672 (save-excursion (beginning-of-line)
2673 (looking-at "[0-9]+: *.-. "))]
2674 )
3cb6768f
EL
2675 "Additional menu-items to add to speedbar frame.")
2676
96ee3f29
KH
2677;; Make sure our special speedbar major mode is loaded
2678(if (featurep 'speedbar)
2679 (Info-install-speedbar-variables)
2680 (add-hook 'speedbar-load-hook 'Info-install-speedbar-variables))
2681
2682;;; Info hierarchy display method
2683;;;###autoload
2684(defun Info-speedbar-browser ()
2685 "Initialize speedbar to display an info node browser.
2686This will add a speedbar major display mode."
2687 (interactive)
2688 (require 'speedbar)
2689 ;; Make sure that speedbar is active
2690 (speedbar-frame-mode 1)
2691 ;; Now, throw us into Info mode on speedbar.
2692 (speedbar-change-initial-expansion-list "Info")
2693 )
2694
7210b6f5
DL
2695(eval-when-compile (defvar speedbar-attached-frame))
2696
96ee3f29
KH
2697(defun Info-speedbar-hierarchy-buttons (directory depth &optional node)
2698 "Display an Info directory hierarchy in speedbar.
2699DIRECTORY is the current directory in the attached frame.
2700DEPTH is the current indentation depth.
2701NODE is an optional argument that is used to represent the
2702specific node to expand."
2703 (if (and (not node)
2704 (save-excursion (goto-char (point-min))
1bcedb3b
RS
2705 (let ((case-fold-search t))
2706 (looking-at "Info Nodes:"))))
96ee3f29
KH
2707 ;; Update our "current node" maybe?
2708 nil
2709 ;; We cannot use the generic list code, that depends on all leaves
2710 ;; being known at creation time.
2711 (if (not node)
2712 (speedbar-with-writable (insert "Info Nodes:\n")))
5fdc7997
EL
2713 (let ((completions nil)
2714 (cf (selected-frame)))
2715 (select-frame speedbar-attached-frame)
2716 (save-window-excursion
2717 (setq completions
2718 (Info-speedbar-fetch-file-nodes (or node '"(dir)top"))))
2719 (select-frame cf)
96ee3f29
KH
2720 (if completions
2721 (speedbar-with-writable
2722 (while completions
2723 (speedbar-make-tag-line 'bracket ?+ 'Info-speedbar-expand-node
2724 (cdr (car completions))
2725 (car (car completions))
2726 'Info-speedbar-goto-node
2727 (cdr (car completions))
2728 'info-xref depth)
2729 (setq completions (cdr completions)))
2730 t)
2731 nil))))
399c88ad 2732
96ee3f29 2733(defun Info-speedbar-goto-node (text node indent)
d1268e52 2734 "When user clicks on TEXT, go to an info NODE.
96ee3f29 2735The INDENT level is ignored."
760d5cb3
GM
2736 (select-frame speedbar-attached-frame)
2737 (let* ((buff (or (get-buffer "*info*")
2738 (progn (info) (get-buffer "*info*"))))
2739 (bwin (get-buffer-window buff 0)))
2740 (if bwin
2741 (progn
2742 (select-window bwin)
2743 (raise-frame (window-frame bwin)))
2744 (if speedbar-power-click
2745 (let ((pop-up-frames t)) (select-window (display-buffer buff)))
2746 (select-frame speedbar-attached-frame)
2747 (switch-to-buffer buff)))
2748 (let ((junk (string-match "^(\\([^)]+\\))\\([^.]+\\)$" node))
2749 (file (match-string 1 node))
2750 (node (match-string 2 node)))
2751 (Info-find-node file node)
2752 ;; If we do a find-node, and we were in info mode, restore
2753 ;; the old default method. Once we are in info mode, it makes
2754 ;; sense to return to whatever method the user was using before.
2755 (if (string= speedbar-initial-expansion-list-name "Info")
2756 (speedbar-change-initial-expansion-list
2757 speedbar-previously-used-expansion-list-name)))))
96ee3f29
KH
2758
2759(defun Info-speedbar-expand-node (text token indent)
2760 "Expand the node the user clicked on.
2761TEXT is the text of the button we clicked on, a + or - item.
2762TOKEN is data related to this node (NAME . FILE).
2763INDENT is the current indentation depth."
2764 (cond ((string-match "+" text) ;we have to expand this file
2765 (speedbar-change-expand-button-char ?-)
2766 (if (speedbar-with-writable
760d5cb3
GM
2767 (save-excursion
2768 (end-of-line) (forward-char 1)
2769 (Info-speedbar-hierarchy-buttons nil (1+ indent) token)))
96ee3f29
KH
2770 (speedbar-change-expand-button-char ?-)
2771 (speedbar-change-expand-button-char ??)))
2772 ((string-match "-" text) ;we have to contract this node
2773 (speedbar-change-expand-button-char ?+)
2774 (speedbar-delete-subblock indent))
2775 (t (error "Ooops... not sure what to do")))
2776 (speedbar-center-buffer-smartly))
2777
2778(defun Info-speedbar-fetch-file-nodes (nodespec)
2779 "Fetch the subnodes from the info NODESPEC.
2780NODESPEC is a string of the form: (file)node.
2781Optional THISFILE represends the filename of"
2782 (save-excursion
2783 ;; Set up a buffer we can use to fake-out Info.
2784 (set-buffer (get-buffer-create "*info-browse-tmp*"))
2785 (if (not (equal major-mode 'Info-mode))
2786 (Info-mode))
2787 ;; Get the node into this buffer
2788 (let ((junk (string-match "^(\\([^)]+\\))\\([^.]+\\)$" nodespec))
2789 (file (match-string 1 nodespec))
2790 (node (match-string 2 nodespec)))
2791 (Info-find-node file node))
2792 ;; Scan the created buffer
2793 (goto-char (point-min))
2794 (let ((completions nil)
1bcedb3b 2795 (case-fold-search t)
96ee3f29
KH
2796 (thisfile (progn (string-match "^(\\([^)]+\\))" nodespec)
2797 (match-string 1 nodespec))))
2798 ;; Always skip the first one...
2799 (re-search-forward "\n\\* \\([^:\t\n]*\\):" nil t)
2800 (while (re-search-forward "\n\\* \\([^:\t\n]*\\):" nil t)
2801 (let ((name (match-string 1)))
2802 (if (looking-at " *\\(([^)]+)[^.\n]+\\)\\.")
2803 (setq name (cons name (match-string 1)))
2804 (if (looking-at " *\\(([^)]+)\\)\\.")
2805 (setq name (cons name (concat (match-string 1) "Top")))
2806 (if (looking-at " \\([^.]+\\).")
2807 (setq name
2808 (cons name (concat "(" thisfile ")" (match-string 1))))
2809 (setq name (cons name (concat "(" thisfile ")" name))))))
2810 (setq completions (cons name completions))))
2811 (nreverse completions))))
2812
2813;;; Info mode node listing
3cb6768f
EL
2814(defun Info-speedbar-buttons (buffer)
2815 "Create a speedbar display to help navigation in an Info file.
2816BUFFER is the buffer speedbar is requesting buttons for."
96ee3f29 2817 (if (save-excursion (goto-char (point-min))
1bcedb3b
RS
2818 (let ((case-fold-search t))
2819 (not (looking-at "Info Nodes:"))))
96ee3f29
KH
2820 (erase-buffer))
2821 (Info-speedbar-hierarchy-buttons nil 0)
2822 )
49116ac0 2823
48e5b471
DL
2824(dolist (mess '("^Node has no Previous$"
2825 "^No menu in this node$"
2826 "^Node has no Next$"
399c88ad
SS
2827 "^No cross-references in this node^"
2828 search-failed
48e5b471
DL
2829 "^No \".*\" in index$"))
2830 (add-to-list 'debug-ignored-errors mess))
2831
49116ac0
JB
2832(provide 'info)
2833
1a06eabd 2834;;; info.el ends here