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