aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJuri Linkov2004-04-08 03:44:34 +0000
committerJuri Linkov2004-04-08 03:44:34 +0000
commit8a7757f6f5793563a4337a3f761c8cc73974e27d (patch)
tree8a527ba1a5d327ebc890e487388b593c59a0f871
parent0c1b7af5c5a4b0b2e7f3fd8a52dcc39b27d41a58 (diff)
downloademacs-8a7757f6f5793563a4337a3f761c8cc73974e27d.tar.gz
emacs-8a7757f6f5793563a4337a3f761c8cc73974e27d.zip
(Info-history): Doc fix.
(Info-history-list): New var. (info-xref): Change magenta4 to blue, remove bold for dark and light backgrounds, change bold to underline for non-color classes. (info-xref-visited): New face. (Info-fontify-visited-nodes): New custom. (Info-hide-note-references): Add new value `hide'. Doc fix. (Info-reference-name): New var. (Info-selection-hook): New custom. (Info-edit-mode-hook): New var. (Info-find-file): New fun. (Info-find-node): Move part of code to Info-find-file. (Info-find-node-2): Add anchors to Info-history-list. Move point to the place with the reference name if name is defined. (Info-select-node): Add current node to Info-history-list. (Info-goto-node): Switch to *info* from *info-history* *info-toc*. (Info-search-whitespace-regexp): New custom. (Info-search-case-fold): New var. (Info-search): Add "case-sensitively" to the prompt. Use Info-search-whitespace-regexp. Set Info-search-case-fold. (Info-search-case-sensitively, Info-search-next): New fun. (Info-up): Move point to the menu item of the current node. (Info-history): New fun. Add *info-history* to same-window-buffer-names. (Info-toc): New fun. Add *info-toc* to same-window-buffer-names. (Info-insert-toc): New fun. (Info-build-toc): New fun. (Info-follow-reference): Add new arg `fork'. Doc fix. Replace [ \n\t]* by [ \n\t]+ in the *Note regexp. For references with the same name prefer the reference closest to point. (Info-next-reference): Replace * by + in the *Note regexp. Add regexp for http:// and ftp://. Skip the *Note prefix. (Info-prev-reference): Replace * by + in the *Note regexp. Add regexp for http:// and ftp://. Skip the *Note prefix. (Info-follow-nearest-node): Add new arg `fork'. (Info-try-follow-nearest-node): Add new arg `fork'. Call browse-url for http:// and ftp:// references. Set Info-reference-name for index entries. (Info-mode-menu): Add menu items for Info-search-case-sensitively, Info-search-next, Info-history, Info-toc, clone-buffer. (Info-menu-update): Replace * by + in the *Note regexp. (Info-mode): Add documentation for Info-history, Info-toc, Info-search-case-sensitively, Info-search-next, clone-buffer. (Info-fontify-menu-headers): Remove fun. Move code to Info-fontify-node. (Info-fontify-node): Add docstring. Add local vars fontify-visited-p and not-fontified-p. If not-fontified-p is t then fontify header line, titles, menu headers, http and ftp references, refill paragraphs. If not-fontified-p is t or fontify-visited-p is t then fontify cross references, menu items. Fontify menu headers. Fontify http and ftp references. Change regexp for cross references to require whitespace after *Note, add matching groups for file and node names. Remove hack for quote. Use display property for Info-hide-note-references=t. Use fifth or fourth match for help-echo. Display visited nodes in a different face. Unhide file names of external references. Unhide newlines. Display visited menu items in a different face.
-rw-r--r--lisp/ChangeLog59
-rw-r--r--lisp/info.el911
2 files changed, 713 insertions, 257 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f422415461b..962ff4b2e18 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,62 @@
12004-04-08 Juri Linkov <juri@jurta.org>
2
3 * info.el (Info-history): Doc fix.
4 (Info-history-list): New var.
5 (info-xref): Change magenta4 to blue, remove bold for dark and
6 light backgrounds, change bold to underline for non-color classes.
7 (info-xref-visited): New face.
8 (Info-fontify-visited-nodes): New custom.
9 (Info-hide-note-references): Add new value `hide'. Doc fix.
10 (Info-reference-name): New var.
11 (Info-selection-hook): New custom.
12 (Info-edit-mode-hook): New var.
13 (Info-find-file): New fun.
14 (Info-find-node): Move part of code to Info-find-file.
15 (Info-find-node-2): Add anchors to Info-history-list. Move point
16 to the place with the reference name if name is defined.
17 (Info-select-node): Add current node to Info-history-list.
18 (Info-goto-node): Switch to *info* from *info-history* *info-toc*.
19 (Info-search-whitespace-regexp): New custom.
20 (Info-search-case-fold): New var.
21 (Info-search): Add "case-sensitively" to the prompt. Use
22 Info-search-whitespace-regexp. Set Info-search-case-fold.
23 (Info-search-case-sensitively, Info-search-next): New fun.
24 (Info-up): Move point to the menu item of the current node.
25 (Info-history): New fun. Add *info-history* to same-window-buffer-names.
26 (Info-toc): New fun. Add *info-toc* to same-window-buffer-names.
27 (Info-insert-toc): New fun.
28 (Info-build-toc): New fun.
29 (Info-follow-reference): Add new arg `fork'. Doc fix.
30 Replace [ \n\t]* by [ \n\t]+ in the *Note regexp. For references
31 with the same name prefer the reference closest to point.
32 (Info-next-reference): Replace * by + in the *Note regexp.
33 Add regexp for http:// and ftp://. Skip the *Note prefix.
34 (Info-prev-reference): Replace * by + in the *Note regexp.
35 Add regexp for http:// and ftp://. Skip the *Note prefix.
36 (Info-follow-nearest-node): Add new arg `fork'.
37 (Info-try-follow-nearest-node): Add new arg `fork'.
38 Call browse-url for http:// and ftp:// references.
39 Set Info-reference-name for index entries.
40 (Info-mode-menu): Add menu items for Info-search-case-sensitively,
41 Info-search-next, Info-history, Info-toc, clone-buffer.
42 (Info-menu-update): Replace * by + in the *Note regexp.
43 (Info-mode): Add documentation for Info-history, Info-toc,
44 Info-search-case-sensitively, Info-search-next, clone-buffer.
45 (Info-fontify-menu-headers): Remove fun. Move code to
46 Info-fontify-node.
47 (Info-fontify-node): Add docstring. Add local vars
48 fontify-visited-p and not-fontified-p. If not-fontified-p is t
49 then fontify header line, titles, menu headers, http and ftp
50 references, refill paragraphs. If not-fontified-p is t or
51 fontify-visited-p is t then fontify cross references, menu items.
52 Fontify menu headers. Fontify http and ftp references. Change
53 regexp for cross references to require whitespace after *Note, add
54 matching groups for file and node names. Remove hack for quote.
55 Use display property for Info-hide-note-references=t. Use fifth
56 or fourth match for help-echo. Display visited nodes in a
57 different face. Unhide file names of external references. Unhide
58 newlines. Display visited menu items in a different face.
59
12004-04-07 Jan Nieuwenhuizen <janneke@gnu.org> 602004-04-07 Jan Nieuwenhuizen <janneke@gnu.org>
2 61
3 * info.el (Info-hide-cookies-node): New function. 62 * info.el (Info-hide-cookies-node): New function.
diff --git a/lisp/info.el b/lisp/info.el
index a72ded5bc3d..173abe17a83 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -44,9 +44,13 @@
44 44
45 45
46(defvar Info-history nil 46(defvar Info-history nil
47 "List of info nodes user has visited. 47 "Stack of info nodes user has visited.
48Each element of list is a list (FILENAME NODENAME BUFFERPOS).") 48Each element of list is a list (FILENAME NODENAME BUFFERPOS).")
49 49
50(defvar Info-history-list nil
51 "List of all info nodes user has visited.
52Each element of list is a list (FILENAME NODENAME).")
53
50(defcustom Info-enable-edit nil 54(defcustom Info-enable-edit nil
51 "*Non-nil means the \\<Info-mode-map>\\[Info-edit] command in Info can edit the current node. 55 "*Non-nil means the \\<Info-mode-map>\\[Info-edit] command in Info can edit the current node.
52This is convenient if you want to write info files by hand. 56This is convenient if you want to write info files by hand.
@@ -75,12 +79,25 @@ The Lisp code is executed when the node is selected.")
75 :group 'info) 79 :group 'info)
76 80
77(defface info-xref 81(defface info-xref
78 '((((class color) (background light)) (:foreground "magenta4" :weight bold)) 82 '((((class color) (background light)) (:foreground "blue"))
79 (((class color) (background dark)) (:foreground "cyan" :weight bold)) 83 (((class color) (background dark)) (:foreground "cyan"))
80 (t (:weight bold))) 84 (t (:underline t)))
81 "Face for Info cross-references." 85 "Face for Info cross-references."
82 :group 'info) 86 :group 'info)
83 87
88(defface info-xref-visited
89 '((((class color) (background light)) (:foreground "magenta4"))
90 (((class color) (background dark)) (:foreground "magenta4"))
91 (t (:underline t)))
92 "Face for visited Info cross-references."
93 :group 'info)
94
95(defcustom Info-fontify-visited-nodes t
96 "*Non-nil means to fontify visited nodes in a different face."
97 :version "21.4"
98 :type 'boolean
99 :group 'info)
100
84(defcustom Info-fontify-maximum-menu-size 100000 101(defcustom Info-fontify-maximum-menu-size 100000
85 "*Maximum size of menu to fontify if `font-lock-mode' is non-nil." 102 "*Maximum size of menu to fontify if `font-lock-mode' is non-nil."
86 :type 'integer 103 :type 'integer
@@ -154,12 +171,13 @@ when you hit the end of the current node."
154 171
155(defcustom Info-hide-note-references t 172(defcustom Info-hide-note-references t
156 "*If non-nil, hide the tag and section reference in *note and * menu items. 173 "*If non-nil, hide the tag and section reference in *note and * menu items.
157Also replaces the \"*note\" text with \"see\". 174If value is non-nil but not `hide', also replaces the \"*note\" with \"see\".
158If value is non-nil but not t, the reference section is still shown." 175If value is non-nil but not t or `hide', the reference section is still shown."
159 :version "21.4" 176 :version "21.4"
160 :type '(choice (const :tag "No reformatting" nil) 177 :type '(choice (const :tag "No hiding" nil)
161 (const :tag "Replace tag and hide reference" t) 178 (const :tag "Replace tag and hide reference" t)
162 (other :tag "Replace only tag" tag)) 179 (const :tag "Hide tag and reference" hide)
180 (other :tag "Only replace tag" tag))
163 :group 'info) 181 :group 'info)
164 182
165(defcustom Info-refill-paragraphs nil 183(defcustom Info-refill-paragraphs nil
@@ -170,14 +188,31 @@ file, so be prepared for a few surprises if you enable this feature."
170 :type 'boolean 188 :type 'boolean
171 :group 'info) 189 :group 'info)
172 190
191(defcustom Info-search-whitespace-regexp "\\\\(?:\\\\s-+\\\\)"
192 "*If non-nil, regular expression to match a sequence of whitespace chars.
193This applies to Info search for regular expressions.
194You might want to use something like \"[ \\t\\r\\n]+\" instead.
195In the Customization buffer, that is `[' followed by a space,
196a tab, a carriage return (control-M), a newline, and `]+'."
197 :type 'regexp
198 :group 'info)
199
173(defcustom Info-mode-hook 200(defcustom Info-mode-hook
174 ;; Try to obey obsolete Info-fontify settings. 201 ;; Try to obey obsolete Info-fontify settings.
175 (unless (and (boundp 'Info-fontify) (null Info-fontify)) 202 (unless (and (boundp 'Info-fontify) (null Info-fontify))
176 '(turn-on-font-lock)) 203 '(turn-on-font-lock))
177 "Hooks run when `info-mode' is called." 204 "Hooks run when `Info-mode' is called."
205 :type 'hook
206 :group 'info)
207
208(defcustom Info-selection-hook nil
209 "Hooks run when `Info-select-node' is called."
178 :type 'hook 210 :type 'hook
179 :group 'info) 211 :group 'info)
180 212
213(defvar Info-edit-mode-hook nil
214 "Hooks run when `Info-edit-mode' is called.")
215
181(defvar Info-current-file nil 216(defvar Info-current-file nil
182 "Info file that Info is now looking at, or nil. 217 "Info file that Info is now looking at, or nil.
183This is the name that was specified in Info, not the actual file name. 218This is the name that was specified in Info, not the actual file name.
@@ -204,6 +239,11 @@ Marker points nowhere if file has no tag table.")
204(defvar Info-index-alternatives nil 239(defvar Info-index-alternatives nil
205 "List of possible matches for last `Info-index' command.") 240 "List of possible matches for last `Info-index' command.")
206 241
242(defvar Info-reference-name nil
243 "Name of the selected cross-reference.
244Point is moved to the proper occurrence of this name within a node
245after selecting it.")
246
207(defvar Info-standalone nil 247(defvar Info-standalone nil
208 "Non-nil if Emacs was started solely as an Info browser.") 248 "Non-nil if Emacs was started solely as an Info browser.")
209 249
@@ -488,11 +528,10 @@ In standalone mode, \\<Info-mode-map>\\[Info-exit] exits Emacs itself."
488 (forward-line 1) ; does the line after delimiter match REGEXP? 528 (forward-line 1) ; does the line after delimiter match REGEXP?
489 (re-search-backward regexp beg t)))) 529 (re-search-backward regexp beg t))))
490 530
491(defun Info-find-node (filename nodename &optional no-going-back) 531(defun Info-find-file (filename &optional noerror)
492 "Go to an info node specified as separate FILENAME and NODENAME. 532 "Return expanded FILENAME, or t, if FILENAME is \"dir\".
493NO-GOING-BACK is non-nil if recovering from an error in this function; 533Optional second argument NOERROR, if t, means if file is not found
494it says do not attempt further (recursive) error recovery." 534just return nil (no error)."
495 (info-initialize)
496 ;; Convert filename to lower case if not found as specified. 535 ;; Convert filename to lower case if not found as specified.
497 ;; Expand it. 536 ;; Expand it.
498 (if (stringp filename) 537 (if (stringp filename)
@@ -545,7 +584,17 @@ it says do not attempt further (recursive) error recovery."
545 (setq dirs (cdr dirs)))))) 584 (setq dirs (cdr dirs))))))
546 (if found 585 (if found
547 (setq filename found) 586 (setq filename found)
548 (error "Info file %s does not exist" filename)))) 587 (if noerror
588 (setq filename nil)
589 (error "Info file %s does not exist" filename)))
590 filename)))
591
592(defun Info-find-node (filename nodename &optional no-going-back)
593 "Go to an info node specified as separate FILENAME and NODENAME.
594NO-GOING-BACK is non-nil if recovering from an error in this function;
595it says do not attempt further (recursive) error recovery."
596 (info-initialize)
597 (setq filename (Info-find-file filename))
549 ;; Record the node we are leaving. 598 ;; Record the node we are leaving.
550 (if (and Info-current-file (not no-going-back)) 599 (if (and Info-current-file (not no-going-back))
551 (setq Info-history 600 (setq Info-history
@@ -800,7 +849,18 @@ a case-insensitive match is tried."
800 nodename))) 849 nodename)))
801 850
802 (Info-select-node) 851 (Info-select-node)
803 (goto-char (or anchorpos (point-min)))))) 852 (goto-char (point-min))
853 (cond (anchorpos
854 (let ((new-history (list Info-current-file
855 (substring-no-properties nodename))))
856 ;; Add anchors to the history too
857 (setq Info-history-list
858 (cons new-history
859 (delete new-history Info-history-list))))
860 (goto-char anchorpos))
861 (Info-reference-name
862 (Info-find-index-name Info-reference-name)
863 (setq Info-reference-name nil))))))
804 ;; If we did not finish finding the specified node, 864 ;; If we did not finish finding the specified node,
805 ;; go back to the previous one. 865 ;; go back to the previous one.
806 (or Info-current-node no-going-back (null Info-history) 866 (or Info-current-node no-going-back (null Info-history)
@@ -1202,6 +1262,10 @@ any double quotes or backslashes must be escaped (\\\",\\\\)."
1202 (read (current-buffer)))))) 1262 (read (current-buffer))))))
1203 (point-max))) 1263 (point-max)))
1204 (if Info-enable-active-nodes (eval active-expression)) 1264 (if Info-enable-active-nodes (eval active-expression))
1265 ;; Add a new unique history item to full history list
1266 (let ((new-history (list Info-current-file Info-current-node)))
1267 (setq Info-history-list
1268 (cons new-history (delete new-history Info-history-list))))
1205 (Info-fontify-node) 1269 (Info-fontify-node)
1206 (Info-display-images-node) 1270 (Info-display-images-node)
1207 (Info-hide-cookies-node) 1271 (Info-hide-cookies-node)
@@ -1236,6 +1300,8 @@ If FORK is a string, it is the name to use for the new buffer."
1236 (if fork 1300 (if fork
1237 (set-buffer 1301 (set-buffer
1238 (clone-buffer (concat "*info-" (if (stringp fork) fork nodename) "*") t))) 1302 (clone-buffer (concat "*info-" (if (stringp fork) fork nodename) "*") t)))
1303 (if (member (buffer-name) '("*info-history*" "*info-toc*"))
1304 (switch-to-buffer "*info*"))
1239 (let (filename) 1305 (let (filename)
1240 (string-match "\\s *\\((\\s *\\([^\t)]*\\)\\s *)\\s *\\|\\)\\(.*\\)" 1306 (string-match "\\s *\\((\\s *\\([^\t)]*\\)\\s *)\\s *\\|\\)\\(.*\\)"
1241 nodename) 1307 nodename)
@@ -1344,13 +1410,18 @@ If FORK is a string, it is the name to use for the new buffer."
1344(defvar Info-search-history nil 1410(defvar Info-search-history nil
1345 "The history list for `Info-search'.") 1411 "The history list for `Info-search'.")
1346 1412
1413(defvar Info-search-case-fold nil
1414 "The value of `case-fold-search' from previous `Info-search' command.")
1415
1347(defun Info-search (regexp) 1416(defun Info-search (regexp)
1348 "Search for REGEXP, starting from point, and select node it's found in." 1417 "Search for REGEXP, starting from point, and select node it's found in."
1349 (interactive (list (read-string 1418 (interactive (list (read-string
1350 (if Info-search-history 1419 (if Info-search-history
1351 (format "Regexp search (default `%s'): " 1420 (format "Regexp search%s (default `%s'): "
1421 (if case-fold-search "" " case-sensitively")
1352 (car Info-search-history)) 1422 (car Info-search-history))
1353 "Regexp search: ") 1423 (format "Regexp search%s: "
1424 (if case-fold-search "" " case-sensitively")))
1354 nil 'Info-search-history))) 1425 nil 'Info-search-history)))
1355 (when transient-mark-mode 1426 (when transient-mark-mode
1356 (deactivate-mark)) 1427 (deactivate-mark))
@@ -1363,6 +1434,10 @@ If FORK is a string, it is the name to use for the new buffer."
1363 (opoint (point)) 1434 (opoint (point))
1364 (ostart (window-start)) 1435 (ostart (window-start))
1365 (osubfile Info-current-subfile)) 1436 (osubfile Info-current-subfile))
1437 (when Info-search-whitespace-regexp
1438 (setq regexp (replace-regexp-in-string
1439 "[ \t\n]+" Info-search-whitespace-regexp regexp)))
1440 (setq Info-search-case-fold case-fold-search)
1366 (save-excursion 1441 (save-excursion
1367 (save-restriction 1442 (save-restriction
1368 (widen) 1443 (widen)
@@ -1438,6 +1513,20 @@ If FORK is a string, it is the name to use for the new buffer."
1438 (equal ofile Info-current-file)) 1513 (equal ofile Info-current-file))
1439 (setq Info-history (cons (list ofile onode opoint) 1514 (setq Info-history (cons (list ofile onode opoint)
1440 Info-history)))))) 1515 Info-history))))))
1516
1517(defun Info-search-case-sensitively ()
1518 "Search for a regexp case-sensitively."
1519 (interactive)
1520 (let ((case-fold-search nil))
1521 (call-interactively 'Info-search)))
1522
1523(defun Info-search-next ()
1524 "Search for next regexp from a previous `Info-search' command."
1525 (interactive)
1526 (let ((case-fold-search Info-search-case-fold))
1527 (if Info-search-history
1528 (Info-search (car Info-search-history))
1529 (call-interactively 'Info-search))))
1441 1530
1442(defun Info-extract-pointer (name &optional errorname) 1531(defun Info-extract-pointer (name &optional errorname)
1443 "Extract the value of the node-pointer named NAME. 1532 "Extract the value of the node-pointer named NAME.
@@ -1489,12 +1578,25 @@ End of submatch 0, 1, and 3 are the same, so you can safely concat."
1489 "Go to the superior node of this node. 1578 "Go to the superior node of this node.
1490If SAME-FILE is non-nil, do not move to a different Info file." 1579If SAME-FILE is non-nil, do not move to a different Info file."
1491 (interactive) 1580 (interactive)
1492 (let ((node (Info-extract-pointer "up"))) 1581 (let ((old-node Info-current-node)
1582 (old-file Info-current-file)
1583 (node (Info-extract-pointer "up")) p)
1493 (and (or same-file (not (stringp Info-current-file))) 1584 (and (or same-file (not (stringp Info-current-file)))
1494 (string-match "^(" node) 1585 (string-match "^(" node)
1495 (error "Up node is in another Info file")) 1586 (error "Up node is in another Info file"))
1496 (Info-goto-node node)) 1587 (Info-goto-node node)
1497 (Info-restore-point Info-history)) 1588 (setq p (point))
1589 (goto-char (point-min))
1590 (if (and (search-forward "\n* Menu:" nil t)
1591 (re-search-forward
1592 (if (string-equal old-node "Top")
1593 (concat "\n\\*[^:]+: +(" (file-name-nondirectory old-file) ")")
1594 (concat "\n\\* +\\(" (regexp-quote old-node)
1595 ":\\|[^:]+: +" (regexp-quote old-node) "\\)"))
1596 nil t))
1597 (beginning-of-line)
1598 (goto-char p)
1599 (Info-restore-point Info-history))))
1498 1600
1499(defun Info-last () 1601(defun Info-last ()
1500 "Go back to the last node visited." 1602 "Go back to the last node visited."
@@ -1516,9 +1618,160 @@ If SAME-FILE is non-nil, do not move to a different Info file."
1516 (interactive) 1618 (interactive)
1517 (Info-find-node "dir" "top")) 1619 (Info-find-node "dir" "top"))
1518 1620
1519(defun Info-follow-reference (footnotename) 1621;;;###autoload (add-hook 'same-window-buffer-names "*info-history*")
1622
1623(defun Info-history ()
1624 "Create the buffer *info-history* with a menu of visited nodes."
1625 (interactive)
1626 (let ((curr-file Info-current-file)
1627 (curr-node Info-current-node)
1628 p)
1629 (pop-to-buffer
1630 (with-current-buffer (get-buffer-create "*info-history*")
1631 (let ((inhibit-read-only t))
1632 (erase-buffer)
1633 (goto-char (point-min))
1634 (insert "Node: History\n\n")
1635 (insert "Recently Visited Nodes\n**********************\n\n")
1636 (insert "* Menu:\n\n")
1637 (let ((hl Info-history-list))
1638 (while hl
1639 (let ((file (nth 0 (car hl)))
1640 (node (nth 1 (car hl))))
1641 (if (and (string-equal file curr-file)
1642 (string-equal node curr-node))
1643 (setq p (point)))
1644 (insert "* " node ": (" (file-name-nondirectory file)
1645 ")" node ".\n"))
1646 (setq hl (cdr hl))))
1647 (or (eq major-mode 'Info-mode) (Info-mode))
1648 (setq Info-current-file "info-history")
1649 (setq Info-current-node "Info History")
1650 (Info-set-mode-line)
1651 (if (not (bobp)) (Info-fontify-node))
1652 (current-buffer))))
1653 (goto-char (or p (point-min)))))
1654
1655;;;###autoload (add-hook 'same-window-buffer-names "*info-toc*")
1656
1657(defun Info-toc ()
1658 "Create the buffer *info-toc* with Info file's table of contents."
1659 (interactive)
1660 (let ((curr-file Info-current-file)
1661 (curr-node Info-current-node)
1662 p)
1663 (pop-to-buffer
1664 (with-current-buffer (get-buffer-create "*info-toc*")
1665 (if (not (equal Info-current-file curr-file))
1666 (let ((inhibit-read-only t)
1667 (node-list (Info-build-toc curr-file)))
1668 (erase-buffer)
1669 (goto-char (point-min))
1670 (insert "Node: Contents\n\n")
1671 (insert "Table of Contents\n*****************\n\n")
1672 (insert "*Note Top::\n")
1673 (Info-insert-toc
1674 (nth 2 (assoc "Top" node-list)) ; get Top nodes
1675 node-list 0)
1676 (or (eq major-mode 'Info-mode) (Info-mode))
1677 (setq Info-current-file curr-file)
1678 (setq Info-current-node "Contents")
1679 (Info-set-mode-line)))
1680 (if (not (bobp))
1681 (let ((Info-hide-note-references 'hide))
1682 (Info-fontify-node)))
1683 (goto-char (point-min))
1684 (if (setq p (search-forward (concat "*Note " curr-node "::") nil t))
1685 (setq p (- p (length curr-node) 2)))
1686 (current-buffer)))
1687 (goto-char (or p (point-min)))))
1688
1689(defun Info-insert-toc (nodes node-list level)
1690 "Insert table of contents with references to nodes."
1691 (let ((section "Top"))
1692 (while nodes
1693 (let ((node (assoc (car nodes) node-list)))
1694 (unless (member (nth 1 node) (list nil section))
1695 (insert (setq section (nth 1 node)) "\n"))
1696 (insert (make-string level ?\t))
1697 (insert "*Note " (car nodes) "::\n")
1698 (Info-insert-toc (nth 2 node) node-list (1+ level))
1699 (setq nodes (cdr nodes))))))
1700
1701(defun Info-build-toc (file)
1702 "Build table of contents from menus of Info FILE and its subfiles."
1703 (if (equal file "dir")
1704 (error "Table of contents for Info directory is not supported yet"))
1705 (with-temp-buffer
1706 (let ((default-directory (or (and (stringp file)
1707 (file-name-directory
1708 (setq file (Info-find-file file))))
1709 default-directory))
1710 (sections '(("Top" "Top")))
1711 nodes subfiles)
1712 (while (or file subfiles)
1713 (or file (message "Searching subfile %s..." (car subfiles)))
1714 (erase-buffer)
1715 (info-insert-file-contents (or file (car subfiles)))
1716 (while (and (search-forward "\n\^_\nFile:" nil 'move)
1717 (search-forward "Node: " nil 'move))
1718 (let ((nodename (substring-no-properties (Info-following-node-name)))
1719 (bound (- (or (save-excursion (search-forward "\n\^_" nil t))
1720 (point-max)) 2))
1721 (section "Top")
1722 menu-items)
1723 (when (and (not (string-match "\\<index\\>" nodename))
1724 (re-search-forward "^\\* Menu:" bound t))
1725 (forward-line 1)
1726 (beginning-of-line)
1727 (setq bound (or (and (equal nodename "Top")
1728 (save-excursion
1729 (re-search-forward
1730 "^[ \t-]*The Detailed Node Listing" nil t)))
1731 bound))
1732 (while (< (point) bound)
1733 (cond
1734 ;; Menu item line
1735 ((looking-at "^\\* +[^:]+:")
1736 (beginning-of-line)
1737 (forward-char 2)
1738 (let ((menu-node-name (substring-no-properties
1739 (Info-extract-menu-node-name))))
1740 (setq menu-items (cons menu-node-name menu-items))
1741 (if (equal nodename "Top")
1742 (setq sections
1743 (cons (list menu-node-name section) sections)))))
1744 ;; Other non-empty strings in the Top node are section names
1745 ((and (equal nodename "Top")
1746 (looking-at "^\\([^ \t\n*=.-][^:\n]*\\)"))
1747 (setq section (match-string-no-properties 1))))
1748 (forward-line 1)
1749 (beginning-of-line)))
1750 (setq nodes (cons (list nodename
1751 (cadr (assoc nodename sections))
1752 (nreverse menu-items))
1753 nodes))
1754 (goto-char bound)))
1755 (if file
1756 (save-excursion
1757 (goto-char (point-min))
1758 (if (search-forward "\n\^_\nIndirect:" nil t)
1759 (let ((bound (save-excursion (search-forward "\n\^_" nil t))))
1760 (while (re-search-forward "^\\(.*\\): [0-9]+$" bound t)
1761 (setq subfiles (cons (match-string-no-properties 1)
1762 subfiles)))))
1763 (setq subfiles (nreverse subfiles)
1764 file nil))
1765 (setq subfiles (cdr subfiles))))
1766 (message "")
1767 (nreverse nodes))))
1768
1769(defun Info-follow-reference (footnotename &optional fork)
1520 "Follow cross reference named FOOTNOTENAME to the node it refers to. 1770 "Follow cross reference named FOOTNOTENAME to the node it refers to.
1521FOOTNOTENAME may be an abbreviation of the reference name." 1771FOOTNOTENAME may be an abbreviation of the reference name.
1772If FORK is non-nil (interactively with a prefix arg), show the node in
1773a new info buffer. If FORK is a string, it is the name to use for the
1774new buffer."
1522 (interactive 1775 (interactive
1523 (let ((completion-ignore-case t) 1776 (let ((completion-ignore-case t)
1524 (case-fold-search t) 1777 (case-fold-search t)
@@ -1531,7 +1784,7 @@ FOOTNOTENAME may be an abbreviation of the reference name."
1531 (setq bol (point)) 1784 (setq bol (point))
1532 1785
1533 (goto-char (point-min)) 1786 (goto-char (point-min))
1534 (while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t) 1787 (while (re-search-forward "\\*note[ \n\t]+\\([^:]*\\):" nil t)
1535 (setq str (match-string-no-properties 1)) 1788 (setq str (match-string-no-properties 1))
1536 ;; See if this one should be the default. 1789 ;; See if this one should be the default.
1537 (and (null default) 1790 (and (null default)
@@ -1568,7 +1821,7 @@ FOOTNOTENAME may be an abbreviation of the reference name."
1568 "Follow reference named: ") 1821 "Follow reference named: ")
1569 completions nil t))) 1822 completions nil t)))
1570 (list (if (equal input "") 1823 (list (if (equal input "")
1571 default input))) 1824 default input) current-prefix-arg))
1572 (error "No cross-references in this node")))) 1825 (error "No cross-references in this node"))))
1573 1826
1574 (unless footnotename 1827 (unless footnotename
@@ -1580,17 +1833,33 @@ FOOTNOTENAME may be an abbreviation of the reference name."
1580 (setq str (concat (substring str 0 i) "[ \t\n]+" (substring str (1+ i)))) 1833 (setq str (concat (substring str 0 i) "[ \t\n]+" (substring str (1+ i))))
1581 (setq i (+ i 6))) 1834 (setq i (+ i 6)))
1582 (save-excursion 1835 (save-excursion
1583 (goto-char (point-min)) 1836 ;; Move point to the beginning of reference if point is on reference
1584 (or (re-search-forward str nil t) 1837 (or (looking-at "\\*note[ \n\t]+")
1585 (error "No cross-reference named %s" footnotename)) 1838 (and (looking-back "\\*note[ \n\t]+")
1586 (goto-char (+ (match-beginning 0) 5)) 1839 (goto-char (match-beginning 0)))
1587 (setq target 1840 (if (and (save-excursion
1588 (Info-extract-menu-node-name t))) 1841 (goto-char (+ (point) 5)) ; skip a possible *note
1842 (re-search-backward "\\*note[ \n\t]+" nil t)
1843 (looking-at (concat "\\*note[ \n\t]+" (Info-following-node-name-re))))
1844 (<= (point) (match-end 0)))
1845 (goto-char (match-beginning 0))))
1846 ;; Go to the reference closest to point
1847 (let ((next-ref (save-excursion (and (re-search-forward str nil t)
1848 (+ (match-beginning 0) 5))))
1849 (prev-ref (save-excursion (and (re-search-backward str nil t)
1850 (+ (match-beginning 0) 5)))))
1851 (goto-char (cond ((and next-ref prev-ref)
1852 (if (< (abs (- next-ref (point)))
1853 (abs (- prev-ref (point))))
1854 next-ref prev-ref))
1855 ((or next-ref prev-ref))
1856 ((error "No cross-reference named %s" footnotename))))
1857 (setq target (Info-extract-menu-node-name t))))
1589 (while (setq i (string-match "[ \t\n]+" target i)) 1858 (while (setq i (string-match "[ \t\n]+" target i))
1590 (setq target (concat (substring target 0 i) " " 1859 (setq target (concat (substring target 0 i) " "
1591 (substring target (match-end 0)))) 1860 (substring target (match-end 0))))
1592 (setq i (+ i 1))) 1861 (setq i (+ i 1)))
1593 (Info-goto-node target))) 1862 (Info-goto-node target fork)))
1594 1863
1595(defconst Info-menu-entry-name-re "\\(?:[^:]\\|:[^:,.;() \t\n]\\)*" 1864(defconst Info-menu-entry-name-re "\\(?:[^:]\\|:[^:,.;() \t\n]\\)*"
1596 ;; We allow newline because this is also used in Info-follow-reference, 1865 ;; We allow newline because this is also used in Info-follow-reference,
@@ -1997,7 +2266,7 @@ parent node."
1997(defun Info-next-reference (&optional recur) 2266(defun Info-next-reference (&optional recur)
1998 "Move cursor to the next cross-reference or menu item in the node." 2267 "Move cursor to the next cross-reference or menu item in the node."
1999 (interactive) 2268 (interactive)
2000 (let ((pat "\\*note[ \n\t]*\\([^:]*\\):\\|^\\* .*:") 2269 (let ((pat "\\*note[ \n\t]+\\([^:]+\\):\\|^\\* .*:\\|[hf]t?tp://")
2001 (old-pt (point)) 2270 (old-pt (point))
2002 (case-fold-search t)) 2271 (case-fold-search t))
2003 (or (eobp) (forward-char 1)) 2272 (or (eobp) (forward-char 1))
@@ -2008,7 +2277,7 @@ parent node."
2008 (progn 2277 (progn
2009 (goto-char old-pt) 2278 (goto-char old-pt)
2010 (error "No cross references in this node"))))) 2279 (error "No cross references in this node")))))
2011 (goto-char (match-beginning 0)) 2280 (goto-char (or (match-beginning 1) (match-beginning 0)))
2012 (if (looking-at "\\* Menu:") 2281 (if (looking-at "\\* Menu:")
2013 (if recur 2282 (if recur
2014 (error "No cross references in this node") 2283 (error "No cross references in this node")
@@ -2017,7 +2286,7 @@ parent node."
2017(defun Info-prev-reference (&optional recur) 2286(defun Info-prev-reference (&optional recur)
2018 "Move cursor to the previous cross-reference or menu item in the node." 2287 "Move cursor to the previous cross-reference or menu item in the node."
2019 (interactive) 2288 (interactive)
2020 (let ((pat "\\*note[ \n\t]*\\([^:]*\\):\\|^\\* .*:") 2289 (let ((pat "\\*note[ \n\t]+\\([^:]+\\):\\|^\\* .*:\\|[hf]t?tp://")
2021 (old-pt (point)) 2290 (old-pt (point))
2022 (case-fold-search t)) 2291 (case-fold-search t))
2023 (or (re-search-backward pat nil t) 2292 (or (re-search-backward pat nil t)
@@ -2027,7 +2296,7 @@ parent node."
2027 (progn 2296 (progn
2028 (goto-char old-pt) 2297 (goto-char old-pt)
2029 (error "No cross references in this node"))))) 2298 (error "No cross references in this node")))))
2030 (goto-char (match-beginning 0)) 2299 (goto-char (or (match-beginning 1) (match-beginning 0)))
2031 (if (looking-at "\\* Menu:") 2300 (if (looking-at "\\* Menu:")
2032 (if recur 2301 (if recur
2033 (error "No cross references in this node") 2302 (error "No cross references in this node")
@@ -2293,12 +2562,12 @@ At end of the node's text, moves to the next node, or up if none."
2293 (save-excursion (forward-line 1) (eobp)) 2562 (save-excursion (forward-line 1) (eobp))
2294 (Info-next-preorder))) 2563 (Info-next-preorder)))
2295 2564
2296(defun Info-follow-nearest-node () 2565(defun Info-follow-nearest-node (&optional fork)
2297 "Follow a node reference near point. 2566 "Follow a node reference near point.
2298If point is on a reference, follow that reference. Otherwise, 2567If point is on a reference, follow that reference. Otherwise,
2299if point is in a menu item description, follow that menu item." 2568if point is in a menu item description, follow that menu item."
2300 (interactive) 2569 (interactive "P")
2301 (or (Info-try-follow-nearest-node) 2570 (or (Info-try-follow-nearest-node fork)
2302 (when (save-excursion 2571 (when (save-excursion
2303 (search-backward "\n* menu:" nil t)) 2572 (search-backward "\n* menu:" nil t))
2304 (save-excursion 2573 (save-excursion
@@ -2307,35 +2576,45 @@ if point is in a menu item description, follow that menu item."
2307 (beginning-of-line 0)) 2576 (beginning-of-line 0))
2308 (when (looking-at "\\* +\\([^\t\n]*\\):") 2577 (when (looking-at "\\* +\\([^\t\n]*\\):")
2309 (Info-goto-node 2578 (Info-goto-node
2310 (Info-extract-menu-item (match-string-no-properties 1))) 2579 (Info-extract-menu-item (match-string-no-properties 1)) fork)
2311 t))) 2580 t)))
2312 (error "Point neither on reference nor in menu item description"))) 2581 (error "Point neither on reference nor in menu item description")))
2313 2582
2314;; Common subroutine. 2583;; Common subroutine.
2315(defun Info-try-follow-nearest-node () 2584(defun Info-try-follow-nearest-node (&optional fork)
2316 "Follow a node reference near point. Return non-nil if successful." 2585 "Follow a node reference near point. Return non-nil if successful."
2317 (let (node) 2586 (let (node)
2318 (cond 2587 (cond
2319 ((setq node (Info-get-token (point) "\\*note[ \n]" 2588 ((and (Info-get-token (point) "[hf]t?tp://" "[hf]t?tp://\\([^ \t\n\"`({<>})']+\\)")
2320 "\\*note[ \n]\\([^:]*\\):")) 2589 (or (featurep 'browse-url) (require 'browse-url nil t)))
2321 (Info-follow-reference node)) 2590 (setq node t)
2591 (browse-url (browse-url-url-at-point)))
2592 ((setq node (Info-get-token (point) "\\*note[ \n\t]+"
2593 "\\*note[ \n\t]+\\([^:]*\\):\\(:\\|[ \n\t]*(\\)?"))
2594;;; (or (match-string 2)
2595;;; (setq Info-reference-name
2596;;; (replace-regexp-in-string
2597;;; "[ \n\t]+" " " (match-string-no-properties 1))))
2598 (Info-follow-reference node fork))
2322 ;; menu item: node name 2599 ;; menu item: node name
2323 ((setq node (Info-get-token (point) "\\* +" "\\* +\\([^:]*\\)::")) 2600 ((setq node (Info-get-token (point) "\\* +" "\\* +\\([^:]*\\)::"))
2324 (Info-goto-node node)) 2601 (Info-goto-node node fork))
2325 ;; menu item: index entry 2602 ;; menu item: index entry
2326 ((Info-get-token (point) "\\* +" "\\* +\\(.*\\): ") 2603 ((Info-get-token (point) "\\* +" "\\* +\\(.*\\): ")
2604 (if (save-match-data (string-match "\\<index\\>" Info-current-node))
2605 (setq Info-reference-name (match-string-no-properties 1)))
2327 (beginning-of-line) 2606 (beginning-of-line)
2328 (forward-char 2) 2607 (forward-char 2)
2329 (setq node (Info-extract-menu-node-name)) 2608 (setq node (Info-extract-menu-node-name))
2330 (Info-goto-node node)) 2609 (Info-goto-node node fork))
2331 ((setq node (Info-get-token (point) "Up: " "Up: \\([^,\n\t]*\\)")) 2610 ((setq node (Info-get-token (point) "Up: " "Up: \\([^,\n\t]*\\)"))
2332 (Info-goto-node node)) 2611 (Info-goto-node node fork))
2333 ((setq node (Info-get-token (point) "Next: " "Next: \\([^,\n\t]*\\)")) 2612 ((setq node (Info-get-token (point) "Next: " "Next: \\([^,\n\t]*\\)"))
2334 (Info-goto-node node)) 2613 (Info-goto-node node fork))
2335 ((setq node (Info-get-token (point) "File: " "File: \\([^,\n\t]*\\)")) 2614 ((setq node (Info-get-token (point) "File: " "File: \\([^,\n\t]*\\)"))
2336 (Info-goto-node "Top")) 2615 (Info-goto-node "Top" fork))
2337 ((setq node (Info-get-token (point) "Prev: " "Prev: \\([^,\n\t]*\\)")) 2616 ((setq node (Info-get-token (point) "Prev: " "Prev: \\([^,\n\t]*\\)"))
2338 (Info-goto-node node))) 2617 (Info-goto-node node fork)))
2339 node)) 2618 node))
2340 2619
2341(defvar Info-mode-map nil 2620(defvar Info-mode-map nil
@@ -2419,10 +2698,18 @@ if point is in a menu item description, follow that menu item."
2419 ("Reference" ["You should never see this" report-emacs-bug t]) 2698 ("Reference" ["You should never see this" report-emacs-bug t])
2420 ["Search..." Info-search 2699 ["Search..." Info-search
2421 :help "Search for regular expression in this Info file"] 2700 :help "Search for regular expression in this Info file"]
2701 ["Search Case-Sensitively..." Info-search-case-sensitively
2702 :help "Search for regular expression case sensitively"]
2703 ["Search Next" Info-search-next
2704 :help "Search for another occurrence of regular expression"]
2422 ["Go to Node..." Info-goto-node 2705 ["Go to Node..." Info-goto-node
2423 :help "Go to a named node"] 2706 :help "Go to a named node"]
2424 ["Last" Info-last :active Info-history 2707 ["Last" Info-last :active Info-history
2425 :help "Go to the last node you were at"] 2708 :help "Go to the last node you were at"]
2709 ["History" Info-history :active Info-history-list
2710 :help "Go to the history buffer"]
2711 ["Table of Contents" Info-toc
2712 :help "Go to the buffer with a table of contents"]
2426 ("Index..." 2713 ("Index..."
2427 ["Lookup a String" Info-index 2714 ["Lookup a String" Info-index
2428 :help "Look for a string in the index items"] 2715 :help "Look for a string in the index items"]
@@ -2434,6 +2721,8 @@ if point is in a menu item description, follow that menu item."
2434 :active Info-enable-edit] 2721 :active Info-enable-edit]
2435 ["Copy Node Name" Info-copy-current-node-name 2722 ["Copy Node Name" Info-copy-current-node-name
2436 :help "Copy the name of the current node into the kill ring"] 2723 :help "Copy the name of the current node into the kill ring"]
2724 ["Clone Info buffer" clone-buffer
2725 :help "Create a twin copy of the current Info buffer."]
2437 ["Exit" Info-exit :help "Stop reading Info"])) 2726 ["Exit" Info-exit :help "Stop reading Info"]))
2438 2727
2439 2728
@@ -2489,7 +2778,7 @@ if point is in a menu item description, follow that menu item."
2489 (case-fold-search t)) 2778 (case-fold-search t))
2490 (save-excursion 2779 (save-excursion
2491 (goto-char (point-min)) 2780 (goto-char (point-min))
2492 (while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t) 2781 (while (re-search-forward "\\*note[ \n\t]+\\([^:]*\\):" nil t)
2493 (setq str (match-string 1)) 2782 (setq str (match-string 1))
2494 (setq i 0) 2783 (setq i 0)
2495 (while (setq i (string-match "[ \n\t]+" str i)) 2784 (while (setq i (string-match "[ \n\t]+" str i))
@@ -2562,6 +2851,8 @@ Selecting other nodes:
2562\\[Info-directory] Go to the Info directory node. 2851\\[Info-directory] Go to the Info directory node.
2563\\[Info-follow-reference] Follow a cross reference. Reads name of reference. 2852\\[Info-follow-reference] Follow a cross reference. Reads name of reference.
2564\\[Info-last] Move to the last node you were at. 2853\\[Info-last] Move to the last node you were at.
2854\\[Info-history] Go to the history buffer.
2855\\[Info-toc] Go to the buffer with a table of contents.
2565\\[Info-index] Look up a topic in this file's Index and move to that node. 2856\\[Info-index] Look up a topic in this file's Index and move to that node.
2566\\[Info-index-next] (comma) Move to the next match from a previous `i' command. 2857\\[Info-index-next] (comma) Move to the next match from a previous `i' command.
2567\\[Info-top-node] Go to the Top node of this file. 2858\\[Info-top-node] Go to the Top node of this file.
@@ -2582,6 +2873,7 @@ Moving within a node:
2582 2873
2583Advanced commands: 2874Advanced commands:
2584\\[Info-copy-current-node-name] Put name of current info node in the kill ring. 2875\\[Info-copy-current-node-name] Put name of current info node in the kill ring.
2876\\[clone-buffer] Select a new cloned Info buffer in another window.
2585\\[Info-edit] Edit contents of selected node. 2877\\[Info-edit] Edit contents of selected node.
25861 Pick first item in node's menu. 28781 Pick first item in node's menu.
25872, 3, 4, 5 Pick second ... fifth item in node's menu. 28792, 3, 4, 5 Pick second ... fifth item in node's menu.
@@ -2590,6 +2882,10 @@ Advanced commands:
2590\\[universal-argument] \\[info] Move to new Info file with completion. 2882\\[universal-argument] \\[info] Move to new Info file with completion.
2591\\[Info-search] Search through this Info file for specified regexp, 2883\\[Info-search] Search through this Info file for specified regexp,
2592 and select the node in which the next occurrence is found. 2884 and select the node in which the next occurrence is found.
2885\\[Info-search-case-sensitively] Search through this Info file
2886 for specified regexp case-sensitively.
2887\\[Info-search-next] Search for another occurrence of regexp
2888 from a previous `Info-search' command.
2593\\[Info-next-reference] Move cursor to next cross-reference or menu item. 2889\\[Info-next-reference] Move cursor to next cross-reference or menu item.
2594\\[Info-prev-reference] Move cursor to previous cross-reference or menu item." 2890\\[Info-prev-reference] Move cursor to previous cross-reference or menu item."
2595 (kill-all-local-variables) 2891 (kill-all-local-variables)
@@ -2879,17 +3175,6 @@ Preserve text properties."
2879 (push (substring string start end) matches) 3175 (push (substring string start end) matches)
2880 (apply #'concat (nreverse matches))))) 3176 (apply #'concat (nreverse matches)))))
2881 3177
2882(defun Info-fontify-menu-headers ()
2883 "Add the face `info-menu-header' to any header before a menu entry."
2884 (save-excursion
2885 (goto-char (point-min))
2886 (when (re-search-forward "^\\* Menu:" nil t)
2887 (put-text-property (match-beginning 0) (match-end 0)
2888 'font-lock-face 'info-menu-header)
2889 (while (re-search-forward "\n\n\\([^*\n ].*\\)\n\n?[*]" nil t)
2890 (put-text-property (match-beginning 1) (match-end 1)
2891 'font-lock-face 'info-menu-header)))))
2892
2893(defvar Info-next-link-keymap 3178(defvar Info-next-link-keymap
2894 (let ((keymap (make-sparse-keymap))) 3179 (let ((keymap (make-sparse-keymap)))
2895 (define-key keymap [header-line mouse-1] 'Info-next) 3180 (define-key keymap [header-line mouse-1] 'Info-next)
@@ -2919,201 +3204,313 @@ Preserve text properties."
2919 "Keymap to put on the Up link in the text or the header line.") 3204 "Keymap to put on the Up link in the text or the header line.")
2920 3205
2921(defun Info-fontify-node () 3206(defun Info-fontify-node ()
2922 ;; Only fontify the node if it hasn't already been done. 3207 "Fontify the node."
2923 (unless (let ((where (next-property-change (point-min)))) 3208 (save-excursion
2924 (and where (not (= where (point-max))))) 3209 (let* ((inhibit-read-only t)
2925 (save-excursion 3210 (case-fold-search t)
2926 (let ((inhibit-read-only t) 3211 paragraph-markers
2927 (case-fold-search t) 3212 (not-fontified-p ; the node hasn't already been fontified
2928 paragraph-markers) 3213 (not (let ((where (next-property-change (point-min))))
2929 (goto-char (point-min)) 3214 (and where (not (= where (point-max)))))))
2930 (when (looking-at "^\\(File: [^,: \t]+,?[ \t]+\\)?") 3215 (fontify-visited-p ; visited nodes need to be re-fontified
2931 (goto-char (match-end 0)) 3216 (and Info-fontify-visited-nodes
2932 (while (looking-at "[ \t]*\\([^:, \t\n]+\\):[ \t]+\\([^:,\t\n]+\\),?") 3217 ;; Don't take time to refontify visited nodes in huge nodes
2933 (goto-char (match-end 0)) 3218 (< (- (point-max) (point-min)) Info-fontify-maximum-menu-size))))
2934 (let* ((nbeg (match-beginning 2)) 3219
2935 (nend (match-end 2)) 3220 ;; Fontify header line
2936 (tbeg (match-beginning 1)) 3221 (goto-char (point-min))
2937 (tag (match-string 1))) 3222 (when (and not-fontified-p (looking-at "^\\(File: [^,: \t]+,?[ \t]+\\)?"))
2938 (if (string-equal tag "Node") 3223 (goto-char (match-end 0))
2939 (put-text-property nbeg nend 'font-lock-face 'info-header-node) 3224 (while (looking-at "[ \t]*\\([^:, \t\n]+\\):[ \t]+\\([^:,\t\n]+\\),?")
2940 (put-text-property nbeg nend 'font-lock-face 'info-header-xref) 3225 (goto-char (match-end 0))
2941 (put-text-property tbeg nend 'mouse-face 'highlight) 3226 (let* ((nbeg (match-beginning 2))
2942 (put-text-property tbeg nend 3227 (nend (match-end 2))
2943 'help-echo 3228 (tbeg (match-beginning 1))
2944 (concat "Go to node " 3229 (tag (match-string 1)))
2945 (buffer-substring nbeg nend))) 3230 (if (string-equal tag "Node")
2946 ;; Always set up the text property keymap. 3231 (put-text-property nbeg nend 'font-lock-face 'info-header-node)
2947 ;; It will either be used in the buffer 3232 (put-text-property nbeg nend 'font-lock-face 'info-header-xref)
2948 ;; or copied in the header line. 3233 (put-text-property tbeg nend 'mouse-face 'highlight)
2949 (put-text-property tbeg nend 'keymap 3234 (put-text-property tbeg nend
2950 (cond 3235 'help-echo
2951 ((equal tag "Prev") Info-prev-link-keymap) 3236 (concat "Go to node "
2952 ((equal tag "Next") Info-next-link-keymap) 3237 (buffer-substring nbeg nend)))
2953 ((equal tag "Up") Info-up-link-keymap)))))) 3238 ;; Always set up the text property keymap.
2954 (when Info-use-header-line 3239 ;; It will either be used in the buffer
2955 (goto-char (point-min)) 3240 ;; or copied in the header line.
2956 (let ((header-end (line-end-position)) 3241 (put-text-property tbeg nend 'keymap
2957 header) 3242 (cond
2958 ;; If we find neither Next: nor Prev: link, show the entire 3243 ((equal tag "Prev") Info-prev-link-keymap)
2959 ;; node header. Otherwise, don't show the File: and Node: 3244 ((equal tag "Next") Info-next-link-keymap)
2960 ;; parts, to avoid wasting precious space on information that 3245 ((equal tag "Up") Info-up-link-keymap))))))
2961 ;; is available in the mode line. 3246 (when Info-use-header-line
2962 (if (re-search-forward 3247 (goto-char (point-min))
2963 "\\(next\\|up\\|prev[ious]*\\): " 3248 (let ((header-end (line-end-position))
2964 header-end t) 3249 header)
2965 (progn 3250 ;; If we find neither Next: nor Prev: link, show the entire
2966 (goto-char (match-beginning 1)) 3251 ;; node header. Otherwise, don't show the File: and Node:
2967 (setq header (buffer-substring (point) header-end))) 3252 ;; parts, to avoid wasting precious space on information that
2968 (if (re-search-forward "node:[ \t]*[^ \t]+[ \t]*" header-end t) 3253 ;; is available in the mode line.
2969 (setq header 3254 (if (re-search-forward
2970 (concat "No next, prev or up links -- " 3255 "\\(next\\|up\\|prev[ious]*\\): "
2971 (buffer-substring (point) header-end))) 3256 header-end t)
2972 (setq header (buffer-substring (point) header-end)))) 3257 (progn
2973 3258 (goto-char (match-beginning 1))
2974 (put-text-property (point-min) (1+ (point-min)) 3259 (setq header (buffer-substring (point) header-end)))
2975 'header-line (Info-escape-percent header)) 3260 (if (re-search-forward "node:[ \t]*[^ \t]+[ \t]*" header-end t)
2976 ;; Hide the part of the first line 3261 (setq header
2977 ;; that is in the header, if it is just part. 3262 (concat "No next, prev or up links -- "
2978 (unless (bobp) 3263 (buffer-substring (point) header-end)))
2979 ;; Hide the punctuation at the end, too. 3264 (setq header (buffer-substring (point) header-end))))
2980 (skip-chars-backward " \t,") 3265 (put-text-property (point-min) (1+ (point-min))
2981 (put-text-property (point) header-end 'invisible t))))) 3266 'header-line (Info-escape-percent header))
2982 (goto-char (point-min)) 3267 ;; Hide the part of the first line
2983 (while (re-search-forward "\n\\([^ \t\n].+\\)\n\\(\\*+\\|=+\\|-+\\|\\.+\\)$" 3268 ;; that is in the header, if it is just part.
2984 nil t) 3269 (unless (bobp)
2985 (let* ((c (preceding-char)) 3270 ;; Hide the punctuation at the end, too.
2986 (face 3271 (skip-chars-backward " \t,")
2987 (cond ((= c ?*) 'Info-title-1-face) 3272 (put-text-property (point) header-end 'invisible t)))))
2988 ((= c ?=) 'Info-title-2-face) 3273
2989 ((= c ?-) 'Info-title-3-face) 3274 ;; Fontify titles
2990 (t 'Info-title-4-face)))) 3275 (goto-char (point-min))
2991 (put-text-property (match-beginning 1) (match-end 1) 3276 (when not-fontified-p
2992 'font-lock-face face)) 3277 (while (re-search-forward "\n\\([^ \t\n].+\\)\n\\(\\*+\\|=+\\|-+\\|\\.+\\)$"
2993 ;; This is a serious problem for trying to handle multiple 3278 nil t)
2994 ;; frame types at once. We want this text to be invisible 3279 (let* ((c (preceding-char))
2995 ;; on frames that can display the font above. 3280 (face
2996 (when (memq (framep (selected-frame)) '(x pc w32 mac)) 3281 (cond ((= c ?*) 'Info-title-1-face)
2997 (add-text-properties (1- (match-beginning 2)) (match-end 2) 3282 ((= c ?=) 'Info-title-2-face)
2998 '(invisible t front-sticky nil rear-nonsticky t)))) 3283 ((= c ?-) 'Info-title-3-face)
2999 (goto-char (point-min)) 3284 (t 'Info-title-4-face))))
3000 (while (re-search-forward "\\(\\*Note[ \t]*\\)\n?[ \t]*\\([^:]*\\)\\(:[^.,:(]*\\(([^)]*)[^.,:]*\\)?[,:]?\n?\\)" nil t) 3285 (put-text-property (match-beginning 1) (match-end 1)
3001 (unless (= (char-after (1- (match-beginning 0))) ?\") ; hack 3286 'font-lock-face face))
3002 (let ((start (match-beginning 0)) 3287 ;; This is a serious problem for trying to handle multiple
3003 (next (point)) 3288 ;; frame types at once. We want this text to be invisible
3004 (hide-tag Info-hide-note-references) 3289 ;; on frames that can display the font above.
3005 other-tag) 3290 (when (memq (framep (selected-frame)) '(x pc w32 mac))
3006 (when hide-tag 3291 (add-text-properties (1- (match-beginning 2)) (match-end 2)
3007 ;; *Note is often used where *note should have been 3292 '(invisible t front-sticky nil rear-nonsticky t)))))
3008 (goto-char start) 3293
3009 (skip-syntax-backward " ") 3294 ;; Fontify cross references
3010 (setq other-tag 3295 (goto-char (point-min))
3011 (cond ((memq (char-before) '(nil ?\. ?! ??)) 3296 (when (or not-fontified-p fontify-visited-p)
3012 "See ") 3297 (while (re-search-forward "\\(\\*Note[ \n\t]+\\)\\([^:]*\\)\\(:[ \t]*\\([^.,:(]*\\)\\(\\(([^)]*)\\)[^.,:]*\\)?[,:]?\n?\\)" nil t)
3013 ((memq (char-before) '(?\, ?\; ?\: ?-)) 3298 (let ((start (match-beginning 0))
3014 "see ") 3299 (next (point))
3015 ((memq (char-before) '(?\( ?\[ ?\{)) 3300 other-tag)
3016 ;; Check whether the paren is preceded by 3301 (when not-fontified-p
3017 ;; an end of sentence 3302 (when Info-hide-note-references
3018 (skip-syntax-backward " (") 3303 ;; *Note is often used where *note should have been
3019 (if (memq (char-before) '(nil ?\. ?! ??)) 3304 (goto-char start)
3020 "See " 3305 (skip-syntax-backward " ")
3021 "see ")) 3306 (setq other-tag
3022 ((save-match-data (looking-at "\n\n")) 3307 (cond ((memq (char-before) '(nil ?\. ?! ??))
3023 "See "))) 3308 "See ")
3024 (goto-char next)) 3309 ((memq (char-before) '(?\, ?\; ?\: ?-))
3025 (if hide-tag 3310 "see ")
3026 (add-text-properties (match-beginning 1) (match-end 1) 3311 ((memq (char-before) '(?\( ?\[ ?\{))
3027 '(invisible t front-sticky nil rear-nonsticky t))) 3312 ;; Check whether the paren is preceded by
3028 (add-text-properties 3313 ;; an end of sentence
3029 (match-beginning 2) (match-end 2) 3314 (skip-syntax-backward " (")
3030 (cons 'help-echo 3315 (if (memq (char-before) '(nil ?\. ?! ??))
3031 (cons (if (match-end 4) 3316 "See "
3032 (concat "mouse-2: go to " (match-string 4)) 3317 "see "))
3033 "mouse-2: go to this node") 3318 ((save-match-data (looking-at "\n\n"))
3034 '(font-lock-face info-xref 3319 "See ")))
3035 mouse-face highlight)))) 3320 (goto-char next)
3036 (when (eq Info-hide-note-references t) 3321 (add-text-properties
3037 (add-text-properties (match-beginning 3) (match-end 3) 3322 (match-beginning 1)
3038 '(invisible t front-sticky nil rear-nonsticky t))) 3323 (or (save-match-data
3039 (when other-tag 3324 ;; Don't hide \n after *Note
3040 (save-excursion 3325 (let ((start1 (match-beginning 1)))
3041 (goto-char (match-beginning 1)) 3326 (if (string-match "\n" (match-string 1))
3042 (insert other-tag))) 3327 (+ start1 (match-beginning 0)))))
3043 (when (and Info-refill-paragraphs 3328 (match-end 1))
3044 (or hide-tag (eq Info-hide-note-references t))) 3329 (if (and other-tag (not (eq Info-hide-note-references 'hide)))
3045 (push (set-marker (make-marker) start) 3330 `(display ,other-tag front-sticky nil rear-nonsticky t)
3046 paragraph-markers))))) 3331 '(invisible t front-sticky nil rear-nonsticky t))))
3047 3332 (add-text-properties
3048 (when (and Info-refill-paragraphs 3333 (match-beginning 2) (match-end 2)
3049 paragraph-markers) 3334 (list
3050 (let ((fill-nobreak-invisible t) 3335 'help-echo (if (or (match-end 5)
3051 (fill-individual-varying-indent nil) 3336 (not (equal (match-string 4) "")))
3052 (paragraph-start "\f\\|[ \t]*[-*]\\|[ \t]*$") 3337 (concat "mouse-2: go to " (or (match-string 5)
3053 (paragraph-separate ".*\\.[ \t]*\n[ \t]\\|[ \t]*[-*]\\|[ \t\f]*$") 3338 (match-string 4)))
3054 (adaptive-fill-mode nil)) 3339 "mouse-2: go to this node")
3055 (goto-char (point-max)) 3340 'mouse-face 'highlight)))
3056 (while paragraph-markers 3341 (when (or not-fontified-p fontify-visited-p)
3057 (let ((m (car paragraph-markers))) 3342 (add-text-properties
3058 (setq paragraph-markers (cdr paragraph-markers)) 3343 (match-beginning 2) (match-end 2)
3059 (when (< m (point)) 3344 (list
3060 (goto-char m) 3345 'font-lock-face
3061 (beginning-of-line) 3346 ;; Display visited nodes in a different face
3062 (let ((beg (point))) 3347 (if (and Info-fontify-visited-nodes
3063 (when (zerop (forward-paragraph)) 3348 (save-match-data
3064 (fill-individual-paragraphs beg (point) nil nil) 3349 (let* ((node (replace-regexp-in-string
3065 (goto-char beg)))) 3350 "^[ \t]+" ""
3066 (set-marker m nil))))) 3351 (replace-regexp-in-string
3067 3352 "[ \t\n]+" " "
3068 (goto-char (point-min)) 3353 (or (match-string 5)
3069 (when (and (search-forward "\n* Menu:" nil t) 3354 (and (not (equal (match-string 4) ""))
3070 (not (string-match "\\<Index\\>" Info-current-node)) 3355 (match-string 4))
3071 ;; Don't take time to annotate huge menus 3356 (match-string 2)))))
3072 (< (- (point-max) (point)) Info-fontify-maximum-menu-size)) 3357 (file (file-name-nondirectory
3073 (let ((n 0) 3358 Info-current-file))
3074 cont) 3359 (hl Info-history-list)
3075 (while (re-search-forward 3360 res)
3076 (concat "^\\* +\\(" Info-menu-entry-name-re "\\)\\(:" 3361 (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node)
3077 Info-node-spec-re "\\([ \t]*\\)\\)") 3362 (setq file (match-string 1 node)
3078 nil t) 3363 node (if (equal (match-string 2 node) "")
3079 (setq n (1+ n)) 3364 "Top"
3080 (if (and (<= n 9) (zerop (% n 3))) ; visual aids to help with 1-9 keys 3365 (match-string 2 node))))
3081 (put-text-property (match-beginning 0) 3366 (while hl
3082 (1+ (match-beginning 0)) 3367 (if (and (string-equal node (nth 1 (car hl)))
3083 'font-lock-face 'info-menu-5)) 3368 (string-equal file
3084 (add-text-properties 3369 (file-name-nondirectory
3085 (match-beginning 1) (match-end 1) 3370 (nth 0 (car hl)))))
3086 (cons 'help-echo 3371 (setq res (car hl) hl nil)
3087 (cons 3372 (setq hl (cdr hl))))
3088 (if (match-end 3) 3373 res))) 'info-xref-visited 'info-xref))))
3089 (concat "mouse-2: go to " (match-string 3)) 3374 (when not-fontified-p
3090 "mouse-2: go to this node") 3375 (when (memq Info-hide-note-references '(t hide))
3091 '(font-lock-face info-xref 3376 (add-text-properties (match-beginning 3) (match-end 3)
3092 mouse-face highlight)))) 3377 '(invisible t front-sticky nil rear-nonsticky t))
3093 (when (eq Info-hide-note-references t) 3378 ;; Unhide the file name of the external reference in parens
3094 (put-text-property (match-beginning 2) (1- (match-end 6)) 3379 (if (match-string 6)
3095 'invisible t) 3380 (remove-text-properties (match-beginning 6) (match-end 6)
3096 ;; We need a stretchable space like :align-to but with 3381 '(invisible t front-sticky nil rear-nonsticky t)))
3097 ;; a minimum value. 3382 ;; Unhide newline because hidden newlines cause too long lines
3098 (put-text-property (1- (match-end 6)) (match-end 6) 'display 3383 (save-match-data
3099 (if (>= 22 (- (match-end 1) 3384 (let ((start3 (match-beginning 3)))
3100 (match-beginning 0))) 3385 (if (string-match "\n[ \t]*" (match-string 3))
3101 '(space :align-to 24) 3386 (remove-text-properties (+ start3 (match-beginning 0)) (+ start3 (match-end 0))
3102 '(space :width 2))) 3387 '(invisible t front-sticky nil rear-nonsticky t))))))
3103 (setq cont (looking-at ".")) 3388 (when (and Info-refill-paragraphs Info-hide-note-references)
3104 (while (and (= (forward-line 1) 0) 3389 (push (set-marker (make-marker) start)
3105 (looking-at "\\([ \t]+\\)[^*\n]")) 3390 paragraph-markers))))))
3106 (put-text-property (match-beginning 1) (1- (match-end 1)) 3391
3107 'invisible t) 3392 ;; Refill paragraphs (experimental feature)
3108 (put-text-property (1- (match-end 1)) (match-end 1) 3393 (when (and not-fontified-p
3109 'display 3394 Info-refill-paragraphs
3110 (if cont 3395 paragraph-markers)
3111 '(space :align-to 26) 3396 (let ((fill-nobreak-invisible t)
3112 '(space :align-to 24))) 3397 (fill-individual-varying-indent nil)
3113 (setq cont t)))))) 3398 (paragraph-start "\f\\|[ \t]*[-*]\\|[ \t]*$")
3114 3399 (paragraph-separate ".*\\.[ \t]*\n[ \t]\\|[ \t]*[-*]\\|[ \t\f]*$")
3115 (Info-fontify-menu-headers) 3400 (adaptive-fill-mode nil))
3116 (set-buffer-modified-p nil))))) 3401 (goto-char (point-max))
3402 (while paragraph-markers
3403 (let ((m (car paragraph-markers)))
3404 (setq paragraph-markers (cdr paragraph-markers))
3405 (when (< m (point))
3406 (goto-char m)
3407 (beginning-of-line)
3408 (let ((beg (point)))
3409 (when (zerop (forward-paragraph))
3410 (fill-individual-paragraphs beg (point) nil nil)
3411 (goto-char beg))))
3412 (set-marker m nil)))))
3413
3414 ;; Fontify menu items
3415 (goto-char (point-min))
3416 (when (and (or not-fontified-p fontify-visited-p)
3417 (search-forward "\n* Menu:" nil t)
3418 (not (string-match "\\<Index\\>" Info-current-node))
3419 ;; Don't take time to annotate huge menus
3420 (< (- (point-max) (point)) Info-fontify-maximum-menu-size))
3421 (let ((n 0)
3422 cont)
3423 (while (re-search-forward
3424 (concat "^\\* +\\(" Info-menu-entry-name-re "\\)\\(:"
3425 Info-node-spec-re "\\([ \t]*\\)\\)")
3426 nil t)
3427 (when not-fontified-p
3428 (setq n (1+ n))
3429 (if (and (<= n 9) (zerop (% n 3))) ; visual aids to help with 1-9 keys
3430 (put-text-property (match-beginning 0)
3431 (1+ (match-beginning 0))
3432 'font-lock-face 'info-menu-5)))
3433 (when not-fontified-p
3434 (add-text-properties
3435 (match-beginning 1) (match-end 1)
3436 (list
3437 'help-echo (if (match-end 3)
3438 (concat "mouse-2: go to " (match-string 3))
3439 "mouse-2: go to this node")
3440 'mouse-face 'highlight)))
3441 (when (or not-fontified-p fontify-visited-p)
3442 (add-text-properties
3443 (match-beginning 1) (match-end 1)
3444 (list
3445 'font-lock-face
3446 ;; Display visited menu items in a different face
3447 (if (and Info-fontify-visited-nodes
3448 (save-match-data
3449 (let ((node (if (equal (match-string 3) "")
3450 (match-string 1)
3451 (match-string 3)))
3452 (file (file-name-nondirectory Info-current-file))
3453 (hl Info-history-list)
3454 res)
3455 (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node)
3456 (setq file (match-string 1 node)
3457 node (if (equal (match-string 2 node) "")
3458 "Top"
3459 (match-string 2 node))))
3460 (while hl
3461 (if (and (string-equal node (nth 1 (car hl)))
3462 (string-equal file
3463 (file-name-nondirectory
3464 (nth 0 (car hl)))))
3465 (setq res (car hl) hl nil)
3466 (setq hl (cdr hl))))
3467 res))) 'info-xref-visited 'info-xref))))
3468 (when (and not-fontified-p (memq Info-hide-note-references '(t hide)))
3469 (put-text-property (match-beginning 2) (1- (match-end 6))
3470 'invisible t)
3471 ;; Unhide the file name in parens
3472 (if (and (match-end 4) (not (eq (char-after (match-end 4)) ?.)))
3473 (remove-text-properties (match-beginning 4) (match-end 4)
3474 '(invisible t)))
3475 ;; We need a stretchable space like :align-to but with
3476 ;; a minimum value.
3477 (put-text-property (1- (match-end 6)) (match-end 6) 'display
3478 (if (>= 22 (- (match-end 1)
3479 (match-beginning 0)))
3480 '(space :align-to 24)
3481 '(space :width 2)))
3482 (setq cont (looking-at "."))
3483 (while (and (= (forward-line 1) 0)
3484 (looking-at "\\([ \t]+\\)[^*\n]"))
3485 (put-text-property (match-beginning 1) (1- (match-end 1))
3486 'invisible t)
3487 (put-text-property (1- (match-end 1)) (match-end 1)
3488 'display
3489 (if cont
3490 '(space :align-to 26)
3491 '(space :align-to 24)))
3492 (setq cont t))))))
3493
3494 ;; Fontify menu headers
3495 ;; Add the face `info-menu-header' to any header before a menu entry
3496 (goto-char (point-min))
3497 (when (and not-fontified-p (re-search-forward "^\\* Menu:" nil t))
3498 (put-text-property (match-beginning 0) (match-end 0)
3499 'font-lock-face 'info-menu-header)
3500 (while (re-search-forward "\n\n\\([^*\n ].*\\)\n\n?[*]" nil t)
3501 (put-text-property (match-beginning 1) (match-end 1)
3502 'font-lock-face 'info-menu-header)))
3503
3504 ;; Fontify http and ftp references
3505 (goto-char (point-min))
3506 (when not-fontified-p
3507 (while (re-search-forward "[hf]t?tp://[^ \t\n\"`({<>})']+" nil t)
3508 (add-text-properties (match-beginning 0) (match-end 0)
3509 '(font-lock-face info-xref
3510 mouse-face highlight
3511 help-echo "mouse-2: go to this URL"))))
3512
3513 (set-buffer-modified-p nil))))
3117 3514
3118 3515
3119;; When an Info buffer is killed, make sure the associated tags buffer 3516;; When an Info buffer is killed, make sure the associated tags buffer