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