New org capture template
[emacs.git] / .emacs.d / elisp / icicle / info+.el
1 ;;; info+.el --- Extensions to `info.el'.
2 ;;
3 ;; Filename: info+.el
4 ;; Description: Extensions to `info.el'.
5 ;; Author: Drew Adams
6 ;; Maintainer: Drew Adams
7 ;; Copyright (C) 1996-2012, Drew Adams, all rights reserved.
8 ;; Created: Tue Sep 12 16:30:11 1995
9 ;; Version: 21.1
10 ;; Last-Updated: Sun Jan 15 00:50:02 2012 (-0800)
11 ;; By: dradams
12 ;; Update #: 4495
13 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/info+.el
14 ;; Keywords: help, docs, internal
15 ;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x
16 ;;
17 ;; Features that might be required by this library:
18 ;;
19 ;; `fit-frame', `info', `info+', `misc-fns', `strings',
20 ;; `thingatpt', `thingatpt+'.
21 ;;
22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
23 ;;
24 ;;; Commentary:
25 ;;
26 ;; Extensions to `info.el'.
27 ;;
28 ;; Faces defined here:
29 ;;
30 ;; `info-command-ref-item', `info-file',
31 ;; `info-function-ref-item',`info-macro-ref-item', `info-menu',
32 ;; `info-node', `info-quoted-name', `info-reference-item',
33 ;; `info-single-quote', `info-special-form-ref-item',
34 ;; `info-string', `info-syntax-class-item',
35 ;; `info-user-option-ref-item', `info-variable-ref-item',
36 ;; `info-xref', `minibuffer-prompt'.
37 ;;
38 ;; Options (user variables) defined here:
39 ;;
40 ;; `Info-breadcrumbs-in-header-flag' (Emacs 23+),
41 ;; `Info-display-node-header-fn', `Info-fit-frame-flag',
42 ;; `Info-fontify-quotations-flag',
43 ;; `Info-fontify-reference-items-flag',
44 ;; `Info-fontify-single-quote-flag', `Info-saved-nodes',
45 ;; `Info-subtree-separator'.
46 ;;
47 ;; Commands defined here:
48 ;;
49 ;; `Info-breadcrumbs-in-mode-line-mode' (Emacs 23+),
50 ;; `info-emacs-manual', `Info-follow-nearest-node-new-window',
51 ;; `Info-merge-subnodes',
52 ;; `Info-mouse-follow-nearest-node-new-window',
53 ;; `Info-save-current-node', `Info-set-breadcrumbs-depth' (Emacs
54 ;; 23+), `Info-toggle-breadcrumbs-in-header-line' (Emacs 23+),
55 ;; `Info-virtual-book', `menu-bar-read-lispref',
56 ;; `menu-bar-read-lispintro',
57 ;;
58 ;; Non-interactive functions defined here:
59 ;;
60 ;; `Info-display-node-default-header',
61 ;; `Info-display-node-time-header', `info-fontify-quotations',
62 ;; `info-fontify-reference-items',
63 ;; `Info-insert-breadcrumbs-in-mode-line' (Emacs 23+),
64 ;; `info-quotation-regexp'.
65 ;;
66 ;; Internal variables defined here:
67 ;;
68 ;; `Info-breadcrumbs-depth-internal' (Emacs 23+),
69 ;; `Info-merged-map', `Info-mode-syntax-table'.
70 ;;
71 ;;
72 ;; ***** NOTE: The following standard faces defined in `info.el'
73 ;; (Emacs 21+) have been REDEFINED HERE:
74 ;;
75 ;; `info-title-1', `info-title-2', `info-title-3', `info-title-4'.
76 ;;
77 ;;
78 ;; ***** NOTE: The following standard functions defined in `info.el'
79 ;; have been REDEFINED HERE:
80 ;;
81 ;; `info-display-manual' - Use completion to input manual name.
82 ;; `Info-find-emacs-command-nodes' - Added in-progress message.
83 ;; `Info-find-file' (Emacs 23+) - Handle virtual books.
84 ;; `Info-find-node', `Info-find-node-2' -
85 ;; Call `fit-frame' if `Info-fit-frame-flag'.
86 ;; `Info-fontify-node' -
87 ;; 1. Show breadcrumbs in header line and/or mode line.
88 ;; 2. File name in face `info-file'.
89 ;; 3. Node names in face `info-node'.
90 ;; 4. Menu items in face `info-menu'.
91 ;; 5. Only 5th and 9th menu items have their `*' colored.
92 ;; 6. Notes in face `info-xref'.
93 ;; 7. If `Info-fontify-quotations-flag', then fontify `...' in
94 ;; face `info-quoted-name' and "..." in face `info-string'.
95 ;; 8. If `Info-fontify-single-quote-flag' and
96 ;; `Info-fontify-quotations-flag', then fontify ' in face
97 ;; `info-single-quote'.
98 ;; `Info-goto-emacs-command-node' -
99 ;; 1. Uses `completing-read' in interactive spec, with,
100 ;; as default, `symbol-nearest-point'.
101 ;; 2. Message if single node found.
102 ;; 3. Returns `num-matches' if found; nil if not.
103 ;; `Info-goto-emacs-key-command-node' -
104 ;; If key's command not found, then `Info-search's for key
105 ;; sequence in text and displays message about repeating.
106 ;; `Info-mode' - Doc string shows all bindings.
107 ;; `Info-read-node-name-1' - Treat file name entries, e.g. "(emacs)".
108 ;; `Info-search' - 1. Fits frame.
109 ;; 2. Highlights found regexp if `search-highlight'.
110 ;; `Info-set-mode-line' - Handles breadcrumbs in the mode line.
111 ;; `Info-mouse-follow-nearest-node' (Emacs 21+) -
112 ;; With prefix arg, show node in new info buffer.
113 ;;
114 ;;
115 ;; ***** NOTE: The following behavior defined in `info.el'
116 ;; has been changed.
117 ;;
118 ;; "*info" has been removed from `same-window-buffer-names', so that
119 ;; a separate window can be used if the user so chooses.
120 ;;
121 ;;
122 ;; Suggestion: Use a medium-dark background for Info. Try, for
123 ;; example, setting the background to "LightSteelBlue" in your
124 ;; `~/.emacs' file. You can do this as follows:
125 ;;
126 ;; (setq special-display-buffer-names
127 ;; (cons '("*info*" (background-color . "LightSteelBlue"))
128 ;; special-display-buffer-names))
129 ;;
130 ;; Alternatively, you can change the background value of
131 ;; `special-display-frame-alist' and set `special-display-regexps' to
132 ;; something matching "*info*":
133 ;;
134 ;; (setq special-display-frame-alist
135 ;; (cons '(background-color . "LightSteelBlue")
136 ;; special-display-frame-alist))
137 ;; (setq special-display-regexps '("[ ]?[*][^*]+[*]"))
138 ;;
139 ;; If you do use a medium-dark background for Info, consider
140 ;; customizing face to a lighter foreground color - I use "Yellow".
141 ;;
142 ;; Also, consider customizing face `link' to remove its underline
143 ;; attribute.
144 ;;
145 ;;
146 ;; The following bindings are made here for Info-mode:
147 ;;
148 ;; `?' `describe-mode' (replaces `Info-summary')
149 ;; `+' `Info-merge-subnodes'
150 ;; `.' `Info-save-current-node'
151 ;; `a' `info-apropos'
152 ;; `v' `Info-virtual-book'
153 ;; `mouse-4' `Info-history-back'
154 ;; `mouse-5' `Info-history-forward'
155 ;; `S-down-mouse-2' `Info-mouse-follow-nearest-node-new-window'
156 ;; `S-RET' `Info-follow-nearest-node-new-window'
157 ;;
158 ;; The following bindings are made here for merged Info buffers:
159 ;;
160 ;; `.' `beginning-of-buffer'
161 ;; `b' `beginning-of-buffer'
162 ;; `q' `quit-window'
163 ;; `s' `nonincremental-re-search-forward'
164 ;; `M-s' `nonincremental-re-search-forward'
165 ;; `TAB' `Info-next-reference'
166 ;; `ESC TAB' `Info-prev-reference'
167 ;;
168 ;;
169 ;;
170 ;; This file should be loaded after loading the standard GNU file
171 ;; `info.el'. So, in your `~/.emacs' file, do this:
172 ;; (eval-after-load "info" '(require 'info+))
173 ;;
174 ;;
175 ;; Acknowledgement:
176 ;;
177 ;; Lennart Borgman and Stefan Monnier for regexp suggestions.
178 ;;
179 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
180 ;;
181 ;;; Change Log:
182 ;;
183 ;; 2012/01/15 dadams
184 ;; Added: info-display-manual (redefinition).
185 ;; Info-find-file: Do not define for < Emacs 23.2 - no virtual books.
186 ;; 2011/11/15 dadams
187 ;; Added: redefinition of Info-find-file for Emacs 23+, to handle virtual books.
188 ;; 2011/08/23 dadams
189 ;; Removed hard-code removal of info from same-window-(regexps|buffer-names). Thx to PasJa.
190 ;; 2011/02/06 dadams
191 ;; info-user-option-ref-item: Corrected background for light-bg case.
192 ;; 2011/02/03 dadams
193 ;; All deffaces: Provided default values for dark-background screens too.
194 ;; 2011/01/04 dadams
195 ;; Removed autoload cookies from non def* sexps. Added for defgroup and defface.
196 ;; 2010/05/27 dadams
197 ;; Added: Info-set-mode-line.
198 ;; Info-find-node-2:
199 ;; Added redefinition of it for Emacs 23.2 (sigh, they keep twiddling it).
200 ;; Do not call Info-insert-breadcrumbs-in-mode-line. Do that in Info-set-mode-line now.
201 ;; 2010/04/06 dadams
202 ;; Added: Info-breadcrumbs-in-header-flag, Info-toggle-breadcrumbs-in-header-line,
203 ;; Info-breadcrumbs-in-mode-line-mode, Info-set-breadcrumbs-depth,
204 ;; Info-insert-breadcrumbs-in-mode-line, Info-breadcrumbs-depth-internal.
205 ;; Added to Info-mode-menu (Emacs 23+): Info-breadcrumbs-in-mode-line-mode.
206 ;; Info-find-node-2 (Emacs 23+): Add breadcrumbs to header line & mode line only according to vars.
207 ;; Info-fontify-node (Emacs 23+): Handle breadcrumbs in header only if flag says to.
208 ;; 2010/01/12 dadams
209 ;; Info-find-node for Emacs 20, Info-find-node-2 for Emacs 21, 22, Info-search:
210 ;; save-excursion + set-buffer -> with-current-buffer.
211 ;; 2010/01/10 dadams
212 ;; Info-find-node-2 for Emacs 23+: Updated for Emacs 23.2 (pretest) - virtual function stuff.
213 ;; 2009/12/13 dadams
214 ;; Typo: Incorrectly used Emacs 22 version for Emacs 21 also.
215 ;; 2009/12/11 dadams
216 ;; info-fontify-(node|quotations|reference-items), Info-merge-subnodes:
217 ;; Use font-lock-face property, not face, if > Emacs 21.
218 ;; 2009/08/03 dadams
219 ;; Updated for Emacs 23.1 release: Info-find-node-2, Info-fontify-node, Info-search: new version.
220 ;; 2009/06/10 dadams
221 ;; Added: Info-fontify-reference-items-flag, Info-mode-syntax-table.
222 ;; Info-mode: Use Info-mode-syntax-table, not text-mode-syntax-table.
223 ;; Info-fontify-node: Fontify ref items if *-reference-items-flag, not just for Elisp manual.
224 ;; Renamed: info-elisp-* to info-*.
225 ;; 2009/06/09 dadams
226 ;; info-fontify-quotations: Allow \ before ', just not before`.
227 ;; 2009/06/08 dadams
228 ;; info-fontify-quotations: Rewrote, using better regexp. Don't fontify escaped ` or '.
229 ;; Fontify `\', `\\', etc. Respect Info-fontify-single-quote-flag.
230 ;; Added: info-single-quote, Info-fontify-single-quote-flag, info-quotation-regexp.
231 ;; info-quoted-name: Changed face spec to (:inherit font-lock-string-face :foreground "DarkViolet")
232 ;; 2009/05/25 dadams
233 ;; Info-virtual-book: Treat info-node bookmarks too.
234 ;; 2009/05/23 dadams
235 ;; Added: Info-mode for Emacs 23.
236 ;; They added Info-isearch-filter, Info-revert-buffer-function, Info-bookmark-make-record.
237 ;; 2009/05/22 dadams
238 ;; Added: Info-saved-nodes, Info-save-current-node, Info-virtual-book. Added to Info-mode-menu.
239 ;; Bind info-apropos, Info-save-current-node, Info-virtual-book to a, ., and v.
240 ;; Info-mode: Updated doc string.
241 ;; 2009/04/26 dadams
242 ;; Info-merge-subnodes: Bind inhibit-field-text-motion to t, for end-of-line.
243 ;; 2008/10/07 dadams
244 ;; Require cl.el at compile time for all Emacs versions, because of case.
245 ;; 2008/10/05 dadams
246 ;; Added: Info-read-node-name-1, Info-read-node-name-2.
247 ;; 2008-07-11 dadams
248 ;; Info-fontify-node (Emacs 22+): Protect histories when getting ancestor nodes for breadcrumbs.
249 ;; (Emacs 22+) Don't change faces info-menu-header, *-title-*, *(-header)-node, header-line.
250 ;; (Emacs 20, 21): Removed bold and italic attributes from info-node and info-xref.
251 ;; Removed commented out defface for info-xref and info-node.
252 ;; Face info-file: Blue, not DarkBlue, foreground, by default.
253 ;; 2008/06/12 dadams
254 ;; Info-fontify-node (Emacs 22+):
255 ;; Prevent infinite recursion from Info-goto-node calling Info-fontify-node.
256 ;; Fixed for nil Info-hide-note-references.
257 ;; 2008/06/10 dadams
258 ;; Info-fontify-node (Emacs 22+): Added breadcrumbs.
259 ;; 2008/03/06 dadams
260 ;; info-mode:
261 ;; Use fboundp for Info-clone-buffer, not version test, for Emacs 22+. Thx to Sebastien Vauban.
262 ;; 2008/02/01 dadams
263 ;; Info-mode: Renamed Info-clone-buffer-hook to Info-clone-buffer for Emacs 22.1.90.
264 ;; 2008/01/08 dadams
265 ;; Info-search (Emacs 22): Removed phony pred arg.
266 ;; 2008/01/06 dadams
267 ;; Removed soft require of Icicles due to cirular dependency. Thx to Tennis Smith.
268 ;; 2007/11/27 dadams
269 ;; Info-search: Use icicle-read-string-completing, if available.
270 ;; Added soft require Icicles.
271 ;; 2007/11/20 dadams
272 ;; Info-subtree-separator: Escaped slashes in doc string: \f -> \\f.
273 ;; 2007/09/26 dadams
274 ;; Better default color for info-quoted-name. Added group face to all deffaces.
275 ;; 2007/09/25 dadams
276 ;; Bound Info-mouse-*-new-* to S-down-mouse-2, not S-mouse-2, because of mouse-scan-lines-or-M-:.
277 ;; Info-goto-emacs-command-node: Convert completion default value to string.
278 ;; 2007/08/27 dadams
279 ;; Info-fontify-node:
280 ;; Ensure Info-fontify-node is a string when fontifiy quotations. Updated for released Emacs 22.
281 ;; 2007/07/13 dadams
282 ;; Info-find-node: Redefine only for Emacs < 21.
283 ;; 2006/09/15 dadams
284 ;; Info-mouse-follow-nearest-node redefinition is only for Emacs >= 22.
285 ;; Changed Emacs 22 tests to just (>= emacs-major-version 22).
286 ;; Bind tool-bar-map for Emacs 21. Otherwise, binding of [tool-bar] gives an error (why?).
287 ;; 2006/08/18 dadams
288 ;; Everywhere: Corrected previous change: minibuffer-selected-window to window-minibuffer-p.
289 ;; 2006/08/14 dadams
290 ;; Everywhere: fit-frame only if not a minibuffer window.
291 ;; 2006/08/12 dadams
292 ;; Info-merge-subnodes: Bug fixes:
293 ;; Added concat for insertion of main node when recursive-display-p is negative.
294 ;; Don't recurse down Index menus.
295 ;; When checking for subnodes menu, check for nonfile menu item also.
296 ;; After come back from recursion, go back to Info buffer before trying to go back in history.
297 ;; Call fit-frame at end.
298 ;; 2006/06/10 dadams
299 ;; Added: Info(-mouse)-follow-nearest-node-new-window. Bound to S-RET, S-mouse-2.
300 ;; 2006/03/31 dadams
301 ;; info-menu-header: Removed :underline, because links are underlined in Emacs 22.
302 ;; No longer use display-in-minibuffer.
303 ;; 2006/01/08 dadams
304 ;; Added: redefinition of Info-mouse-follow-nearest-node.
305 ;; 2006/01/07 dadams
306 ;; Added :link for sending bug report.
307 ;; 2006/01/06 dadams
308 ;; Added defgroup Info-Plus and used it. Added :link.
309 ;; 2005/12/30 dadams
310 ;; Moved everything from setup-info.el to here, after getting rid of some of it.
311 ;; Use defface for all faces. Renamed faces, without "-face".
312 ;; Use minibuffer-prompt face, not info-msg-face.
313 ;; No longer require setup-info.el. No longer require cl.el when compile.
314 ;; 2005/11/21 dadams
315 ;; Info-search for Emacs 22: Don't display repeat `s' message if isearch-mode.
316 ;; 2005/11/09 dadams
317 ;; Info-fontify-node: Updated to reflect latest CVS (replaced Info-escape-percent header).
318 ;; 2005/10/31 dadams
319 ;; Use nil as init-value arg in calls to completing-read, everywhere.
320 ;; 2005/07/04 dadams
321 ;; info-fontify-quotations: Use font-lock-face property, instead of face, for Emacs 22.
322 ;; Wrap re-search-forward in condition-case for stack overflow.
323 ;; 2005/07/02 dadams
324 ;; Info-search: fit-frame. Added Emacs 22 version too.
325 ;; Info-goto-emacs-command-node, Info-goto-emacs-key-command-node,
326 ;; Info-merge-subnodes: Use Info-history-back for Emacs 22.
327 ;; Info-mode: Added Emacs 22 version.
328 ;; 2005/06/23 dadams
329 ;; Info-fontify-node: Fontify reference items if in Emacs-Lisp manual.
330 ;; Added: info-fontify-reference-items
331 ;; 2005/05/17 dadams
332 ;; Updated to work with Emacs 22.x.
333 ;; 2004/11/20 dadams
334 ;; Info-find-emacs-command-nodes: bug fix: regexp (cmd-desc) was only for Emacs 21.
335 ;; Refined to deal with Emacs 21 < 21.3.50 (soon to be 22.x)
336 ;; 2004/10/09 dadams
337 ;; info-fontify-quotations:
338 ;; 1) Allow all characters inside `...'.
339 ;; 2) Treat case of "..." preceded by backslashes
340 ;; Info-fontify-node (for Emacs 21): Moved info-fontify-quotations
341 ;; before fontification of titles.
342 ;; 2004/10/07 dadams
343 ;; Renamed Info-resize-frame-p to Info-fit-frame-flag.
344 ;; 2004/10/05 dadams
345 ;; Improved regexp treatment further for fontifying quotations.
346 ;; 2004/10/04 dadams
347 ;; Improved regexp treatment for fontifying quotations.
348 ;; Added info-fontify-quotations. Removed info-fontify-strings-p.
349 ;; Renamed Info-fontify-quotations-p to Info-fontify-quotations-flag.
350 ;; 2004/10/03/dadams
351 ;; Major update: updated to work with Emacs 21 also.
352 ;; Made require of setup-info.el mandatory.
353 ;; Removed all variables and keys to setup-info.el.
354 ;; Renamed to Emacs 21 names and only define for Emacs < 21:
355 ;; emacs-info -> info-emacs-manual
356 ;; 2004/09/28 dadams
357 ;; Removed dir-info (same as Info-directory).
358 ;; Renamed to Emacs 21 names and only define for Emacs < 21:
359 ;; emacs-lisp-info -> menu-bar-read-lispref
360 ;; 2004/06/01 dadams
361 ;; Renamed: Info-fit-frame-p to Info-resize-frame-p
362 ;; and shrink-frame-to-fit to resize-frame.
363 ;; 2000/09/27 dadams
364 ;; 1. Added: Info-fit-frame-p.
365 ;; 2. Info-find-node: added shrink-frame-to-fit.
366 ;; 1999/04/14 dadams
367 ;; Info-fontify-node: Fontify indexes too.
368 ;; 1999/04/14 dadams
369 ;; 1. Added vars: info-file-face, info-menu-face, info-node-face,
370 ;; info-quoted-name-face, info-string-face, info-xref-face.
371 ;; 2. No longer use (or define) faces: info-node, info-file, info-xref,
372 ;; info-menu-5, info-quoted-name, info-string.
373 ;; 3. Info-fontify-node: Use new face variables instead of faces in #2, above.
374 ;; Corrected: node names in info-node-face (was xref). Use info-menu-face
375 ;; for * and menu item.
376 ;; 4. Info-mode: Redefined like original, but: no make-face's; use face vars.
377 ;; Added user options description to doc string.
378 ;; 1999/04/08 dadams
379 ;; Info-goto-emacs-key-command-node: regexp-quote pp-key for Info-search.
380 ;; 1999/04/07 dadams
381 ;; Info-goto-emacs-key-command-node: a) messages only if interactive,
382 ;; b) return nil if not found, else non-nil, c) "is undefined" -> "doc not
383 ;; found", d) use display-in-minibuffer more, e) corrected error handler.
384 ;; 1999/04/01 dadams
385 ;; 1. Added: (remove-hook 'same-window-buffer-names "*info*").
386 ;; 2. Info-find-node: switch-to-buffer-other-window -> pop-to-buffer.
387 ;; 1999/03/31 dadams
388 ;; 1. Added (put 'Info-goto-emacs-(key-)command-node 'info-file "emacs").
389 ;; 2. Info-find-node: Mention searched file in error messages.
390 ;; 3. Added (replacement): Info-find-emacs-command-nodes, with progress msg.
391 ;; 4. a. Info-goto-emacs-key-command-node: Use global-map, unless menu item.
392 ;; b. Added message "Not found using Index ...".
393 ;; 1999/03/31 dadams
394 ;; 1. Info-goto-emacs(-key)-command-node: Only display-in-minibuffer if
395 ;; interactive-p.
396 ;; 2. Info-goto-emacs-key-command-node: Messages: "key"; other entries.
397 ;; 1999/03/31 dadams
398 ;; 1. Added (put 'info 'info-file "emacs") so find doc on `info' cmd.
399 ;; 2. Info-goto-emacs-command-node:
400 ;; a. Added message when =< 1 match.
401 ;; b. Return num-matches if found.
402 ;; c. Uses `display-in-minibuffer' instead of `message'.
403 ;; 3. a. Wrapped call to Info-search in condition-case, not if.
404 ;; b. Info-goto-emacs-key-command-node: Return num-matches if found.
405 ;; 1999/03/30 dadams
406 ;; 1. Added Info menu bar menu.
407 ;; 2. Info-goto-emacs-command-node: Only error if interactive-p.
408 ;; 3. Info-goto-emacs-key-command-node:
409 ;; a. Print key in msgs
410 ;; b. If Info-goto-emacs-command-node doesn't find it, then try
411 ;; Info-search. If found & interactive-p, then msg ("repeat").
412 ;; Else error.
413 ;; 4. Info-search: Msg ("repeat") if found & interactive-p.
414 ;; 1999/03/17 dadams
415 ;; 1. Updated to correspond with Emacs 34.1 version.
416 ;; 2. Protect with fboundp.
417 ;; 1996/07/11 dadams
418 ;; Added redefinitions of Info-goto-emacs-(key-)command-node.
419 ;; 1996/04/26 dadams
420 ;; Put escaped newlines on long-line strings.
421 ;; 1996/04/16 dadams
422 ;; Added: info-file, info-quoted-name, info-string, Info-fontify-quotations-flag,
423 ;; info-fontify-strings-p. Take into account in Info-fontify-node.
424 ;; 1996/02/23 dadams
425 ;; 1. Changed binding of Info-merge-subnodes back to `r', but now
426 ;; requires user confirmation when invoked.
427 ;; 2. Info-subtree-separator: Incorporates "\n* ". variable-interactive prop.
428 ;; 1996/02/22 dadams
429 ;; display-Info-node-subtree:
430 ;; 1. display-Info-node-subtree -> Info-merge-subnodes (renamed).
431 ;; 2. Changed binding of Info-merge-subnodes from `r' to `C-d'.
432 ;; 3. Don't pick up text between menu-item-line and "\n* ". Hardwire "\n* ".
433 ;; 4. Untabify menu-item-line, so can count chars to underline.
434 ;; 5. indent-rigidly, not indent-region.
435 ;; 1996/02/22 dadams
436 ;; 1. Bind describe-mode and display-Info-node-subtree.
437 ;; 2. Added redefinition of Info-mode: Only the doc string was changed.
438 ;; 3. Added Info-subtree-separator.
439 ;; 3. display-Info-node-subtree: Info-subtree-separator. Doc. Garbage-collect.
440 ;; 1996/02/22 dadams
441 ;; Info-merge-subnodes: Rewrote it, adding optional args. Renamed (defaliased) it
442 ;; to display-Info-node-subtree.
443 ;; 1996/02/22 dadams
444 ;; Added redefinition of Info-merge-subnodes (cleanup, corrections).
445 ;; 1996/02/20 dadams
446 ;; 1. Make info-node, info-xref, info-menu-5 here. (Diff faces than before.)
447 ;; 2. Added redefinition of Info-find-node. (Uses other window.)
448 ;;
449 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
450 ;;
451 ;; This program is free software; you can redistribute it and/or modify
452 ;; it under the terms of the GNU General Public License as published by
453 ;; the Free Software Foundation; either version 2, or (at your option)
454 ;; any later version.
455
456 ;; This program is distributed in the hope that it will be useful,
457 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
458 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
459 ;; GNU General Public License for more details.
460
461 ;; You should have received a copy of the GNU General Public License
462 ;; along with this program; see the file COPYING. If not, write to
463 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
464 ;; Floor, Boston, MA 02110-1301, USA.
465 ;;
466 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
467 ;;
468 ;;; Code:
469
470 (require 'info)
471 (eval-when-compile (require 'cl)) ;; case
472 ;; Plus, for Emacs < 20, caar, cadr, when, unless
473
474 ;; These are optional, for cosmetic purposes.
475 (require 'thingatpt nil t) ;; (no error if not found): symbol-at-point
476 (require 'thingatpt+ nil t) ;; (no error if not found): symbol-nearest-point
477 (require 'strings nil t) ;; (no error if not found): concat-w-faces
478 (require 'fit-frame nil t) ;; (no error if not found): fit-frame
479
480 ;; Took this out because it leads to a circular `require' dependency.
481 ;; (when (>= emacs-major-version 22)
482 ;; (require 'icicles nil t)) ;; (no error if not found): icicle-read-string-completing
483
484 ;; Quiet the byte compiler a bit.
485 ;;
486 ;; (when (< emacs-major-version 21)
487 ;; (eval-when-compile
488 (defvar desktop-save-buffer)
489 (defvar header-line-format)
490 (defvar Info-breadcrumbs-in-mode-line-mode)
491 (defvar Info-fontify-visited-nodes)
492 (defvar Info-hide-note-references)
493 (defvar Info-history-list)
494 (defvar Info-isearch-initial-node)
495 (defvar Info-isearch-search)
496 (defvar Info-menu-entry-name-re)
497 (defvar Info-next-link-keymap)
498 (defvar Info-mode-line-node-keymap)
499 (defvar Info-node-spec-re)
500 (defvar Info-point-loc)
501 (defvar Info-prev-link-keymap)
502 (defvar Info-refill-paragraphs)
503 (defvar Info-saved-nodes)
504 (defvar Info-search-case-fold)
505 (defvar Info-search-history)
506 (defvar Info-search-whitespace-regexp)
507 (defvar info-tool-bar-map)
508 (defvar Info-up-link-keymap)
509 (defvar Info-use-header-line)
510 (defvar widen-automatically)
511
512 ;; (when (< emacs-major-version 23)
513 ;; (eval-when-compile
514 (defvar Info-read-node-completion-table)
515 (defvar Info-breadcrumbs-depth)
516 (defvar Info-breadcrumbs-depth-internal)
517 (defvar Info-breadcrumbs-in-header-flag)
518 (defvar Info-current-node-virtual)
519 (defvar Info-last-search)
520 (defvar Info-title-face-alist)
521 (defvar isearch-filter-predicate)
522
523 ;;; You will likely get byte-compiler messages saying that variable
524 ;;; `node-name' is free. In older Emacs versions, you might also get
525 ;;; a byte-compiler message saying that some functions are not known
526 ;;; to be defined.
527
528 ;;;;;;;;;;;;;;;;;;;;
529
530 (provide 'info+)
531 (require 'info+) ;; Ensure loaded before compiling.
532
533 ;;;;;;;;;;;;;;;;;;;;
534
535
536 ;;; KEYS & MENUS ;;;;;;;;;;;;;;;;;;;;;;;;
537
538 (define-key Info-mode-map "?" 'describe-mode) ; Don't use `Info-summary'.
539 (define-key Info-mode-map "+" 'Info-merge-subnodes)
540
541 (when (> emacs-major-version 21)
542 (define-key Info-mode-map "." 'Info-save-current-node)
543 (define-key Info-mode-map "a" 'info-apropos)
544 (define-key Info-mode-map "v" 'Info-virtual-book)
545 ;; Mouse back and forward buttons
546 (define-key Info-mode-map [S-down-mouse-2] 'Info-mouse-follow-nearest-node-new-window)
547 (define-key Info-mode-map [S-return] 'Info-follow-nearest-node-new-window)
548 (define-key Info-mode-map [mouse-4] 'Info-history-back)
549 (define-key Info-mode-map [mouse-5] 'Info-history-forward))
550
551
552
553 ;;; FACES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
554
555 ;;;###autoload
556 (defgroup Info-Plus nil
557 "Various enhancements to Info."
558 :group 'info
559 :link `(url-link :tag "Send Bug Report"
560 ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
561 info+.el bug: \
562 &body=Describe bug here, starting with `emacs -q'. \
563 Don't forget to mention your Emacs and library versions."))
564 :link '(url-link :tag "Other Libraries by Drew"
565 "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
566 :link '(url-link :tag "Download" "http://www.emacswiki.org/cgi-bin/wiki/info+.el")
567 :link '(url-link :tag "Description" "http://www.emacswiki.org/cgi-bin/wiki/InfoPlus")
568 :link '(emacs-commentary-link :tag "Commentary" "info+")
569 )
570
571 ;; This is defined in `faces.el', Emacs 22+. This definition is adapted to Emacs 20.
572 (unless (facep 'minibuffer-prompt)
573 (defface minibuffer-prompt
574 '((((background dark)) (:foreground "cyan"))
575 (t (:foreground "dark blue")))
576 "*Face for minibuffer prompts."
577 :group 'basic-faces))
578
579 ;;;###autoload
580 (defface info-file
581 '((((background dark)) (:foreground "Yellow" :background "DimGray"))
582 (t (:foreground "Blue" :background "LightGray")))
583 "*Face for file heading labels in `info'." :group 'Info-Plus :group 'faces)
584
585 ;;;###autoload
586 (defface info-menu
587 '((((background dark)) (:foreground "Yellow"))
588 (t (:foreground "Blue")))
589 "*Face used for menu items in `info'." :group 'Info-Plus :group 'faces)
590
591 ;; FWIW, I use a `LightSteelBlue' background for `*info*', and I use `yellow' for this face.
592 ;;;###autoload
593 (defface info-quoted-name ; For `...'
594 '((((background dark)) (:inherit font-lock-string-face :foreground "#6B6BFFFF2C2C")) ; ~ green
595 (((background light)) (:inherit font-lock-string-face :foreground "DarkViolet"))
596 (t (:foreground "yellow")))
597 "*Face for quoted names (`...') in `info'."
598 :group 'Info-Plus :group 'faces)
599
600 ;; FWIW, I use a `LightSteelBlue' background for `*info*', and I use `red3' for this face.
601 ;;;###autoload
602 (defface info-string ; For "..."
603 '((((background dark)) (:inherit font-lock-string-face :foreground "Orange"))
604 (t (:inherit font-lock-string-face :foreground "red3")))
605 "*Face for strings (\"...\") in `info'."
606 :group 'Info-Plus :group 'faces)
607
608 ;;;###autoload
609 (defface info-single-quote ; For '
610 '((((background dark)) (:inherit font-lock-keyword-face :foreground "Green"))
611 (t (:inherit font-lock-keyword-face :foreground "Magenta")))
612 "*Face for isolated single-quote marks (') in `info'."
613 :group 'Info-Plus :group 'faces)
614
615 ;;; These are only for Emacs 20 and 21.
616 (unless (fboundp 'set-face-attribute)
617 (set-face-foreground 'info-node "Blue")
618 (set-face-background 'info-node "SkyBlue")
619 (set-face-bold-p 'info-node nil)
620 (set-face-italic-p 'info-node nil)
621 (set-face-foreground 'info-xref "Blue")
622 (set-face-bold-p 'info-xref nil))
623
624 ;; Standard faces from vanilla Emacs `info.el', but without `:weight', `:height' and `:inherit'.
625 ;;;###autoload
626 (defface info-title-1
627 '((((type tty pc) (class color) (background dark)) :foreground "yellow" :weight bold)
628 (((type tty pc) (class color) (background light)) :foreground "brown" :weight bold))
629 "*Face for info titles at level 1."
630 :group (if (facep 'info-title-1) 'info 'Info-Plus))
631 ;; backward-compatibility alias
632 (put 'Info-title-1-face 'face-alias 'info-title-1)
633
634 ;;;###autoload
635 (defface info-title-2
636 '((((type tty pc) (class color)) :foreground "lightblue" :weight bold))
637 "*Face for info titles at level 2."
638 :group (if (facep 'info-title-1) 'info 'Info-Plus))
639 ;; backward-compatibility alias
640 (put 'Info-title-2-face 'face-alias 'info-title-2)
641
642 ;;;###autoload
643 (defface info-title-3
644 '((((type tty pc) (class color)) :weight bold))
645 "*Face for info titles at level 3."
646 :group (if (facep 'info-title-1) 'info 'Info-Plus))
647 ;; backward-compatibility alias
648 (put 'Info-title-3-face 'face-alias 'info-title-3)
649
650 ;;;###autoload
651 (defface info-title-4
652 '((((type tty pc) (class color)) :weight bold))
653 "*Face for info titles at level 4."
654 :group (if (facep 'info-title-1) 'info 'Info-Plus))
655 ;; backward-compatibility alias
656 (put 'Info-title-4-face 'face-alias 'info-title-4)
657
658 (when (<= emacs-major-version 21)
659 (setq Info-title-face-alist '((?* info-title-1 bold underline)
660 (?= info-title-2 bold-italic underline)
661 (?- info-title-4 italic underline))))
662
663 ;;; Faces for highlighting reference items
664 ;;;###autoload
665 (defface info-function-ref-item
666 '((((background dark))
667 (:foreground "#4D4DDDDDDDDD" :background "DimGray")) ; ~ cyan
668 (t (:foreground "DarkBlue" :background "LightGray")))
669 "*Face used for \"Function:\" reference items in `info' manual."
670 :group 'Info-Plus :group 'faces)
671 ;;;###autoload
672 (defface info-variable-ref-item
673 '((((background dark))
674 (:foreground "Orange" :background "DimGray"))
675 (t (:foreground "FireBrick" :background "LightGray")))
676 "*Face used for \"Variable:\" reference items in `info' manual."
677 :group 'Info-Plus :group 'faces)
678 ;;;###autoload
679 (defface info-special-form-ref-item
680 '((((background dark))
681 (:foreground "Yellow" :background "DimGray")) ; ~ light green
682 (t (:foreground "DarkMagenta" :background "LightGray")))
683 "*Face used for \"Special Form:\" reference items in `info' manual."
684 :group 'Info-Plus :group 'faces)
685 ;;;###autoload
686 (defface info-command-ref-item
687 '((((background dark)) (:foreground "#7474FFFF7474" :background "DimGray")) ; ~ light green
688 (t (:foreground "Blue" :background "LightGray")))
689 "*Face used for \"Command:\" reference items in `info' manual."
690 :group 'Info-Plus :group 'faces)
691 ;;;###autoload
692 (defface info-user-option-ref-item
693 '((((background dark)) (:foreground "Red" :background "DimGray"))
694 (t (:foreground "Red" :background "LightGray")))
695 "*Face used for \"User Option:\" reference items in `info' manual."
696 :group 'Info-Plus :group 'faces)
697 ;;;###autoload
698 (defface info-macro-ref-item
699 '((((background dark))
700 (:foreground "Yellow" :background "DimGray")) ; ~ light green
701 (t (:foreground "DarkMagenta" :background "LightGray")))
702 "*Face used for \"Macro:\" reference items in `info' manual."
703 :group 'Info-Plus :group 'faces)
704 ;;;###autoload
705 (defface info-syntax-class-item
706 '((((background dark))
707 (:foreground "#FFFF9B9BFFFF" :background "DimGray")) ; ~ pink
708 (t (:foreground "DarkGreen" :background "LightGray")))
709 "*Face used for \"Syntax Class:\" reference items in `info' manual."
710 :group 'Info-Plus :group 'faces)
711 ;;;###autoload
712 (defface info-reference-item
713 '((((background dark)) (:background "DimGray"))
714 (t (:background "LightGray")))
715 "*Face used for reference items in `info' manual."
716 :group 'Info-Plus :group 'faces)
717
718
719 ;;; USER OPTIONS (VARIABLES) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
720
721 ;;;###autoload
722 (defcustom Info-fit-frame-flag t
723 "*Non-nil means call `fit-frame' on Info buffer."
724 :type 'boolean :group 'Info-Plus :group 'Fit-Frame)
725
726 ;;;###autoload
727 (defcustom Info-fontify-quotations-flag t
728 "*Non-nil means `info' fontifies text between quotes.
729 This applies to double-quote strings (\"...\") and text between
730 single-quotes (`...').
731
732 Note: This fontification can never be 100% reliable. It aims to be
733 useful in most Info texts, but it can occasionally result in
734 fontification that you might not expect. This is not a bug; it is
735 part of the design to be able to appropriately fontify a great variety
736 of texts. Set this flag to nil if you do not find this fontification
737 useful."
738 :type 'boolean :group 'Info-Plus)
739
740 ;;;###autoload
741 (defcustom Info-fontify-single-quote-flag t
742 "*Non-nil means `info' fontifies ' when not preceded by `....
743 A non-nil value has no effect unless `Info-fontify-quotations-flag' is
744 also non-nil.
745
746 Note: This fontification can never be 100% reliable. It aims to be
747 useful in most Info texts, but it can occasionally result in
748 fontification that you might not expect. This is not a bug; it is
749 part of the design to be able to appropriately fontify a great variety
750 of texts. Set this flag to nil if you do not find this fontification
751 useful."
752 :type 'boolean :group 'Info-Plus)
753
754 ;;;###autoload
755 (defcustom Info-fontify-reference-items-flag t
756 "*Non-nil means `info' fontifies reference items such as \"Function:\"."
757 :type 'boolean :group 'Info-Plus)
758
759 ;;;###autoload
760 (defcustom Info-display-node-header-fn 'Info-display-node-default-header
761 "*Function to insert header by `Info-merge-subnodes'."
762 :type 'function :group 'Info-Plus)
763
764 ;;;###autoload
765 (defcustom Info-subtree-separator "\n* "
766 "*A string used to separate Info node descriptions.
767 Inserted by `Info-merge-subnodes' just before each node title.
768 Setting this to a string that includes a form-feed (^L), such as
769 \"\\f\\n* \", will cause a page break before each node description.
770
771 Use command `set-variable' to set this, quoting any control characters
772 you want to include, such as form-feed (^L) and newline (^J), with ^Q.
773 For example, type `^Q^L^Q^J* ' to set this to \"\\f\\n* \"."
774 :type 'string :group 'Info-Plus)
775
776 (when (> emacs-major-version 22)
777 (defcustom Info-breadcrumbs-in-header-flag nil
778 "*Non-nil means breadcrumbs are shown in the header line."
779 :type 'boolean :group 'Info-Plus))
780
781
782 ;;; NEW COMMANDS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
783
784 (when (>= emacs-major-version 22)
785 (defun Info-mouse-follow-nearest-node-new-window (click)
786 "Open the link at the mouse pointer in a new window."
787 (interactive "e")
788 (Info-mouse-follow-nearest-node click t))
789 (defun Info-follow-nearest-node-new-window ()
790 "Open the link near the text cursor in a new window."
791 (interactive)
792 (Info-follow-nearest-node t)))
793
794
795 ;;; INTERNAL VARIABLES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
796
797 ;; I reported this as Emacs bug #3312. If it gets fixed, this can be removed.
798 (defvar Info-mode-syntax-table
799 (let ((table (copy-syntax-table text-mode-syntax-table)))
800 (modify-syntax-entry ?' "." table) ; Punctuation syntax for apostrophe (').
801 (modify-syntax-entry ?\240 "." table) ; Punctuation syntax for non-breaking space.
802 table)
803 "Syntax table for `info'.")
804
805 (defvar Info-merged-map nil "Keymap for merged Info buffer.")
806 (if Info-merged-map
807 nil
808 (setq Info-merged-map (make-keymap))
809 (suppress-keymap Info-merged-map)
810 (define-key Info-merged-map "." 'beginning-of-buffer)
811 (define-key Info-merged-map "\t" 'Info-next-reference)
812 (define-key Info-merged-map "\e\t" 'Info-prev-reference)
813 (define-key Info-merged-map "b" 'beginning-of-buffer)
814 (define-key Info-merged-map "q" 'quit-window)
815 (define-key Info-merged-map "s" 'nonincremental-re-search-forward)
816 (define-key Info-merged-map "\M-s" 'nonincremental-re-search-forward))
817
818 (if (>= emacs-major-version 22)
819 (easy-menu-define
820 Info-mode-menu Info-mode-map
821 "Menu for info files."
822 '("Info"
823 ["Table of Contents" Info-toc :help "Go to table of contents"]
824 ["Virtual Book" Info-virtual-book
825 :help "Open table of contents of a virtual book" :active Info-saved-nodes]
826 ["Save Current Node" Info-save-current-node
827 :help "Save current node name for virtual book"]
828 ["Find...(Regexp)" Info-search
829 :help "Search for regular expression in this Info file"]
830 ["Find Case-Sensitively..." Info-search-case-sensitively
831 :help "Search for regular expression case sensitively"]
832 ["Find Again" Info-search-next
833 :help "Search for another occurrence of same regular expression"]
834 ("Index"
835 ["Find with Index..." Info-index :help "Look for a string in the index"]
836 ["Find Again with Index" Info-index-next :active Info-index-alternatives
837 :help "Look for string again in index"]
838 ["Find In All Indexes..." info-apropos
839 :help "Look for a string in the indexes of all manuals"])
840 "--"
841 ["Back (History)" Info-history-back :active Info-history
842 :help "Go back in history to the last node you were at"]
843 ["Forward (History)" Info-history-forward :active Info-history-forward
844 :help "Go forward in history"]
845 ["History List" Info-history :active Info-history-list
846 :help "Go to menu of visited nodes"]
847 "--"
848 ["Top" Info-directory :help "Go to the list of manuals (Info top level)"]
849 ["Up" Info-up :active (Info-check-pointer "up") :help "Go up in the Info tree"]
850 ["Next" Info-next :active (Info-check-pointer "next") :help "Go to the next node"]
851 ["Previous" Info-prev :active (Info-check-pointer "prev[ious]*")
852 :help "Go to the previous node"]
853 ("Menu Item" ["You should never see this" report-emacs-bug t])
854 ("Reference" ["You should never see this" report-emacs-bug t])
855 ["Go to Node..." Info-goto-node :help "Go to a named node"]
856 "--"
857 ["Forward" Info-forward-node
858 :help "Go forward one node, considering all as a sequence"]
859 ["Backward" Info-backward-node
860 :help "Go backward one node, considering all as a sequence"]
861 ["First in File" Info-top-node :help "Go to top node of file"]
862 ["Last in File" Info-final-node :help "Go to final node in this file"]
863 ["Beginning of This Node" beginning-of-buffer :help "Go to beginning of this node"]
864 "--"
865 ["Clone Info Buffer" clone-buffer
866 :help "Create a twin copy of the current Info buffer."]
867 ["Copy Node Name" Info-copy-current-node-name
868 :help "Copy the name of the current node into the kill ring"]
869 ["Merge Subnodes" Info-merge-subnodes
870 :help "Integrate current node with nodes referred to in its Menu"]
871 ["Edit" Info-edit :help "Edit contents of this node" :active Info-enable-edit]
872 "--"
873 ["Quit Info" Info-exit :help "Exit from Info"]))
874 (easy-menu-define
875 Info-mode-menu
876 Info-mode-map
877 "Menu for Info files."
878 '("Info"
879 ["Back" Info-last Info-history]
880 ("Menu item" ["You should never see this" report-emacs-bug t])
881 ("Reference" ["You should never see this" report-emacs-bug t])
882 "--"
883 ["Up" Info-up (Info-check-pointer "up")]
884 ["Next" Info-next (Info-check-pointer "next")]
885 ["Previous" Info-prev (Info-check-pointer "prev[ious]*")]
886 ["Top" Info-directory t]
887 ["Goto Node..." Info-goto-node t]
888 "--"
889 ["Forward in File" Info-forward-node t]
890 ["Backward in File" Info-backward-node t]
891 ["First in File" Info-top-node t]
892 ["Last in File" Info-final-node t]
893 "--"
894 ["Next Link in Node" Info-next-reference t]
895 ["Previous Link in Node" Info-prev-reference t]
896 "--"
897 ["Search (regexp)" Info-search t]
898 ["Info on Key" Info-goto-emacs-key-command-node t]
899 ["Info on Command" Info-goto-emacs-command-node t]
900 ["Find with Index" Info-index t]
901 "--"
902 ["Merge Subnodes" Info-merge-subnodes t]
903 ["Edit Node" Info-edit t]
904 "--"
905 ["Tutorial" Info-help t]
906 ["Quit Info" Info-exit t])))
907
908 (when (> emacs-major-version 22)
909 (easy-menu-add-item
910 Info-mode-menu nil
911 ["Toggle Breadcrumbs in Mode Line" Info-breadcrumbs-in-mode-line-mode
912 :help "Toggle showing breadcrumbs in the mode line"]
913 "Quit Info")
914 (easy-menu-add-item
915 Info-mode-menu nil
916 ["Toggle Breadcrumbs in Header Line" Info-toggle-breadcrumbs-in-header-line
917 :help "Toggle showing breadcrumbs in the header line"]
918 "Quit Info"))
919
920 (when (> emacs-major-version 22)
921 (defun Info-toggle-breadcrumbs-in-header-line ()
922 "Toggle showing breadcrumbs in a header line."
923 (interactive)
924 (setq Info-breadcrumbs-in-header-flag (not Info-breadcrumbs-in-header-flag))))
925
926 (easy-menu-define
927 Info-merged-menu
928 Info-merged-map
929 "Menu for merged `info' buffers."
930 '("Info"
931 ["Next Link" Info-next-reference t]
932 ["Previous Link" Info-prev-reference t]
933 ["Search (regexp)" Info-search t]
934 ["Quit" quit-window t]))
935
936
937 ;; Make `Info-find-emacs-command-nodes' look for these commands in the
938 ;; Emacs manual. In particular, don't look for command `info' in Info
939 ;; manual, because that has no index.
940 (put 'info 'info-file "emacs")
941 (put 'Info-goto-emacs-command-node 'info-file "emacs")
942 (put 'Info-goto-emacs-key-command-node 'info-file "emacs")
943
944
945 (unless (>= emacs-major-version 22)
946 ;; I previously called this `emacs-info', but Emacs 21 came out with this name.
947 (defun info-emacs-manual ()
948 "Access the Emacs manual via \"Info\"."
949 (interactive) (info "emacs"))
950
951 ;; I previously called this `emacs-lisp-info', but Emacs 21 came out with this name.
952 (defun menu-bar-read-lispref ()
953 "Access the Emacs Lisp manual via \"Info\"."
954 (interactive) (info "elisp"))
955
956 ;; From Emacs 21 `menu-bar.el'. Of course, the file `eintr.info' needs to be there.
957 (defun menu-bar-read-lispintro ()
958 "Display the Introduction to Emacs Lisp Programming in Info mode."
959 (interactive) (info "eintr")))
960
961
962
963 ;; REPLACE ORIGINAL in `info.el':
964 ;;
965 ;; Added final clause to `cond', to handle virtual books. (Emacs 23.2+)
966 ;;
967 (when (or (> emacs-major-version 23) (and (= emacs-major-version 23) (> emacs-minor-version 1)))
968 (defun Info-find-file (filename &optional noerror)
969 "Return expanded FILENAME, or t if FILENAME is \"dir\".
970 Optional second argument NOERROR, if t, means if file is not found
971 just return nil (no error)."
972 ;; Convert filename to lower case if not found as specified.
973 ;; Expand it.
974 (cond
975 ((Info-virtual-call (Info-virtual-fun 'find-file filename nil) filename noerror))
976 ((stringp filename)
977 (let (temp temp-downcase found)
978 (setq filename (substitute-in-file-name filename))
979 (let ((dirs (if (string-match "^\\./" filename)
980 '("./") ; If specified name starts with `./' then just try current dir.
981 (if (file-name-absolute-p filename)
982 '(nil) ; No point in searching for an absolute file name
983 (if Info-additional-directory-list
984 (append Info-directory-list Info-additional-directory-list)
985 Info-directory-list)))))
986 ;; Fall back on the installation directory if we can't find the info node anywhere else.
987 (when installation-directory
988 (setq dirs (append dirs (list (expand-file-name "info" installation-directory)))))
989 ;; Search the directory list for file FILENAME.
990 (while (and dirs (not found))
991 (setq temp (expand-file-name filename (car dirs)))
992 (setq temp-downcase (expand-file-name (downcase filename) (car dirs)))
993 ;; Try several variants of specified name.
994 (let ((suffix-list Info-suffix-list)
995 (lfn (if (fboundp 'msdos-long-file-names) (msdos-long-file-names) t)))
996 (while (and suffix-list (not found))
997 (cond ((info-file-exists-p
998 (info-insert-file-contents-1 temp (car (car suffix-list)) lfn))
999 (setq found temp))
1000 ((info-file-exists-p
1001 (info-insert-file-contents-1 temp-downcase (car (car suffix-list)) lfn))
1002 (setq found temp-downcase))
1003 ((and (fboundp 'msdos-long-file-names)
1004 lfn
1005 (info-file-exists-p
1006 (info-insert-file-contents-1 temp (car (car suffix-list)) nil)))
1007 (setq found temp)))
1008 (setq suffix-list (cdr suffix-list))))
1009 (setq dirs (cdr dirs))))
1010 (if found
1011 (setq filename found)
1012 (if noerror
1013 (setq filename nil)
1014 (error "Info file %s does not exist" filename)))
1015 filename))
1016 ((member filename '(apropos history toc)) filename))) ; Handle virtual books - `toc'.
1017 )
1018
1019
1020
1021 ;; REPLACE ORIGINAL in `info.el':
1022 ;;
1023 ;; Call `fit-frame' if `Info-fit-frame-flag'.
1024 ;;
1025 (when (< emacs-major-version 21)
1026 (defun Info-find-node (filename nodename &optional no-going-back)
1027 ;; Go to an info node specified as separate FILENAME and NODENAME.
1028 ;; NO-GOING-BACK is non-nil if recovering from an error in this function;
1029 ;; it says do not attempt further (recursive) error recovery.
1030
1031 ;; Convert filename to lower case if not found as specified.
1032 ;; Expand it.
1033 (if filename
1034 (let (temp temp-downcase found)
1035 (setq filename (substitute-in-file-name filename))
1036 (if (string= (downcase filename) "dir")
1037 (setq found t)
1038 (let ((dirs (if (string-match "^\\./" filename)
1039 ;; If specified name starts with `./'
1040 ;; then just try current directory.
1041 '("./")
1042 (if (file-name-absolute-p filename)
1043 ;; No point in searching for an absolute file name.
1044 '(nil)
1045 (if Info-additional-directory-list
1046 (append Info-directory-list
1047 Info-additional-directory-list)
1048 Info-directory-list)))))
1049 ;; Search the directory list for file FILENAME.
1050 (while (and dirs (not found))
1051 (setq temp (expand-file-name filename (car dirs))
1052 temp-downcase (expand-file-name (downcase filename) (car dirs)))
1053 ;; Try several variants of specified name.
1054 (let ((suffix-list Info-suffix-list))
1055 (while (and suffix-list (not found))
1056 (cond ((info-file-exists-p
1057 (info-insert-file-contents-1 temp (caar suffix-list)))
1058 (setq found temp))
1059 ((info-file-exists-p
1060 (info-insert-file-contents-1 temp-downcase (caar suffix-list)))
1061 (setq found temp-downcase)))
1062 (setq suffix-list (cdr suffix-list))))
1063 (setq dirs (cdr dirs)))))
1064 (if found (setq filename found) (error "Info file `%s' does not exist" filename))))
1065 ;; Record the node we are leaving.
1066 (when (and Info-current-file (not no-going-back))
1067 (setq Info-history (cons (list Info-current-file Info-current-node (point)) Info-history)))
1068 ;; Go into info buffer.
1069 (or (eq major-mode 'Info-mode) (pop-to-buffer "*info*"))
1070 (buffer-disable-undo (current-buffer))
1071 (or (eq major-mode 'Info-mode) (Info-mode))
1072 (widen)
1073 (setq Info-current-node nil)
1074 (unwind-protect
1075 ;; Bind case-fold-search in case the user sets it to nil.
1076 (let ((case-fold-search t)
1077 anchorpos)
1078 ;; Switch files if necessary
1079 (or (null filename)
1080 (equal Info-current-file filename)
1081 (let ((buffer-read-only nil))
1082 (setq Info-current-file nil
1083 Info-current-subfile nil
1084 Info-current-file-completions ()
1085 buffer-file-name nil)
1086 (erase-buffer)
1087 (if (eq filename t)
1088 (Info-insert-dir)
1089 (info-insert-file-contents filename t)
1090 (setq default-directory (file-name-directory filename)))
1091 (set-buffer-modified-p nil)
1092 ;; See whether file has a tag table. Record the location if yes.
1093 (goto-char (point-max))
1094 (forward-line -8)
1095 ;; Use string-equal, not equal, to ignore text props.
1096 (if (not (or (string-equal nodename "*")
1097 (not
1098 (search-forward "\^_\nEnd tag table\n" nil t))))
1099 (let (pos)
1100 ;; We have a tag table. Find its beginning.
1101 ;; Is this an indirect file?
1102 (search-backward "\nTag table:\n")
1103 (setq pos (point))
1104 (if (save-excursion (forward-line 2) (looking-at "(Indirect)\n"))
1105 ;; It is indirect. Copy it to another buffer
1106 ;; and record that the tag table is in that buffer.
1107 (let ((buf (current-buffer))
1108 (tagbuf (or Info-tag-table-buffer
1109 (generate-new-buffer " *info tag table*"))))
1110 (setq Info-tag-table-buffer tagbuf)
1111 (with-current-buffer tagbuf
1112 (buffer-disable-undo (current-buffer))
1113 (setq case-fold-search t)
1114 (erase-buffer)
1115 (insert-buffer-substring buf))
1116 (set-marker Info-tag-table-marker (match-end 0) tagbuf))
1117 (set-marker Info-tag-table-marker pos)))
1118 (set-marker Info-tag-table-marker nil))
1119 (setq Info-current-file (if (eq filename t) "dir" filename))))
1120 ;; Use string-equal, not equal, to ignore text props.
1121 (if (string-equal nodename "*")
1122 (progn (setq Info-current-node nodename)
1123 (Info-set-mode-line))
1124 ;; Possibilities:
1125 ;;
1126 ;; 1. Anchor found in tag table
1127 ;; 2. Anchor *not* in tag table
1128 ;;
1129 ;; 3. Node found in tag table
1130 ;; 4. Node *not* found in tag table, but found in file
1131 ;; 5. Node *not* in tag table, and *not* in file
1132 ;;
1133 ;; *Or* the same, but in an indirect subfile.
1134
1135 ;; Search file for a suitable node.
1136 (let ((guesspos (point-min))
1137 (regexp (concat "\\(Node:\\|Ref:\\) *\\(" (regexp-quote nodename)
1138 "\\) *[,\t\n\177]"))
1139 (nodepos nil))
1140
1141 ;; First, search a tag table, if any
1142 (if (marker-position Info-tag-table-marker)
1143 (let ((found-in-tag-table t)
1144 found-anchor found-mode
1145 (m Info-tag-table-marker))
1146 (with-current-buffer (marker-buffer m)
1147 (save-excursion
1148 (goto-char m)
1149 (beginning-of-line) ; so re-search will work.
1150
1151 ;; Search tag table
1152 (catch 'foo
1153 (while (re-search-forward regexp nil t)
1154 (setq found-anchor (string-equal "Ref:" (match-string 1)))
1155 (or nodepos (setq nodepos (point))
1156 (and (string-equal (match-string 2) nodename) (throw 'foo t))))
1157 (if nodepos (goto-char nodepos) (setq found-in-tag-table nil)))
1158 (when found-in-tag-table (setq guesspos (1+ (read (current-buffer)))))
1159 (setq found-mode major-mode)))
1160
1161 ;; Indirect file among split files
1162 (if found-in-tag-table
1163 (progn
1164 ;; If this is an indirect file, determine
1165 ;; which file really holds this node and
1166 ;; read it in.
1167 (if (not (eq found-mode 'Info-mode))
1168 ;; Note that the current buffer must be
1169 ;; the *info* buffer on entry to
1170 ;; Info-read-subfile. Thus the hackery
1171 ;; above.
1172 (setq guesspos (Info-read-subfile guesspos)))))
1173
1174 ;; Handle anchor
1175 (if found-anchor
1176 (goto-char (setq anchorpos guesspos))
1177
1178 ;; Else we may have a node, which we search for:
1179 (goto-char (max (point-min) (- (byte-to-position guesspos) 1000)))
1180 ;; Now search from our advised position
1181 ;; (or from beg of buffer)
1182 ;; to find the actual node.
1183 ;; First, check whether the node is right
1184 ;; where we are, in case the buffer begins
1185 ;; with a node.
1186 (setq nodepos nil)
1187 (or (and (string< "20.5" emacs-version) (Info-node-at-bob-matching regexp))
1188 (catch 'foo
1189 (while (search-forward "\n\^_" nil t)
1190 (forward-line 1)
1191 (let ((beg (point)))
1192 (forward-line 1)
1193 (when (re-search-backward regexp beg t)
1194 (if (string-equal (match-string 2) nodename)
1195 (progn (beginning-of-line) (throw 'foo t))
1196 (unless nodepos (setq nodepos (point)))))))
1197 (if nodepos
1198 (progn (goto-char nodepos) (beginning-of-line))
1199 (error "No such anchor in tag table or node in tag table \
1200 or file: `%s'"
1201 nodename))))))
1202 (goto-char (max (point-min) (- guesspos 1000)))
1203 ;; Now search from our advised position (or from beg of buffer)
1204 ;; to find the actual node.
1205 ;; First, check whether the node is right where we are, in case
1206 ;; the buffer begins with a node.
1207 (setq nodepos nil)
1208 (or (and (string< "20.5" emacs-version)
1209 (Info-node-at-bob-matching regexp))
1210 (catch 'foo
1211 (while (search-forward "\n\^_" nil t)
1212 (forward-line 1)
1213 (let ((beg (point)))
1214 (forward-line 1)
1215 (when (re-search-backward regexp beg t)
1216 (if (string-equal (match-string 2) nodename)
1217 (throw 'foo t)
1218 (unless nodepos (setq nodepos (point)))))))
1219 (if nodepos (goto-char nodepos) (error "No such node: `%s'" nodename))))))
1220 (Info-select-node)
1221 (goto-char (or anchorpos (point-min))))
1222 (when (and (one-window-p t) (not (window-minibuffer-p))
1223 (fboundp 'fit-frame) ; Defined in `fit-frame.el'.
1224 Info-fit-frame-flag)
1225 (fit-frame)))
1226 ;; If we did not finish finding the specified node,
1227 ;; go back to the previous one.
1228 (or Info-current-node no-going-back (null Info-history)
1229 (let ((hist (car Info-history)))
1230 (setq Info-history (cdr Info-history))
1231 (Info-find-node (nth 0 hist) (nth 1 hist) t)
1232 (goto-char (nth 2 hist)))))))
1233
1234
1235 ;; REPLACE ORIGINAL in `info.el':
1236 ;; Call `fit-frame' if `Info-fit-frame-flag'.
1237 ;;
1238 (when (eq emacs-major-version 21)
1239 (defun Info-find-node-2 (filename nodename &optional no-going-back)
1240 (buffer-disable-undo (current-buffer))
1241 (or (eq major-mode 'Info-mode)
1242 (Info-mode))
1243 (widen)
1244 (setq Info-current-node nil)
1245 (unwind-protect
1246 (let ((case-fold-search t)
1247 anchorpos)
1248 ;; Switch files if necessary
1249 (or (null filename)
1250 (equal Info-current-file filename)
1251 (let ((buffer-read-only nil))
1252 (setq Info-current-file nil
1253 Info-current-subfile nil
1254 Info-current-file-completions ()
1255 buffer-file-name nil)
1256 (erase-buffer)
1257 (if (eq filename t)
1258 (Info-insert-dir)
1259 (info-insert-file-contents filename t)
1260 (setq default-directory (file-name-directory filename)))
1261 (set-buffer-modified-p nil)
1262 ;; See whether file has a tag table. Record the location if yes.
1263 (goto-char (point-max))
1264 (forward-line -8)
1265 ;; Use string-equal, not equal, to ignore text props.
1266 (if (not (or (string-equal nodename "*")
1267 (not (search-forward "\^_\nEnd tag table\n" nil t))))
1268 (let (pos)
1269 ;; We have a tag table. Find its beginning.
1270 ;; Is this an indirect file?
1271 (search-backward "\nTag table:\n")
1272 (setq pos (point))
1273 (if (save-excursion
1274 (forward-line 2)
1275 (looking-at "(Indirect)\n"))
1276 ;; It is indirect. Copy it to another buffer
1277 ;; and record that the tag table is in that buffer.
1278 (let ((buf (current-buffer))
1279 (tagbuf (or Info-tag-table-buffer
1280 (generate-new-buffer " *info tag table*"))))
1281 (setq Info-tag-table-buffer tagbuf)
1282 (with-current-buffer tagbuf
1283 (buffer-disable-undo (current-buffer))
1284 (setq case-fold-search t)
1285 (erase-buffer)
1286 (insert-buffer-substring buf))
1287 (set-marker Info-tag-table-marker (match-end 0) tagbuf))
1288 (set-marker Info-tag-table-marker pos)))
1289 (set-marker Info-tag-table-marker nil))
1290 (setq Info-current-file (if (eq filename t) "dir" filename))))
1291 ;; Use string-equal, not equal, to ignore text props.
1292 (if (string-equal nodename "*")
1293 (progn (setq Info-current-node nodename) (Info-set-mode-line))
1294 ;; Possibilities:
1295 ;;
1296 ;; 1. Anchor found in tag table
1297 ;; 2. Anchor *not* in tag table
1298 ;;
1299 ;; 3. Node found in tag table
1300 ;; 4. Node *not* found in tag table, but found in file
1301 ;; 5. Node *not* in tag table, and *not* in file
1302 ;;
1303 ;; *Or* the same, but in an indirect subfile.
1304
1305 ;; Search file for a suitable node.
1306 (let ((guesspos (point-min))
1307 (regexp (concat "\\(Node:\\|Ref:\\) *\\(" (if (stringp nodename)
1308 (regexp-quote nodename)
1309 "")
1310 "\\) *[,\t\n\177]"))
1311 (nodepos nil))
1312
1313 (catch 'foo
1314
1315 ;; First, search a tag table, if any
1316 (when (marker-position Info-tag-table-marker)
1317 (let* ((m Info-tag-table-marker)
1318 (found (Info-find-in-tag-table m regexp)))
1319 (when found
1320 ;; FOUND is (ANCHOR POS MODE).
1321 (setq guesspos (nth 1 found))
1322
1323 ;; If this is an indirect file, determine which
1324 ;; file really holds this node and read it in.
1325 (unless (eq (nth 2 found) 'Info-mode)
1326 ;; Note that the current buffer must be the
1327 ;; *info* buffer on entry to
1328 ;; Info-read-subfile. Thus the hackery above.
1329 (setq guesspos (Info-read-subfile guesspos)))
1330
1331 ;; Handle anchor
1332 (when (nth 0 found)
1333 (goto-char (setq anchorpos guesspos)) (throw 'foo t)))))
1334
1335 ;; Else we may have a node, which we search for:
1336 (goto-char (max (point-min) (- (byte-to-position guesspos) 1000)))
1337
1338 ;; Now search from our advised position (or from beg of
1339 ;; buffer) to find the actual node. First, check
1340 ;; whether the node is right where we are, in case the
1341 ;; buffer begins with a node.
1342 (let ((pos (Info-find-node-in-buffer regexp)))
1343 (when pos (goto-char pos) (throw 'foo t))
1344 (error "No such anchor in tag table or node in tag table or file: %s" nodename)))
1345 (Info-select-node)
1346 (goto-char (or anchorpos (point-min)))))
1347 (when (and (one-window-p t) (not (window-minibuffer-p))
1348 (fboundp 'fit-frame) ; Defined in `fit-frame.el'.
1349 Info-fit-frame-flag)
1350 (fit-frame)))
1351 ;; If we did not finish finding the specified node,
1352 ;; go back to the previous one.
1353 (or Info-current-node no-going-back (null Info-history)
1354 (let ((hist (car Info-history)))
1355 (setq Info-history (cdr Info-history))
1356 (Info-find-node (nth 0 hist) (nth 1 hist) t)
1357 (goto-char (nth 2 hist)))))))
1358
1359
1360
1361 ;; REPLACE ORIGINAL in `info.el':
1362 ;; Call `fit-frame' if `Info-fit-frame-flag'.
1363 ;;
1364 (when (= emacs-major-version 22)
1365 (defun Info-find-node-2 (filename nodename &optional no-going-back)
1366 (buffer-disable-undo (current-buffer))
1367 (or (eq major-mode 'Info-mode)
1368 (Info-mode))
1369 (widen)
1370 (setq Info-current-node nil)
1371 (unwind-protect
1372 (let ((case-fold-search t)
1373 anchorpos)
1374 ;; Switch files if necessary
1375 (or (null filename)
1376 (equal Info-current-file filename)
1377 (let ((buffer-read-only nil))
1378 (setq Info-current-file nil
1379 Info-current-subfile nil
1380 Info-current-file-completions ()
1381 buffer-file-name nil)
1382 (erase-buffer)
1383 (cond
1384 ((eq filename t) (Info-insert-dir))
1385 ((eq filename 'apropos) (insert-buffer-substring " *info-apropos*"))
1386 ((eq filename 'history) (insert-buffer-substring " *info-history*"))
1387 ((eq filename 'toc) (insert-buffer-substring " *info-toc*"))
1388 (t (info-insert-file-contents filename nil)
1389 (setq default-directory (file-name-directory filename))))
1390 (set-buffer-modified-p nil)
1391
1392 ;; Check makeinfo version for index cookie support
1393 (let ((found nil))
1394 (goto-char (point-min))
1395 (condition-case ()
1396 (if (and (re-search-forward
1397 "makeinfo[ \n]version[ \n]\\([0-9]+.[0-9]+\\)"
1398 (line-beginning-position 3) t)
1399 (not (version< (match-string 1) "4.7")))
1400 (setq found t))
1401 (error nil))
1402 (set (make-local-variable 'Info-file-supports-index-cookies) found))
1403
1404 ;; See whether file has a tag table. Record the location if yes.
1405 (goto-char (point-max))
1406 (forward-line -8)
1407 ;; Use string-equal, not equal, to ignore text props.
1408 (if (not (or (string-equal nodename "*")
1409 (not (search-forward "\^_\nEnd tag table\n" nil t))))
1410 (let (pos)
1411 ;; We have a tag table. Find its beginning.
1412 ;; Is this an indirect file?
1413 (search-backward "\nTag table:\n")
1414 (setq pos (point))
1415 (if (save-excursion (forward-line 2) (looking-at "(Indirect)\n"))
1416 ;; It is indirect. Copy it to another buffer
1417 ;; and record that the tag table is in that buffer.
1418 (let ((buf (current-buffer))
1419 (tagbuf (or Info-tag-table-buffer
1420 (generate-new-buffer " *info tag table*"))))
1421 (setq Info-tag-table-buffer tagbuf)
1422 (with-current-buffer tagbuf
1423 (buffer-disable-undo (current-buffer))
1424 (setq case-fold-search t)
1425 (erase-buffer)
1426 (insert-buffer-substring buf))
1427 (set-marker Info-tag-table-marker (match-end 0) tagbuf))
1428 (set-marker Info-tag-table-marker pos)))
1429 (set-marker Info-tag-table-marker nil))
1430 (setq Info-current-file (cond ((eq filename t) "dir")
1431 (t filename)))))
1432
1433 ;; Use string-equal, not equal, to ignore text props.
1434 (if (string-equal nodename "*")
1435 (progn (setq Info-current-node nodename) (Info-set-mode-line))
1436 ;; Possibilities:
1437 ;;
1438 ;; 1. Anchor found in tag table
1439 ;; 2. Anchor *not* in tag table
1440 ;;
1441 ;; 3. Node found in tag table
1442 ;; 4. Node *not* found in tag table, but found in file
1443 ;; 5. Node *not* in tag table, and *not* in file
1444 ;;
1445 ;; *Or* the same, but in an indirect subfile.
1446
1447 ;; Search file for a suitable node.
1448 (let ((guesspos (point-min))
1449 (regexp (concat "\\(Node:\\|Ref:\\) *\\(" (if (stringp nodename)
1450 (regexp-quote nodename)
1451 "")
1452 "\\) *[,\t\n\177]")))
1453
1454 (catch 'foo
1455
1456 ;; First, search a tag table, if any
1457 (when (marker-position Info-tag-table-marker)
1458 (let* ((m Info-tag-table-marker)
1459 (found (Info-find-in-tag-table m regexp)))
1460
1461 (when found
1462 ;; FOUND is (ANCHOR POS MODE).
1463 (setq guesspos (nth 1 found))
1464
1465 ;; If this is an indirect file, determine which
1466 ;; file really holds this node and read it in.
1467 (unless (eq (nth 2 found) 'Info-mode)
1468 ;; Note that the current buffer must be the
1469 ;; *info* buffer on entry to
1470 ;; Info-read-subfile. Thus the hackery above.
1471 (setq guesspos (Info-read-subfile guesspos)))
1472
1473 ;; Handle anchor
1474 (when (nth 0 found)
1475 (goto-char (setq anchorpos guesspos)) (throw 'foo t)))))
1476
1477 ;; Else we may have a node, which we search for:
1478 (goto-char (max (point-min) (- (byte-to-position guesspos) 1000)))
1479
1480 ;; Now search from our advised position (or from beg of
1481 ;; buffer) to find the actual node. First, check
1482 ;; whether the node is right where we are, in case the
1483 ;; buffer begins with a node.
1484 (let ((pos (Info-find-node-in-buffer regexp)))
1485 (when pos (goto-char pos) (throw 'foo t)))
1486
1487 (when (string-match "\\([^.]+\\)\\." nodename)
1488 (let (Info-point-loc)
1489 (Info-find-node-2 filename (match-string 1 nodename) no-going-back))
1490 (widen)
1491 (throw 'foo t))
1492
1493 ;; No such anchor in tag table or node in tag table or file
1494 (error "No such node or anchor: %s" nodename))
1495
1496 (Info-select-node)
1497 (goto-char (point-min))
1498 (cond (anchorpos
1499 (let ((new-history (list Info-current-file (substring-no-properties nodename))))
1500 ;; Add anchors to the history too
1501 (setq Info-history-list (cons new-history
1502 (delete new-history Info-history-list))))
1503 (goto-char anchorpos))
1504 ((numberp Info-point-loc)
1505 (forward-line (1- Info-point-loc))
1506 (setq Info-point-loc nil))
1507 ((stringp Info-point-loc)
1508 (Info-find-index-name Info-point-loc)
1509 (setq Info-point-loc nil)))
1510 (when (and (one-window-p t) (not (window-minibuffer-p))
1511 (fboundp 'fit-frame) ; Defined in `fit-frame.el'.
1512 Info-fit-frame-flag)
1513 (fit-frame)))))
1514 ;; If we did not finish finding the specified node,
1515 ;; go back to the previous one.
1516 (or Info-current-node no-going-back (null Info-history)
1517 (let ((hist (car Info-history)))
1518 (setq Info-history (cdr Info-history))
1519 (Info-find-node (nth 0 hist) (nth 1 hist) t)
1520 (goto-char (nth 2 hist)))))))
1521
1522
1523
1524 ;; REPLACE ORIGINAL in `info.el':
1525 ;; Call `fit-frame' if `Info-fit-frame-flag'.
1526 ;;
1527 (when (> emacs-major-version 22)
1528 (defun Info-find-node-2 (filename nodename &optional no-going-back)
1529 (buffer-disable-undo (current-buffer))
1530 (or (eq major-mode 'Info-mode) (Info-mode))
1531 (widen)
1532 (setq Info-current-node nil)
1533 (unwind-protect
1534 (let ((case-fold-search t)
1535 (virtual-fun (and (fboundp 'Info-virtual-fun) ; Emacs 23.2.
1536 (Info-virtual-fun 'find-node
1537 (or filename Info-current-file)
1538 nodename)))
1539 anchorpos)
1540 (cond ((functionp virtual-fun)
1541 (let ((filename (or filename Info-current-file)))
1542 (setq buffer-read-only nil
1543 Info-current-file filename
1544 Info-current-subfile nil
1545 Info-current-file-completions ()
1546 buffer-file-name nil)
1547 (erase-buffer)
1548 (Info-virtual-call virtual-fun filename nodename no-going-back)
1549 (set-marker Info-tag-table-marker nil)
1550 (setq buffer-read-only t)
1551 (set-buffer-modified-p nil)
1552 (set (make-local-variable 'Info-current-node-virtual) t)))
1553 ((not (and (or (not (boundp 'Info-current-node-virtual))
1554 (not Info-current-node-virtual))
1555 (or (null filename) (equal Info-current-file filename))))
1556 ;; Switch files if necessary
1557 (let ((inhibit-read-only t))
1558 (when (and (boundp 'Info-current-node-virtual) Info-current-node-virtual)
1559 ;; When moving from a virtual node.
1560 (set (make-local-variable 'Info-current-node-virtual) nil)
1561 (unless filename (setq filename Info-current-file)))
1562 (setq Info-current-file nil
1563 Info-current-subfile nil
1564 Info-current-file-completions ()
1565 buffer-file-name nil)
1566 (erase-buffer)
1567 (cond ((eq filename t) (Info-insert-dir))
1568 ((eq filename 'apropos) (insert-buffer-substring " *info-apropos*"))
1569 ((eq filename 'history) (insert-buffer-substring " *info-history*"))
1570 ((eq filename 'toc) (insert-buffer-substring " *info-toc*"))
1571 (t (info-insert-file-contents filename nil)
1572 (setq default-directory (file-name-directory filename))))
1573 (set-buffer-modified-p nil)
1574 (set (make-local-variable 'Info-file-supports-index-cookies)
1575 (Info-file-supports-index-cookies filename))
1576
1577 ;; See whether file has a tag table. Record the location if yes.
1578 (goto-char (point-max))
1579 (forward-line -8)
1580 ;; Use string-equal, not equal, to ignore text props.
1581 (if (not (or (string-equal nodename "*")
1582 (not (search-forward "\^_\nEnd tag table\n" nil t))))
1583 (let (pos)
1584 ;; We have a tag table. Find its beginning.
1585 ;; Is this an indirect file?
1586 (search-backward "\nTag table:\n")
1587 (setq pos (point))
1588 (if (save-excursion (forward-line 2) (looking-at "(Indirect)\n"))
1589 ;; It is indirect. Copy it to another buffer
1590 ;; and record that the tag table is in that buffer.
1591 (let ((buf (current-buffer))
1592 (tagbuf (or Info-tag-table-buffer
1593 (generate-new-buffer " *info tag table*"))))
1594 (setq Info-tag-table-buffer tagbuf)
1595 (with-current-buffer tagbuf
1596 (buffer-disable-undo (current-buffer))
1597 (setq case-fold-search t)
1598 (erase-buffer)
1599 (insert-buffer-substring buf))
1600 (set-marker Info-tag-table-marker (match-end 0) tagbuf))
1601 (set-marker Info-tag-table-marker pos)))
1602 (set-marker Info-tag-table-marker nil))
1603 (setq Info-current-file filename))))
1604 ;; Use string-equal, not equal, to ignore text props.
1605 (if (string-equal nodename "*")
1606 (progn (setq Info-current-node nodename) (Info-set-mode-line))
1607 ;; Possibilities:
1608 ;;
1609 ;; 1. Anchor found in tag table
1610 ;; 2. Anchor *not* in tag table
1611 ;;
1612 ;; 3. Node found in tag table
1613 ;; 4. Node *not* found in tag table, but found in file
1614 ;; 5. Node *not* in tag table, and *not* in file
1615 ;;
1616 ;; *Or* the same, but in an indirect subfile.
1617 ;;
1618 ;;
1619 ;; Search file for a suitable node.
1620 (let ((guesspos (point-min))
1621 (regexp (concat "\\(Node:\\|Ref:\\) *\\(" (if (stringp nodename)
1622 (regexp-quote nodename)
1623 "")
1624 "\\) *[,\t\n\177]")))
1625 (catch 'foo
1626 ;; First, search a tag table, if any
1627 (when (marker-position Info-tag-table-marker)
1628 (let* ((m Info-tag-table-marker)
1629 (found (Info-find-in-tag-table m regexp)))
1630 (when found
1631 ;; FOUND is (ANCHOR POS MODE).
1632 (setq guesspos (nth 1 found))
1633 ;; If this is an indirect file, determine which
1634 ;; file really holds this node and read it in.
1635 (unless (eq (nth 2 found) 'Info-mode)
1636 ;; Note that the current buffer must be the
1637 ;; *info* buffer on entry to
1638 ;; Info-read-subfile. Thus the hackery above.
1639 (setq guesspos (Info-read-subfile guesspos)))
1640 ;; Handle anchor
1641 (when (nth 0 found)
1642 (goto-char (setq anchorpos guesspos)) (throw 'foo t)))))
1643 ;; Else we may have a node, which we search for:
1644 (goto-char (max (point-min) (- (byte-to-position guesspos) 1000)))
1645 ;; Now search from our advised position (or from beg of
1646 ;; buffer) to find the actual node. First, check
1647 ;; whether the node is right where we are, in case the
1648 ;; buffer begins with a node.
1649 (let ((pos (Info-find-node-in-buffer regexp)))
1650 (when pos (goto-char pos) (throw 'foo t)))
1651 (when (string-match "\\([^.]+\\)\\." nodename)
1652 (let (Info-point-loc)
1653 (Info-find-node-2 filename (match-string 1 nodename) no-going-back))
1654 (widen)
1655 (throw 'foo t))
1656 ;; No such anchor in tag table or node in tag table or file
1657 (error "No such node or anchor: %s" nodename))
1658 (Info-select-node)
1659 (goto-char (point-min))
1660 (forward-line 1) ; skip header line
1661 (when (and (not (fboundp 'Info-breadcrumbs)) ; Before Emacs 23.2
1662 Info-breadcrumbs-in-header-flag
1663 (> Info-breadcrumbs-depth 0))
1664 (forward-line 1)) ; skip breadcrumbs line
1665 (cond (anchorpos
1666 (let ((new-history (list Info-current-file (substring-no-properties nodename))))
1667 ;; Add anchors to the history too
1668 (setq Info-history-list (cons new-history
1669 (delete new-history Info-history-list))))
1670 (goto-char anchorpos))
1671 ((numberp Info-point-loc)
1672 (forward-line (- Info-point-loc 2))
1673 (setq Info-point-loc nil))
1674 ((stringp Info-point-loc)
1675 (Info-find-index-name Info-point-loc)
1676 (setq Info-point-loc nil)))))
1677 (when (and (one-window-p t) (not (window-minibuffer-p))
1678 (fboundp 'fit-frame) ; Defined in `fit-frame.el'.
1679 Info-fit-frame-flag)
1680 (fit-frame)))
1681 ;; If we did not finish finding the specified node,
1682 ;; go back to the previous one.
1683 (or Info-current-node no-going-back (null Info-history)
1684 (let ((hist (car Info-history)))
1685 (setq Info-history (cdr Info-history))
1686 (Info-find-node (nth 0 hist) (nth 1 hist) t)
1687 (goto-char (nth 2 hist)))))
1688 (Info-set-mode-line)))
1689
1690
1691
1692 ;; REPLACE ORIGINAL in `info.el':
1693 ;;
1694 ;; Handle `Info-breadcrumbs-in-mode-line-mode'.
1695 ;;
1696 (when (> emacs-major-version 22)
1697 (defun Info-set-mode-line ()
1698 "Set the Info mode line.
1699 If `Info-breadcrumbs-in-mode-line-mode' is non-nil, insert breadcrumbs."
1700 (if Info-breadcrumbs-in-mode-line-mode
1701 (Info-insert-breadcrumbs-in-mode-line)
1702 (setq mode-line-buffer-identification
1703 (nconc (propertized-buffer-identification "%b")
1704 (list
1705 (concat
1706 " ("
1707 (if (stringp Info-current-file)
1708 (replace-regexp-in-string
1709 "%" "%%" (file-name-nondirectory Info-current-file))
1710 (format "*%S*" Info-current-file))
1711 ") "
1712 (if Info-current-node
1713 (propertize (replace-regexp-in-string
1714 "%" "%%" Info-current-node)
1715 'face 'mode-line-buffer-id
1716 'help-echo
1717 "mouse-1: scroll forward, mouse-3: scroll back"
1718 'mouse-face 'mode-line-highlight
1719 'local-map Info-mode-line-node-keymap)
1720 ""))))))))
1721
1722 (when (> emacs-major-version 22)
1723 (defun Info-insert-breadcrumbs-in-mode-line ()
1724 (let ((nodes (Info-toc-nodes Info-current-file))
1725 (node Info-current-node)
1726 (crumbs ())
1727 (depth Info-breadcrumbs-depth-internal)
1728 (text ""))
1729 ;; Get ancestors from the cached parent-children node info
1730 (while (and (not (equal "Top" node)) (> depth 0))
1731 (setq node (nth 1 (assoc node nodes)))
1732 (when node (push node crumbs))
1733 (setq depth (1- depth)))
1734 ;; Add bottom node.
1735 (setq crumbs (nconc crumbs (list Info-current-node)))
1736 (when crumbs
1737 ;; Add top node (and continuation if needed).
1738 (setq crumbs (cons "Top" (if (member (pop crumbs) '(nil "Top"))
1739 crumbs
1740 (cons nil crumbs))))
1741 (dolist (node crumbs)
1742 (let ((crumbs-map (make-sparse-keymap))
1743 (menu-map (make-sparse-keymap "Breadcrumbs in Mode Line")))
1744 (define-key crumbs-map [mode-line mouse-3] menu-map)
1745 (when node
1746 (define-key menu-map [Info-prev]
1747 `(menu-item "Previous Node" Info-prev
1748 :visible ,(Info-check-pointer "prev[ious]*") :help "Go to the previous node"))
1749 (define-key menu-map [Info-next]
1750 `(menu-item "Next Node" Info-next
1751 :visible ,(Info-check-pointer "next") :help "Go to the next node"))
1752 (define-key menu-map [separator] '("--"))
1753 (define-key menu-map [Info-breadcrumbs-in-mode-line-mode]
1754 `(menu-item "Toggle Breadcrumbs" Info-breadcrumbs-in-mode-line-mode
1755 :help "Toggle displaying breadcrumbs in the Info mode-line"
1756 :button (:toggle . Info-breadcrumbs-in-mode-line-mode)))
1757 (define-key menu-map [Info-set-breadcrumbs-depth]
1758 `(menu-item "Set Breadcrumbs Depth" Info-set-breadcrumbs-depth
1759 :help "Set depth of breadcrumbs to show in the mode-line"))
1760 (setq node (if (equal node Info-current-node)
1761 (propertize
1762 (replace-regexp-in-string "%" "%%" Info-current-node)
1763 'face 'mode-line-buffer-id
1764 'help-echo "mouse-1: Scroll back, mouse-2: Scroll forward, mouse-3: Menu"
1765 'mouse-face 'mode-line-highlight
1766 'local-map
1767 (progn
1768 (define-key crumbs-map [mode-line mouse-1] 'Info-mouse-scroll-down)
1769 (define-key crumbs-map [mode-line mouse-2] 'Info-mouse-scroll-up)
1770 crumbs-map))
1771 (propertize
1772 node
1773 'local-map (progn (define-key crumbs-map [mode-line mouse-1]
1774 `(lambda () (interactive) (Info-goto-node ,node)))
1775 (define-key crumbs-map [mode-line mouse-2]
1776 `(lambda () (interactive) (Info-goto-node ,node)))
1777 crumbs-map)
1778 'mouse-face 'mode-line-highlight
1779 'help-echo "mouse-1, mouse-2: Go to this node; mouse-3: Menu")))))
1780 (let ((nodetext (if (not (equal node "Top"))
1781 node
1782 (concat (format "(%s)" (if (stringp Info-current-file)
1783 (file-name-nondirectory Info-current-file)
1784 ;; Some legacy code can still use a symbol.
1785 Info-current-file))
1786 node))))
1787 (setq text (concat text (if (equal node "Top") "" " > ") (if node nodetext "...")))))
1788 (make-local-variable 'mode-line-format) ; Needed for Emacs 21+.
1789 (setq mode-line-format text)))))
1790
1791
1792
1793 ;; REPLACE ORIGINAL in `info.el':
1794 ;; BUG FIX (bug reported 2008-10-04).
1795 ;; 1. Match closing paren, if present.
1796 ;; 2. If only opening paren and CODE = t, then wrap each file name in ().
1797 ;;
1798 (when (> emacs-major-version 22)
1799 (defun Info-read-node-name-1 (string predicate code)
1800 (cond ((string-match "\\`(\\([^)]*\\))\\'" string) ; e.g. (emacs) or (emacs-mime)
1801 (cond ((eq code nil) string)
1802 ((eq code t) (list string))
1803 (t t)))
1804 ((string-match "\\`(\\([^)]*\\)\\'" string) ; e.g. (emacs
1805 (let ((ctwc (completion-table-with-context
1806 "("
1807 (apply-partially
1808 'completion-table-with-terminator ")"
1809 (apply-partially 'Info-read-node-name-2
1810 Info-directory-list
1811 (mapcar 'car Info-suffix-list)))
1812 (match-string 1 string)
1813 predicate
1814 code)))
1815 (cond ((eq code nil) ctwc)
1816 ((eq code t) (mapcar (lambda (file) (concat "(" file ")")) ctwc))
1817 (t t))))
1818 ((string-match "\\`(" string) ; e.g. (emacs)Mac OS or (jlkj - just punt.
1819 (cond ((eq code nil) string)
1820 ((eq code t) nil)
1821 (t t)))
1822 ;; Otherwise use Info-read-node-completion-table - e.g. Mac OS
1823 (t (complete-with-action code Info-read-node-completion-table string predicate)))))
1824
1825
1826
1827 ;; REPLACE ORIGINAL in `info.el':
1828 ;; BUG FIX (bug reported 2008-10-04).
1829 ;; 1. Match closing paren, if present.
1830 ;; 2. If only opening paren and CODE = t, then wrap each file name in ().
1831 ;;
1832 (when (= emacs-major-version 22)
1833 (defun Info-read-node-name-1 (string predicate code)
1834 (cond ((string-match "\\`(\\([^)]*\\))\\'" string) ; e.g. (emacs) or (emacs-mime)
1835 (cond ((eq code nil) string)
1836 ((eq code t) (list string))
1837 (t t)))
1838 ((string-match "\\`(\\([^)]*\\)\\'" string) ; e.g. (emacs
1839 (let ((file (match-string 1 string)))
1840 (cond ((eq code nil)
1841 (let ((comp (try-completion file 'Info-read-node-name-2
1842 (cons Info-directory-list
1843 (mapcar #'car Info-suffix-list)))))
1844 (cond ((eq comp t) (concat string ")"))
1845 (comp (concat "(" comp)))))
1846 ((eq code t)
1847 (mapcar (lambda (file) (concat "(" file ")"))
1848 (all-completions file 'Info-read-node-name-2
1849 (cons Info-directory-list
1850 (mapcar #'car Info-suffix-list)))))
1851 (t nil))))
1852 ((string-match "\\`(" string) ; e.g. (emacs)Mac OS or (jlkj - just punt.
1853 (cond ((eq code nil) string)
1854 ((eq code t) nil)
1855 (t t)))
1856 ;; Otherwise use Info-read-node-completion-table - e.g. Mac OS
1857 ((eq code nil)
1858 (try-completion string Info-read-node-completion-table predicate))
1859 ((eq code t)
1860 (all-completions string Info-read-node-completion-table predicate))
1861 (t (test-completion string Info-read-node-completion-table predicate)))))
1862
1863
1864
1865 (when (< emacs-major-version 22)
1866
1867 ;; REPLACE ORIGINAL in `info.el':
1868 ;; 1. Match closing paren, if present.
1869 ;; 2. If only opening paren and CODE = t, then wrap each file name in ().
1870 ;;
1871 (defun Info-read-node-name-1 (string predicate code)
1872 (cond ((string-match "\\`(\\([^)]*\\))\\'" string) ; e.g. (emacs) or (emacs-mime)
1873 (cond ((eq code nil) string)
1874 ((eq code t) (list string))
1875 (t t)))
1876 ((string-match "\\`(\\([^)]*\\)\\'" string) ; e.g. (emacs
1877 (let ((file (match-string 1 string)))
1878 (cond ((eq code nil)
1879 (let ((comp (try-completion file 'Info-read-node-name-2
1880 (cons Info-directory-list
1881 (mapcar #'car Info-suffix-list)))))
1882 (cond ((eq comp t) (concat string ")"))
1883 (comp (concat "(" comp)))))
1884 ((eq code t)
1885 (mapcar (lambda (file) (concat "(" file ")"))
1886 (all-completions file 'Info-read-node-name-2
1887 (cons Info-directory-list
1888 (mapcar #'car Info-suffix-list)))))
1889 (t nil))))
1890 ((eq code nil) (try-completion string Info-read-node-completion-table predicate))
1891 ((eq code t) (all-completions string Info-read-node-completion-table predicate))
1892 (t (assoc string Info-read-node-completion-table))))
1893
1894 ;; Adapted from Emacs 22 `Info-read-node-name-2' (there is normally no such function for 20, 21).
1895 (defun Info-read-node-name-2 (string path-and-suffixes action)
1896 "Virtual completion table for file names input in Info node names.
1897 PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
1898 (let* ((names ())
1899 (suffixes (remove "" (cdr path-and-suffixes)))
1900 (suffix (concat (regexp-opt suffixes t) "\\'"))
1901 (string-dir (file-name-directory string))
1902 (dirs (if (file-name-absolute-p string)
1903 (list (file-name-directory string))
1904 (car path-and-suffixes))))
1905 (dolist (dir dirs)
1906 (unless dir (setq dir default-directory))
1907 (if string-dir (setq dir (expand-file-name string-dir dir)))
1908 (when (file-directory-p dir)
1909 (dolist (file (file-name-all-completions (file-name-nondirectory string) dir))
1910 ;; If the file name has no suffix or a standard suffix, include it.
1911 (and (or (null (file-name-extension file)) (string-match suffix file))
1912 ;; But exclude subfiles of split Info files.
1913 (not (string-match "-[0-9]+\\'" file))
1914 ;; And exclude backup files.
1915 (not (string-match "~\\'" file))
1916 (push (if string-dir (concat string-dir file) file) names))
1917 ;; If the file name ends in a standard suffix,
1918 ;; add the unsuffixed name as a completion option.
1919 (when (string-match suffix file)
1920 (setq file (substring file 0 (match-beginning 0)))
1921 (push (if string-dir (concat string-dir file) file) names)))))
1922 (cond ((eq action t) (all-completions string (mapcar #'list names)))
1923 ((null action) (try-completion string (mapcar #'list names)))
1924 (t (assoc string Info-read-node-completion-table))))))
1925
1926
1927
1928 ;; REPLACE ORIGINAL in `info.el':
1929 ;; 1. Added in-progress message ("Looking...")
1930 ;; 2, Return nil if not found.
1931 ;;
1932 (defun Info-find-emacs-command-nodes (command)
1933 "Return a list of locations documenting COMMAND.
1934 The `info-file' property of COMMAND says which Info manual to search.
1935 If COMMAND has no property, the variable `Info-file-list-for-emacs'
1936 defines heuristics for which Info manual to try.
1937 The locations are of the format used in variable `Info-history', that
1938 is, (FILENAME NODENAME BUFFERPOS\)."
1939 (let ((where ())
1940 (cmd-desc (concat "^\\* +" (regexp-quote (symbol-name command))
1941 (if (< emacs-major-version 21)
1942 ":\\s *\\(.*\\)\\.$"
1943 "\\( <[0-9]+>\\)?:\\s *\\(.*\\)\\.$")))
1944 (info-file "emacs")) ;default
1945 ;; Determine which info file this command is documented in.
1946 (if (get command 'info-file)
1947 (setq info-file (get command 'info-file))
1948 ;; If it doesn't say explicitly, test its name against
1949 ;; various prefixes that we know.
1950 (let ((file-list Info-file-list-for-emacs))
1951 (while file-list
1952 (let* ((elt (car file-list))
1953 (name (if (consp elt) (car elt) elt))
1954 (file (if (consp elt) (cdr elt) elt))
1955 (regexp (concat "\\`" (regexp-quote name) "\\(\\'\\|-\\)")))
1956 (if (string-match regexp (symbol-name command))
1957 (setq info-file file
1958 file-list ()))
1959 (setq file-list (cdr file-list))))))
1960 (message "Looking for command `%s' in Info manual `%s'..."
1961 command (file-name-nondirectory info-file))
1962
1963 (cond ((>= emacs-major-version 22)
1964 (save-excursion
1965 (condition-case nil
1966 (progn (Info-find-node info-file "Top")
1967 (or (and (search-forward "\n* menu:" nil t)
1968 (re-search-forward "\n\\* \\(.*\\<Index\\>\\)" nil t))
1969 (error "Info file `%s' appears to lack an index" info-file)))
1970 (error nil)) ; Return nil: not found.
1971 (goto-char (match-beginning 1))
1972 ;; Bind Info-history to nil, to prevent the index nodes from
1973 ;; getting into the node history.
1974 (let ((Info-history ())
1975 (Info-history-list ())
1976 node
1977 (nodes (Info-index-nodes)))
1978 (Info-goto-node (car nodes))
1979 (while
1980 (progn (goto-char (point-min))
1981 (while (re-search-forward cmd-desc nil t)
1982 (setq where (cons (list Info-current-file
1983 (match-string-no-properties 2)
1984 0)
1985 where)))
1986 (and (setq nodes (cdr nodes)
1987 node (car nodes))))
1988 (Info-goto-node node)))
1989 where))
1990 ((>= emacs-major-version 21)
1991 (save-excursion
1992 (condition-case nil
1993 (progn (Info-find-node info-file "Top")
1994 (or (and (search-forward "\n* menu:" nil t)
1995 (re-search-forward "\n\\* \\(.*\\<Index\\>\\)" nil t))
1996 (error "Info file `%s' appears to lack an index" info-file)))
1997 (error nil)) ; Return nil: not found.
1998 (goto-char (match-beginning 1))
1999 ;; Bind Info-history to nil, to prevent the index nodes from
2000 ;; getting into the node history.
2001 (let ((Info-history ())
2002 (exact nil)
2003 node found)
2004 (Info-goto-node (Info-extract-menu-node-name))
2005 (while
2006 (progn
2007 (goto-char (point-min))
2008 (while (re-search-forward cmd-desc nil t)
2009 (setq where (cons (list Info-current-file (match-string-no-properties 2) 0)
2010 where)))
2011 (and (setq node (Info-extract-pointer "next" t))
2012 (string-match "\\<Index\\>" node)))
2013 (Info-goto-node node)))
2014 where))
2015 (t
2016 (save-excursion
2017 (condition-case nil
2018 (Info-find-node info-file "Command Index")
2019 ;; Some manuals may not have a separate Command Index node,
2020 ;; so try just Index instead.
2021 (error (condition-case nil
2022 (Info-find-node info-file "Index")
2023 (error nil)))) ; Return nil: not found.
2024 ;; Take the index node off the Info history.
2025 (setq Info-history (cdr Info-history))
2026 (goto-char (point-max))
2027 (while (re-search-backward cmd-desc nil t)
2028 (setq where (cons (list Info-current-file
2029 (buffer-substring (match-beginning 1) (match-end 1))
2030 0)
2031 where)))
2032 where)))))
2033
2034
2035 ;; REPLACES ORIGINAL in `info.el':
2036 ;; 1. Uses `completing-read' in interactive spec, with `symbol-nearest-point'
2037 ;; (defined in `thingatpt+.el') or `symbol-at-point' (defined in `thingatpt.el').
2038 ;; 2. Message if single node found.
2039 ;; 3. Returns `num-matches' if found; nil if not.
2040 ;;
2041 ;;;###autoload
2042 (defun Info-goto-emacs-command-node (command)
2043 "Go to the Info node in the Emacs manual for command COMMAND.
2044 The command is found by looking it up in Emacs manual's indexes,
2045 or in another manual found via COMMAND's `info-file' property or
2046 the variable `Info-file-list-for-emacs'.
2047 COMMAND must be a symbol or string."
2048 (interactive
2049 (let ((symb (cond ((fboundp 'symbol-nearest-point) (symbol-nearest-point))
2050 ((fboundp 'symbol-at-point) (symbol-at-point))
2051 (t nil)))
2052 (enable-recursive-minibuffers t))
2053 (list (intern (completing-read "Find documentation for command: "
2054 obarray 'commandp t nil nil (symbol-name symb) t)))))
2055 (unless (commandp command)
2056 (signal 'wrong-type-argument (list 'commandp command)))
2057 (let ((where (Info-find-emacs-command-nodes command)))
2058 (if where
2059 (let ((num-matches (length where)))
2060 ;; Get Info running, and pop to it in another window.
2061 (save-window-excursion (info))
2062 (or (eq major-mode 'Info-mode) (pop-to-buffer "*info*"))
2063 ;; Bind Info-history to nil, to prevent the last Index node
2064 ;; visited by Info-find-emacs-command-nodes from being
2065 ;; pushed onto the history.
2066 (let ((Info-history ())
2067 (Info-history-list ()))
2068 (Info-find-node (car (car where)) (car (cdr (car where)))))
2069 (if (<= num-matches 1)
2070 (when (interactive-p) (message "This info node documents command `%s'." command))
2071
2072 ;; (car where) will be pushed onto Info-history
2073 ;; when/if they go to another node. Put the other
2074 ;; nodes that were found on the history.
2075 (setq Info-history (nconc (cdr where) Info-history))
2076 (when (interactive-p)
2077 (message "Found %d other entr%s. Use %s to see %s."
2078 (1- num-matches) (if (> num-matches 2) "ies" "y")
2079 (substitute-command-keys (if (>= emacs-major-version 22)
2080 "\\<Info-mode-map>\\[Info-history-back]"
2081 "\\<Info-mode-map>\\[Info-last]"))
2082 (if (> num-matches 2) "them" "it"))))
2083 num-matches) ; Return num-matches found.
2084 (and (interactive-p) ; Return nil for unfound.
2085 (error "No documentation found for command `%s'" command)))))
2086
2087
2088 ;; REPLACES ORIGINAL in `info.el':
2089 ;; If key's command is not found, then `Info-search' for key sequence in text.
2090 ;; Message for repeating.
2091 ;;
2092 ;;;###autoload
2093 (defun Info-goto-emacs-key-command-node (key)
2094 "Go to the node in the Emacs manual describing command bound to KEY.
2095 KEY is a string.
2096
2097 Interactively, if the binding is `execute-extended-command', then a
2098 command is read.
2099
2100 The command is found by looking it up in Emacs manual's indexes,
2101 or in another manual's index found via COMMAND's `info-file' property
2102 or the variable `Info-file-list-for-emacs'.
2103
2104 If key's command cannot be found by looking in indexes, then
2105 `Info-search' is used to search for the key sequence in the info text."
2106 (interactive "kFind documentation for key: ")
2107 (let ((command (lookup-key global-map key))
2108 (pp-key (key-description key)))
2109 (when (natnump command) (setq command (key-binding key))) ; E.g. menu item.
2110 (cond ((null command)
2111 (when (interactive-p) (message "No doc found for key sequence `%s'." pp-key))
2112 nil) ; RETURN nil: not found.
2113 ((and (interactive-p) (eq command 'execute-extended-command)) ; Read a new command name.
2114 (Info-goto-emacs-command-node (read-command "Find documentation for command: ")))
2115 (t
2116 (let ((this-file Info-current-file)
2117 (this-node Info-current-node)
2118 (num-cmd-matches (Info-goto-emacs-command-node command)))
2119 (cond (num-cmd-matches
2120 ;; Found key's command via a manual index.
2121 (when (interactive-p)
2122 (if (<= num-cmd-matches 1)
2123 (message "This info node documents key `%s'." pp-key)
2124 (message
2125 (substitute-command-keys
2126 (concat "Found %d other entr%s. Use "
2127 (if (>= emacs-major-version 22)
2128 "\\<Info-mode-map>`\\[Info-history-back]' to see %s."
2129 "\\<Info-mode-map>`\\[Info-last]' to see %s.")))
2130 (1- num-cmd-matches) (if (> num-cmd-matches 2) "ies" "y")
2131 (if (> num-cmd-matches 2) "them" "it"))))
2132 num-cmd-matches) ; RETURN num-cmd-matches: found.
2133 (t;; Couldn't find key's command via a manual index.
2134 ;; Get back to where we were.
2135 ;; Would be better if there were a save-xxx-excursion-xxx
2136 ;; that would work.
2137 (Info-goto-node (concat "(" this-file ")" this-node))
2138 ;; Would be better to now try looking for the key in indexes (e.g. Key
2139 ;; Index). Instead, just look for the key sequence in the text.
2140 (when (interactive-p)
2141 (message "Not found using Index. Searching for \"%s\" in text..." pp-key)
2142 (sit-for 3))
2143 (condition-case err
2144 (progn
2145 (Info-search (regexp-quote pp-key))
2146 (when (interactive-p)
2147 (message (substitute-command-keys
2148 "Use \\<Info-mode-map>`\\[Info-search] RET' \
2149 to search again for `%s'.")
2150 pp-key))
2151 t) ; RETURN t: found.
2152 (search-failed (message "No documentation found for key `%s'." pp-key)
2153 nil))))))))) ; RETURN nil: not found.
2154
2155
2156 ;; REPLACES ORIGINAL in `info.el':
2157 ;; 1. File name in face `info-file'.
2158 ;; 2. Node names in face `info-node'.
2159 ;; 3. Menu items in face `info-menu'.
2160 ;; 4. Only 5th and 9th menu items have their `*' colored.
2161 ;; 5. Notes in face `info-xref'.
2162 ;; 6. If `Info-fontify-quotations-flag', fontify `...' in face `info-quoted-name',
2163 ;; "..." in face `info-string', and ' in face `info-single-quote'.
2164 ;;
2165 (unless (> emacs-major-version 21)
2166 (defun Info-fontify-node ()
2167 (save-excursion
2168 (let ((buffer-read-only nil)
2169 (case-fold-search t))
2170 (goto-char (point-min))
2171 ;; Header line.
2172 (when (looking-at "^File: \\([^,: \t]+\\),?[ \t]+")
2173 (put-text-property (match-beginning 1) (match-end 1) 'face 'info-file)
2174 (goto-char (match-end 0))
2175 ;; Node names in menu at top of buffer.
2176 (while (looking-at "[ \t]*\\([^:, \t\n]+\\):[ \t]+\\([^:,\t\n]+\\),?")
2177 (goto-char (match-end 0))
2178 (if (save-excursion
2179 (goto-char (match-beginning 1))
2180 (save-match-data (looking-at "Node:")))
2181 (put-text-property (match-beginning 2) (match-end 2) 'face 'info-node)
2182 (put-text-property (match-beginning 2) (match-end 2) 'face 'info-xref)
2183 (put-text-property (match-beginning 2) (match-end 2) 'mouse-face 'highlight))))
2184 (goto-char (point-min))
2185 ;; Text headings: replace ***'s, ---'s, ==='s by faces.
2186 (while (re-search-forward "\n\\([^ \t\n].+\\)\n\\(\\*+\\|=+\\|-+\\)$"
2187 nil t)
2188 (put-text-property (match-beginning 1) (match-end 1)
2189 'face
2190 (cdr (assq (preceding-char) Info-title-face-alist)))
2191 ;; This is a serious problem for trying to handle multiple
2192 ;; frame types at once. We want this text to be invisible
2193 ;; on frames that can display the font above.
2194 (if (memq (framep (selected-frame)) '(x pc w32 win32))
2195 (put-text-property (match-end 1) (match-end 2) 'invisible t)))
2196 (goto-char (point-min))
2197 ;; Cross references.
2198 (while (re-search-forward "\\*Note[ \n\t]+\\([^:]*\\):" nil t)
2199 (unless (= (char-after (1- (match-beginning 0))) ?\") ; hack
2200 (put-text-property (match-beginning 1) (match-end 1) 'face 'info-xref)
2201 (put-text-property (match-beginning 1) (match-end 1) 'mouse-face 'highlight)))
2202 (goto-char (point-min))
2203 ;; Menus.
2204 (when (and (search-forward "\n* Menu:" nil t)
2205 ;; Fontify indexes too.
2206 ;;(not (string-match "\\<Index\\>" Info-current-node))
2207 ;; Don't take time to annotate huge menus
2208 (< (- (point-max) (point)) Info-fontify-maximum-menu-size))
2209 (let ((n 0))
2210 (while (re-search-forward "^\\* +\\([^:\t\n]*\\):" nil t)
2211 (setq n (1+ n))
2212 (when (memq n '(5 9)) ; visual aids to help with 1-9 keys
2213 (put-text-property (match-beginning 0) (1+ (match-beginning 0))
2214 'face 'info-menu)) ; was: info-menu-5
2215 (put-text-property (match-beginning 1) (match-end 1) 'face 'info-menu) ; was: info-xref
2216 (put-text-property (match-beginning 1) (match-end 1)
2217 'mouse-face 'highlight))))
2218
2219 ;; Fontify `...' and "..."
2220 (goto-char (point-min))
2221 (when Info-fontify-quotations-flag (info-fontify-quotations)) ; Fontify `...' and "..."
2222 ;; Fontify reference items: `-- Function:', `-- Variable:', etc.
2223 (goto-char (point-min))
2224 (when Info-fontify-reference-items-flag (info-fontify-reference-items))
2225 (set-buffer-modified-p nil)))))
2226
2227
2228 ;; REPLACES ORIGINAL in `info.el':
2229 ;; 1. File name in face `info-file'.
2230 ;; 2. If `Info-fontify-quotations-flag', fontify `...' in face `info-quoted-name',
2231 ;; "..." in face `info-string', and ' in face `info-single-quote'.
2232 ;;
2233 (when (= emacs-major-version 22)
2234 (defun Info-fontify-node ()
2235 "Fontify the node."
2236 (save-excursion
2237 (let* ((inhibit-read-only t)
2238 (case-fold-search t)
2239 paragraph-markers
2240 (not-fontified-p ; the node hasn't already been fontified
2241 (not (let ((where (next-property-change (point-min))))
2242 (and where (not (= where (point-max)))))))
2243 (fontify-visited-p ; visited nodes need to be re-fontified
2244 (and Info-fontify-visited-nodes
2245 ;; Don't take time to refontify visited nodes in huge nodes
2246 Info-fontify-maximum-menu-size
2247 (< (- (point-max) (point-min)) Info-fontify-maximum-menu-size)))
2248 rbeg rend)
2249
2250 ;; Fontify header line
2251 (goto-char (point-min))
2252 (when (and not-fontified-p (looking-at "^File: \\([^,: \t]+\\),?[ \t]+"))
2253 (put-text-property (match-beginning 1) (match-end 1) 'font-lock-face 'info-file))
2254 (goto-char (point-min))
2255 (when (and not-fontified-p (looking-at "^\\(File: [^,: \t]+,?[ \t]+\\)?"))
2256 (while (looking-at "[ \t]*\\([^:, \t\n]+\\):[ \t]+\\([^:,\t\n]+\\),?")
2257 (goto-char (match-end 0))
2258 (let* ((nbeg (match-beginning 2))
2259 (nend (match-end 2))
2260 (tbeg (match-beginning 1))
2261 (tag (match-string 1)))
2262 (if (string-equal (downcase tag) "node")
2263 (put-text-property nbeg nend 'font-lock-face 'info-header-node)
2264 (put-text-property nbeg nend 'font-lock-face 'info-header-xref)
2265 (put-text-property tbeg nend 'mouse-face 'highlight)
2266 (put-text-property tbeg nend
2267 'help-echo
2268 (concat "mouse-2: Go to node "
2269 (buffer-substring nbeg nend)))
2270 ;; Always set up the text property keymap.
2271 ;; It will either be used in the buffer
2272 ;; or copied in the header line.
2273 (put-text-property tbeg nend 'keymap
2274 (cond
2275 ((string-equal (downcase tag) "prev") Info-prev-link-keymap)
2276 ((string-equal (downcase tag) "next") Info-next-link-keymap)
2277 ((string-equal (downcase tag) "up" ) Info-up-link-keymap))))))
2278 ;; Add breadcrumbs - my version.
2279 (unless (string= "Top" Info-current-node)
2280 (let ((nod Info-current-node)
2281 (onode Info-current-node)
2282 (crumbs ())
2283 (done nil))
2284 (while (not done)
2285 (let ((up (Info-extract-pointer "up")))
2286 (cond ((string= "Top" up)
2287 (setq crumbs (if crumbs
2288 (concat "*Note Top:: > " crumbs)
2289 "*Note Top::")
2290 done t))
2291 (t
2292 (let ((Info-fontify-maximum-menu-size nil) ; Prevents infinite recursion
2293 (Info-history Info-history)
2294 (Info-history-list Info-history-list))
2295 (Info-goto-node up))
2296 (setq nod Info-current-node)
2297 (when crumbs (setq crumbs (concat " > " crumbs)))
2298 (setq crumbs (concat "*Note " nod ":: " crumbs))))))
2299 (let ((Info-fontify-maximum-menu-size nil) ; Prevents infinite recursion
2300 (Info-history Info-history)
2301 (Info-history-list Info-history-list))
2302 (Info-goto-node onode))
2303 (forward-line 1)
2304 (insert (concat crumbs "\n\n"))))
2305
2306 ;; Treat header line
2307 (when Info-use-header-line
2308 (goto-char (point-min))
2309 (let* ((header-end (line-end-position))
2310 (header
2311 ;; If we find neither Next: nor Prev: link, show the entire
2312 ;; node header. Otherwise, don't show the File: and Node:
2313 ;; parts, to avoid wasting precious space on information that
2314 ;; is available in the mode line.
2315 (if (re-search-forward "\\(next\\|up\\|prev[ious]*\\): "
2316 header-end t)
2317 (progn (goto-char (match-beginning 1))
2318 (buffer-substring (point) header-end))
2319 (if (re-search-forward "node:[ \t]*[^ \t]+[ \t]*" header-end t)
2320 (concat "No next, prev or up links -- "
2321 (buffer-substring (point) header-end))
2322 (buffer-substring (point) header-end)))))
2323 (put-text-property (point-min) (1+ (point-min))
2324 'header-line
2325 (replace-regexp-in-string
2326 "%"
2327 ;; Preserve text properties on duplicated `%'.
2328 (lambda (s) (concat s s)) header))
2329 ;; Hide the part of the first line
2330 ;; that is in the header, if it is just part.
2331 (unless (bobp)
2332 ;; Hide the punctuation at the end, too.
2333 (skip-chars-backward " \t,")
2334 (put-text-property (point) header-end 'invisible t)))))
2335
2336 ;; Fontify `...' and "..."
2337 (goto-char (point-min))
2338 (when Info-fontify-quotations-flag (info-fontify-quotations))
2339
2340 ;; Fontify reference items: `-- Function:', `-- Variable:', etc.
2341 (goto-char (point-min))
2342 (when Info-fontify-reference-items-flag (info-fontify-reference-items))
2343
2344 ;; Fontify titles
2345 (goto-char (point-min))
2346 (when (and font-lock-mode not-fontified-p)
2347 (while (and (re-search-forward "\n\\([^ \t\n].+\\)\n\\(\\*\\*+\\|==+\\|--+\\|\\.\\.+\\)$"
2348 nil t)
2349 ;; Only consider it as an underlined title if the ASCII
2350 ;; underline has the same size as the text. A typical
2351 ;; counter example is when a continuation "..." is alone
2352 ;; on a line.
2353 (= (string-width (match-string 1))
2354 (string-width (match-string 2))))
2355 (let* ((c (preceding-char))
2356 (face (cond ((= c ?*) 'Info-title-1-face)
2357 ((= c ?=) 'Info-title-2-face)
2358 ((= c ?-) 'Info-title-3-face)
2359 (t 'Info-title-4-face))))
2360 (put-text-property (match-beginning 1) (match-end 1) 'font-lock-face face))
2361 ;; This is a serious problem for trying to handle multiple
2362 ;; frame types at once. We want this text to be invisible
2363 ;; on frames that can display the font above.
2364 (when (memq (framep (selected-frame)) '(x pc w32 mac))
2365 (add-text-properties (1- (match-beginning 2)) (match-end 2)
2366 '(invisible t front-sticky nil rear-nonsticky t)))))
2367
2368 ;; Fontify cross references
2369 (goto-char (point-min))
2370 (when (or not-fontified-p fontify-visited-p)
2371 (while (re-search-forward
2372 "\\(\\*Note[ \n\t]+\\)\\([^:]*\\)\\(:[ \t]*\\([^.,:(]*\\)\\(\\(([^)]\
2373 *)\\)[^.,:]*\\)?[,:]?\n?\\)"
2374 nil t)
2375 (let ((start (match-beginning 0))
2376 (next (point))
2377 other-tag)
2378 (when not-fontified-p
2379 (when (or Info-hide-note-references (<= (line-number-at-pos) 4))
2380 (when (and (not (eq Info-hide-note-references 'hide))
2381 (> (line-number-at-pos) 4)) ; Skip breadcrumbs
2382 ;; *Note is often used where *note should have been
2383 (goto-char start)
2384 (skip-syntax-backward " ")
2385 (when (memq (char-before) '(?\( ?\[ ?\{))
2386 ;; Check whether the paren is preceded by
2387 ;; an end of sentence
2388 (skip-syntax-backward " ("))
2389 (setq other-tag (cond ((save-match-data (looking-back "\\<see"))
2390 "")
2391 ((save-match-data (looking-back "\\<in"))
2392 "")
2393 ((memq (char-before) '(nil ?\. ?! ??))
2394 "See ")
2395 ((save-match-data
2396 (save-excursion (search-forward "\n\n" start t)))
2397 "See ")
2398 (t "see "))))
2399 (goto-char next)
2400 (add-text-properties
2401 (match-beginning 1)
2402 (or (save-match-data
2403 ;; Don't hide \n after *Note
2404 (let ((start1 (match-beginning 1)))
2405 (and (string-match "\n" (match-string 1))
2406 (+ start1 (match-beginning 0)))))
2407 (match-end 1))
2408 (if other-tag
2409 `(display ,other-tag front-sticky nil rear-nonsticky t)
2410 '(invisible t front-sticky nil rear-nonsticky t))))
2411 (add-text-properties
2412 (match-beginning 2) (match-end 2)
2413 (list
2414 'help-echo (if (or (match-end 5)
2415 (not (equal (match-string 4) "")))
2416 (concat "mouse-2: go to " (or (match-string 5)
2417 (match-string 4)))
2418 "mouse-2: go to this node")
2419 'mouse-face 'highlight)))
2420 (when (or not-fontified-p fontify-visited-p)
2421 (setq rbeg (match-beginning 2)
2422 rend (match-end 2))
2423 (put-text-property
2424 rbeg rend
2425 'font-lock-face
2426 ;; Display visited nodes in a different face
2427 (if (and Info-fontify-visited-nodes
2428 (save-match-data
2429 (let* ((node
2430 (replace-regexp-in-string
2431 "^[ \t]+" ""
2432 (replace-regexp-in-string
2433 "[ \t\n]+" " "
2434 (or (match-string-no-properties 5)
2435 (and (not (equal (match-string 4) ""))
2436 (match-string-no-properties 4))
2437 (match-string-no-properties 2)))))
2438 (external-link-p (string-match "(\\([^)]+\\))\\([^)]*\\)" node))
2439 (file (if external-link-p
2440 (file-name-nondirectory
2441 (match-string-no-properties 1 node))
2442 Info-current-file))
2443 (hl Info-history-list)
2444 res)
2445 (when external-link-p
2446 (setq node (if (equal (match-string 2 node) "")
2447 "Top"
2448 (match-string-no-properties 2 node))))
2449 (while hl
2450 (if (and (string-equal node (nth 1 (car hl)))
2451 (equal file
2452 (if (and external-link-p (stringp (caar hl)))
2453 (file-name-nondirectory (caar hl))
2454 (caar hl))))
2455 (setq res (car hl)
2456 hl nil)
2457 (setq hl (cdr hl))))
2458 res))) 'info-xref-visited 'info-xref))
2459 ;; For multiline ref, unfontify newline and surrounding whitespace
2460 (save-excursion
2461 (goto-char rbeg)
2462 (save-match-data
2463 (while (re-search-forward "\\s-*\n\\s-*" rend t nil)
2464 (remove-text-properties (match-beginning 0)
2465 (match-end 0)
2466 '(font-lock-face t))))))
2467 (when not-fontified-p
2468 (when (or (memq Info-hide-note-references '(t hide))
2469 (<= (line-number-at-pos) 4))
2470 (add-text-properties (match-beginning 3) (match-end 3)
2471 '(invisible t front-sticky nil rear-nonsticky t))
2472 ;; Unhide the file name of the external reference in parens
2473 (if (and (match-string 6)
2474 (not (eq Info-hide-note-references 'hide))
2475 (> (line-number-at-pos) 4))
2476 (remove-text-properties
2477 (match-beginning 6) (match-end 6)
2478 '(invisible t front-sticky nil rear-nonsticky t)))
2479 ;; Unhide newline because hidden newlines cause too long lines
2480 (save-match-data
2481 (let ((beg3 (match-beginning 3))
2482 (end3 (match-end 3)))
2483 (if (and (string-match "\n[ \t]*" (match-string 3))
2484 (not (save-match-data (save-excursion (goto-char (1+ end3))
2485 (looking-at "[.)]*$")))))
2486 (remove-text-properties
2487 (+ beg3 (match-beginning 0))
2488 (+ beg3 (match-end 0))
2489 '(invisible t front-sticky nil rear-nonsticky t))))))
2490 (when (and Info-refill-paragraphs
2491 (or Info-hide-note-references
2492 (<= (line-number-at-pos) 4)))
2493 (push (set-marker (make-marker) start) paragraph-markers))))))
2494
2495 ;; Refill paragraphs (experimental feature)
2496 (when (and not-fontified-p
2497 Info-refill-paragraphs
2498 paragraph-markers)
2499 (let ((fill-nobreak-invisible t)
2500 (fill-individual-varying-indent nil)
2501 (paragraph-start "\f\\|[ \t]*[-*]\\|[ \t]*$")
2502 (paragraph-separate ".*\\.[ \t]*\n[ \t]\\|[ \t]*[-*]\\|[ \t\f]*$")
2503 (adaptive-fill-mode nil))
2504 (goto-char (point-max))
2505 (dolist (m paragraph-markers)
2506 (when (< m (point))
2507 (goto-char m)
2508 (beginning-of-line)
2509 (let ((beg (point)))
2510 (when (zerop (forward-paragraph))
2511 (fill-individual-paragraphs beg (point) nil nil)
2512 (goto-char beg))))
2513 (set-marker m nil))))
2514
2515 ;; Fontify menu items
2516 (goto-char (point-min))
2517 (when (and (or not-fontified-p fontify-visited-p)
2518 (search-forward "\n* Menu:" nil t)
2519 ;; Don't take time to annotate huge menus
2520 Info-fontify-maximum-menu-size
2521 (< (- (point-max) (point)) Info-fontify-maximum-menu-size))
2522 (let ((n 0)
2523 cont)
2524 (while (re-search-forward
2525 (concat "^\\* Menu:\\|\\(?:^\\* +\\(" Info-menu-entry-name-re "\\)\\(:"
2526 Info-node-spec-re "\\([ \t]*\\)\\)\\)")
2527 nil t)
2528 (when (match-beginning 1)
2529 (when not-fontified-p
2530 (setq n (1+ n))
2531 (if (and (<= n 9) (zerop (% n 3))) ; visual aids to help with 1-9 keys
2532 (put-text-property (match-beginning 0)
2533 (1+ (match-beginning 0))
2534 'font-lock-face 'info-menu-5)))
2535 (when not-fontified-p
2536 (add-text-properties
2537 (match-beginning 1) (match-end 1)
2538 (list
2539 'help-echo (if (and (match-end 3)
2540 (not (equal (match-string 3) "")))
2541 (concat "mouse-2: go to " (match-string 3))
2542 "mouse-2: go to this node")
2543 'mouse-face 'highlight)))
2544 (when (or not-fontified-p fontify-visited-p)
2545 (put-text-property
2546 (match-beginning 1) (match-end 1)
2547 'font-lock-face
2548 ;; Display visited menu items in a different face
2549 (if (and Info-fontify-visited-nodes
2550 (save-match-data
2551 (let* ((node (if (equal (match-string 3) "")
2552 (match-string-no-properties 1)
2553 (match-string-no-properties 3)))
2554 (external-link-p (string-match "(\\([^)]+\\))\\([^)]*\\)" node))
2555 (file (if external-link-p
2556 (file-name-nondirectory
2557 (match-string-no-properties 1 node))
2558 Info-current-file))
2559 (hl Info-history-list)
2560 res)
2561 (when external-link-p
2562 (setq node (if (equal (match-string 2 node) "")
2563 "Top"
2564 (match-string-no-properties 2 node))))
2565 (while hl
2566 (if (and (string-equal node (nth 1 (car hl)))
2567 (equal file (if (and external-link-p (stringp (caar hl)))
2568 (file-name-nondirectory (caar hl))
2569 (caar hl))))
2570 (setq res (car hl)
2571 hl nil)
2572 (setq hl (cdr hl))))
2573 res))) 'info-xref-visited 'info-xref)))
2574 (when (and not-fontified-p
2575 (or (memq Info-hide-note-references '(t hide))
2576 (<= (line-number-at-pos) 4))
2577 (not (Info-index-node)))
2578 (put-text-property (match-beginning 2) (1- (match-end 6))
2579 'invisible t)
2580 ;; Unhide the file name in parens
2581 (if (and (match-end 4) (not (eq (char-after (match-end 4)) ?.)))
2582 (remove-text-properties (match-beginning 4) (match-end 4)
2583 '(invisible t)))
2584 ;; We need a stretchable space like :align-to but with
2585 ;; a minimum value.
2586 (put-text-property (1- (match-end 6)) (match-end 6) 'display
2587 (if (>= 22 (- (match-end 1)
2588 (match-beginning 0)))
2589 '(space :align-to 24)
2590 '(space :width 2)))
2591 (setq cont (looking-at "."))
2592 (while (and (= (forward-line 1) 0)
2593 (looking-at "\\([ \t]+\\)[^*\n]"))
2594 (put-text-property (match-beginning 1) (1- (match-end 1))
2595 'invisible t)
2596 (put-text-property (1- (match-end 1)) (match-end 1)
2597 'display
2598 (if cont
2599 '(space :align-to 26)
2600 '(space :align-to 24)))
2601 (setq cont t)))))))
2602
2603 ;; Fontify menu headers
2604 ;; Add the face `info-menu-header' to any header before a menu entry
2605 (goto-char (point-min))
2606 (when (and not-fontified-p (re-search-forward "^\\* Menu:" nil t))
2607 (put-text-property (match-beginning 0) (match-end 0)
2608 'font-lock-face 'info-menu-header)
2609 (while (re-search-forward "\n\n\\([^*\n ].*\\)\n\n?[*]" nil t)
2610 (put-text-property (match-beginning 1) (match-end 1)
2611 'font-lock-face 'info-menu-header)))
2612
2613 ;; Hide index line numbers
2614 (goto-char (point-min))
2615 (when (and not-fontified-p (Info-index-node))
2616 (while (re-search-forward "[ \t\n]*(line +[0-9]+)" nil t)
2617 (put-text-property (match-beginning 0) (match-end 0)
2618 'invisible t)))
2619
2620 ;; Fontify http and ftp references
2621 (goto-char (point-min))
2622 (when not-fontified-p
2623 (while (re-search-forward "\\(https?\\|ftp\\)://[^ \t\n\"`({<>})']+" nil t)
2624 (add-text-properties (match-beginning 0) (match-end 0)
2625 '(font-lock-face info-xref
2626 mouse-face highlight
2627 help-echo "mouse-2: go to this URL"))))
2628
2629 (set-buffer-modified-p nil)))))
2630
2631
2632 ;; REPLACES ORIGINAL in `info.el':
2633 ;; 1. File name in face `info-file'.
2634 ;; 2. If `Info-fontify-quotations-flag', fontify `...' in face `info-quoted-name',
2635 ;; "..." in face `info-string', and ' in face `info-single-quote'.
2636 ;;
2637 (when (and (> emacs-major-version 22) (not (fboundp 'Info-breadcrumbs))) ; Emacs 23.1, not 23.2+
2638 (defun Info-fontify-node ()
2639 "Fontify the node."
2640 (save-excursion
2641 (let* ((inhibit-read-only t)
2642 (case-fold-search t)
2643 paragraph-markers
2644 (not-fontified-p ; the node hasn't already been fontified
2645 (not (let ((where (next-single-property-change (point-min) 'font-lock-face)))
2646 (and where (not (= where (point-max)))))))
2647 (fontify-visited-p ; visited nodes need to be re-fontified
2648 (and Info-fontify-visited-nodes
2649 ;; Don't take time to refontify visited nodes in huge nodes
2650 Info-fontify-maximum-menu-size
2651 (< (- (point-max) (point-min)) Info-fontify-maximum-menu-size)))
2652 rbeg rend)
2653
2654 ;; Fontify header line
2655 (goto-char (point-min))
2656 (when (and not-fontified-p (looking-at "^File: \\([^,: \t]+\\),?[ \t]+"))
2657 (put-text-property (match-beginning 1) (match-end 1) 'font-lock-face 'info-file))
2658 (goto-char (point-min))
2659 (when (and not-fontified-p (looking-at "^\\(File: [^,: \t]+,?[ \t]+\\)?"))
2660 (while (looking-at "[ \t]*\\([^:, \t\n]+\\):[ \t]+\\([^:,\t\n]+\\),?")
2661 (goto-char (match-end 0))
2662 (let* ((nbeg (match-beginning 2))
2663 (nend (match-end 2))
2664 (tbeg (match-beginning 1))
2665 (tag (match-string 1)))
2666 (if (string-equal (downcase tag) "node")
2667 (put-text-property nbeg nend 'font-lock-face 'info-header-node)
2668 (put-text-property nbeg nend 'font-lock-face 'info-header-xref)
2669 (put-text-property tbeg nend 'mouse-face 'highlight)
2670 (put-text-property tbeg nend
2671 'help-echo
2672 (concat "mouse-2: Go to node "
2673 (buffer-substring nbeg nend)))
2674 ;; Always set up the text property keymap.
2675 ;; It will either be used in the buffer
2676 ;; or copied in the header line.
2677 (put-text-property tbeg nend 'keymap
2678 (cond
2679 ((string-equal (downcase tag) "prev") Info-prev-link-keymap)
2680 ((string-equal (downcase tag) "next") Info-next-link-keymap)
2681 ((string-equal (downcase tag) "up" ) Info-up-link-keymap))))))
2682 (when (and Info-breadcrumbs-in-header-flag (> Info-breadcrumbs-depth 0))
2683 (Info-insert-breadcrumbs))
2684
2685 ;; Treat header line.
2686 (when Info-use-header-line
2687 (goto-char (point-min))
2688 (let* ((header-end (line-end-position))
2689 (header
2690 ;; If we find neither Next: nor Prev: link, show the entire
2691 ;; node header. Otherwise, don't show the File: and Node:
2692 ;; parts, to avoid wasting precious space on information that
2693 ;; is available in the mode line.
2694 (if (re-search-forward "\\(next\\|up\\|prev[ious]*\\): " header-end t)
2695 (progn (goto-char (match-beginning 1))
2696 (buffer-substring (point) header-end))
2697 (if (re-search-forward "node:[ \t]*[^ \t]+[ \t]*" header-end t)
2698 (concat "No next, prev or up links -- "
2699 (buffer-substring (point) header-end))
2700 (buffer-substring (point) header-end)))))
2701 (put-text-property (point-min) (1+ (point-min))
2702 'header-line (replace-regexp-in-string
2703 "%"
2704 ;; Preserve text properties on duplicated `%'.
2705 (lambda (s) (concat s s)) header))
2706 ;; Hide the part of the first line that is in the header, if it is just part.
2707 (cond ((and Info-breadcrumbs-in-header-flag (> Info-breadcrumbs-depth 0))
2708 (put-text-property (point-min) (1+ header-end) 'invisible t))
2709 ((not (bobp))
2710 ;; Hide the punctuation at the end, too.
2711 (skip-chars-backward " \t,")
2712 (put-text-property (point) header-end 'invisible t))))))
2713
2714 ;; Fontify `...' and "..."
2715 (goto-char (point-min))
2716 (when Info-fontify-quotations-flag (info-fontify-quotations))
2717
2718 ;; Fontify reference items: `-- Function:', `-- Variable:', etc.
2719 (goto-char (point-min))
2720 (when Info-fontify-reference-items-flag (info-fontify-reference-items))
2721
2722 ;; Fontify titles
2723 (goto-char (point-min))
2724 (when (and font-lock-mode not-fontified-p)
2725 (while (and (re-search-forward "\n\\([^ \t\n].+\\)\n\\(\\*\\*+\\|==+\\|--+\\|\\.\\.+\\)$"
2726 nil t)
2727 ;; Only consider it as an underlined title if the ASCII
2728 ;; underline has the same size as the text. A typical
2729 ;; counter example is when a continuation "..." is alone
2730 ;; on a line.
2731 (= (string-width (match-string 1))
2732 (string-width (match-string 2))))
2733 (let* ((c (preceding-char))
2734 (face (cond ((= c ?*) 'Info-title-1-face)
2735 ((= c ?=) 'Info-title-2-face)
2736 ((= c ?-) 'Info-title-3-face)
2737 (t 'Info-title-4-face))))
2738 (put-text-property (match-beginning 1) (match-end 1)
2739 'font-lock-face face))
2740 ;; This is a serious problem for trying to handle multiple
2741 ;; frame types at once. We want this text to be invisible
2742 ;; on frames that can display the font above.
2743 (when (memq (framep (selected-frame)) '(x pc w32 ns))
2744 (add-text-properties (1- (match-beginning 2)) (match-end 2)
2745 '(invisible t front-sticky nil rear-nonsticky t)))))
2746
2747 ;; Fontify cross references
2748 (goto-char (point-min))
2749 (when (or not-fontified-p fontify-visited-p)
2750 (while (re-search-forward
2751 "\\(\\*Note[ \n\t]+\\)\\([^:]*\\)\\(:[ \t]*\\([^.,:(]*\\)\\(\\(([^)]\
2752 *)\\)[^.,:]*\\)?[,:]?\n?\\)"
2753 nil t)
2754 (let ((start (match-beginning 0))
2755 (next (point))
2756 other-tag)
2757 (when not-fontified-p
2758 (when Info-hide-note-references
2759 (when (and (not (eq Info-hide-note-references 'hide))
2760 (> (line-number-at-pos) 4)) ; Skip breadcrumbs
2761 ;; *Note is often used where *note should have been
2762 (goto-char start)
2763 (skip-syntax-backward " ")
2764 (when (memq (char-before) '(?\( ?\[ ?\{))
2765 ;; Check whether the paren is preceded by
2766 ;; an end of sentence
2767 (skip-syntax-backward " ("))
2768 (setq other-tag (cond ((save-match-data (looking-back "\\<see"))
2769 "")
2770 ((save-match-data (looking-back "\\<in"))
2771 "")
2772 ((memq (char-before) '(nil ?\. ?! ??))
2773 "See ")
2774 ((save-match-data
2775 (save-excursion (search-forward "\n\n" start t)))
2776 "See ")
2777 (t "see "))))
2778 (goto-char next)
2779 (add-text-properties
2780 (match-beginning 1)
2781 (or (save-match-data
2782 ;; Don't hide \n after *Note
2783 (let ((start1 (match-beginning 1)))
2784 (and (string-match "\n" (match-string 1))
2785 (+ start1 (match-beginning 0)))))
2786 (match-end 1))
2787 (if other-tag
2788 `(display ,other-tag front-sticky nil rear-nonsticky t)
2789 '(invisible t front-sticky nil rear-nonsticky t))))
2790 (add-text-properties
2791 (match-beginning 2) (match-end 2)
2792 (list
2793 'help-echo (if (or (match-end 5)
2794 (not (equal (match-string 4) "")))
2795 (concat "mouse-2: go to " (or (match-string 5)
2796 (match-string 4)))
2797 "mouse-2: go to this node")
2798 'mouse-face 'highlight)))
2799 (when (or not-fontified-p fontify-visited-p)
2800 (setq rbeg (match-beginning 2)
2801 rend (match-end 2))
2802 (put-text-property
2803 rbeg rend
2804 'font-lock-face
2805 ;; Display visited nodes in a different face
2806 (if (and Info-fontify-visited-nodes
2807 (save-match-data
2808 (let* ((node
2809 (replace-regexp-in-string
2810 "^[ \t]+" ""
2811 (replace-regexp-in-string
2812 "[ \t\n]+" " "
2813 (or (match-string-no-properties 5)
2814 (and (not (equal (match-string 4) ""))
2815 (match-string-no-properties 4))
2816 (match-string-no-properties 2)))))
2817 (external-link-p (string-match "(\\([^)]+\\))\\([^)]*\\)" node))
2818 (file (if external-link-p
2819 (file-name-nondirectory
2820 (match-string-no-properties 1 node))
2821 Info-current-file))
2822 (hl Info-history-list)
2823 res)
2824 (when external-link-p
2825 (setq node (if (equal (match-string 2 node) "")
2826 "Top"
2827 (match-string-no-properties 2 node))))
2828 (while hl
2829 (if (and (string-equal node (nth 1 (car hl)))
2830 (equal file (if (and external-link-p (stringp (caar hl)))
2831 (file-name-nondirectory (caar hl))
2832 (caar hl))))
2833 (setq res (car hl)
2834 hl nil)
2835 (setq hl (cdr hl))))
2836 res))) 'info-xref-visited 'info-xref))
2837 ;; For multiline ref, unfontify newline and surrounding whitespace
2838 (save-excursion
2839 (goto-char rbeg)
2840 (save-match-data
2841 (while (re-search-forward "\\s-*\n\\s-*" rend t nil)
2842 (remove-text-properties (match-beginning 0) (match-end 0)
2843 '(font-lock-face t))))))
2844 (when not-fontified-p
2845 (when (memq Info-hide-note-references '(t hide))
2846 (add-text-properties (match-beginning 3) (match-end 3)
2847 '(invisible t front-sticky nil rear-nonsticky t))
2848 ;; Unhide the file name of the external reference in parens
2849 (if (and (match-string 6)
2850 (not (eq Info-hide-note-references 'hide)))
2851 (remove-text-properties
2852 (match-beginning 6) (match-end 6)
2853 '(invisible t front-sticky nil rear-nonsticky t)))
2854 ;; Unhide newline because hidden newlines cause too long lines
2855 (save-match-data
2856 (let ((beg3 (match-beginning 3))
2857 (end3 (match-end 3)))
2858 (if (and (string-match "\n[ \t]*" (match-string 3))
2859 (not (save-match-data (save-excursion (goto-char (1+ end3))
2860 (looking-at "[.)]*$")))))
2861 (remove-text-properties
2862 (+ beg3 (match-beginning 0))
2863 (+ beg3 (match-end 0))
2864 '(invisible t front-sticky nil rear-nonsticky t))))))
2865 (when (and Info-refill-paragraphs Info-hide-note-references)
2866 (push (set-marker (make-marker) start) paragraph-markers))))))
2867
2868 ;; Refill paragraphs (experimental feature)
2869 (when (and not-fontified-p Info-refill-paragraphs paragraph-markers)
2870 (let ((fill-nobreak-invisible t)
2871 (fill-individual-varying-indent nil)
2872 (paragraph-start "\f\\|[ \t]*[-*]\\|[ \t]*$")
2873 (paragraph-separate ".*\\.[ \t]*\n[ \t]\\|[ \t]*[-*]\\|[ \t\f]*$")
2874 (adaptive-fill-mode nil))
2875 (goto-char (point-max))
2876 (dolist (m paragraph-markers)
2877 (when (< m (point))
2878 (goto-char m)
2879 (beginning-of-line)
2880 (let ((beg (point)))
2881 (when (zerop (forward-paragraph))
2882 (fill-individual-paragraphs beg (point) nil nil)
2883 (goto-char beg))))
2884 (set-marker m nil))))
2885
2886 ;; Fontify menu items
2887 (goto-char (point-min))
2888 (when (and (or not-fontified-p fontify-visited-p)
2889 (search-forward "\n* Menu:" nil t)
2890 ;; Don't take time to annotate huge menus
2891 Info-fontify-maximum-menu-size
2892 (< (- (point-max) (point)) Info-fontify-maximum-menu-size))
2893 (let ((n 0)
2894 cont)
2895 (while (re-search-forward
2896 (concat "^\\* Menu:\\|\\(?:^\\* +\\(" Info-menu-entry-name-re "\\)\\(:"
2897 Info-node-spec-re "\\([ \t]*\\)\\)\\)")
2898 nil t)
2899 (when (match-beginning 1)
2900 (when not-fontified-p
2901 (setq n (1+ n))
2902 (if (and (<= n 9) (zerop (% n 3))) ; visual aids to help with 1-9 keys
2903 (put-text-property (match-beginning 0) (1+ (match-beginning 0))
2904 'font-lock-face 'info-menu-5)))
2905 (when not-fontified-p
2906 (add-text-properties
2907 (match-beginning 1) (match-end 1)
2908 (list 'help-echo (if (and (match-end 3)
2909 (not (equal (match-string 3) "")))
2910 (concat "mouse-2: go to " (match-string 3))
2911 "mouse-2: go to this node")
2912 'mouse-face 'highlight)))
2913 (when (or not-fontified-p fontify-visited-p)
2914 (put-text-property
2915 (match-beginning 1) (match-end 1)
2916 'font-lock-face
2917 ;; Display visited menu items in a different face
2918 (if (and Info-fontify-visited-nodes
2919 (save-match-data
2920 (let* ((node (if (equal (match-string 3) "")
2921 (match-string-no-properties 1)
2922 (match-string-no-properties 3)))
2923 (external-link-p (string-match "(\\([^)]+\\))\\([^)]*\\)" node))
2924 (file (if external-link-p
2925 (file-name-nondirectory
2926 (match-string-no-properties 1 node))
2927 Info-current-file))
2928 (hl Info-history-list)
2929 res)
2930 (when external-link-p
2931 (setq node (if (equal (match-string 2 node) "")
2932 "Top"
2933 (match-string-no-properties 2 node))))
2934 (while hl
2935 (if (and (string-equal node (nth 1 (car hl)))
2936 (equal file (if (and external-link-p (stringp (caar hl)))
2937 (file-name-nondirectory (caar hl))
2938 (caar hl))))
2939 (setq res (car hl)
2940 hl nil)
2941 (setq hl (cdr hl))))
2942 res))) 'info-xref-visited 'info-xref)))
2943 (when (and not-fontified-p
2944 (memq Info-hide-note-references '(t hide))
2945 (not (Info-index-node)))
2946 (put-text-property (match-beginning 2) (1- (match-end 6)) 'invisible t)
2947 ;; Unhide the file name in parens
2948 (if (and (match-end 4) (not (eq (char-after (match-end 4)) ?.)))
2949 (remove-text-properties (match-beginning 4) (match-end 4)
2950 '(invisible t)))
2951 ;; We need a stretchable space like :align-to but with
2952 ;; a minimum value.
2953 (put-text-property (1- (match-end 6)) (match-end 6) 'display
2954 (if (>= 22 (- (match-end 1)
2955 (match-beginning 0)))
2956 '(space :align-to 24)
2957 '(space :width 2)))
2958 (setq cont (looking-at "."))
2959 (while (and (= (forward-line 1) 0)
2960 (looking-at "\\([ \t]+\\)[^*\n]"))
2961 (put-text-property (match-beginning 1) (1- (match-end 1))
2962 'invisible t)
2963 (put-text-property (1- (match-end 1)) (match-end 1)
2964 'display
2965 (if cont
2966 '(space :align-to 26)
2967 '(space :align-to 24)))
2968 (setq cont t)))))))
2969
2970 ;; Fontify menu headers
2971 ;; Add the face `info-menu-header' to any header before a menu entry
2972 (goto-char (point-min))
2973 (when (and not-fontified-p (re-search-forward "^\\* Menu:" nil t))
2974 (put-text-property (match-beginning 0) (match-end 0)
2975 'font-lock-face 'info-menu-header)
2976 (while (re-search-forward "\n\n\\([^*\n ].*\\)\n\n?[*]" nil t)
2977 (put-text-property (match-beginning 1) (match-end 1)
2978 'font-lock-face 'info-menu-header)))
2979
2980 ;; Hide index line numbers
2981 (goto-char (point-min))
2982 (when (and not-fontified-p (Info-index-node))
2983 (while (re-search-forward "[ \t\n]*(line +[0-9]+)" nil t)
2984 (put-text-property (match-beginning 0) (match-end 0)
2985 'invisible t)))
2986
2987 ;; Fontify http and ftp references
2988 (goto-char (point-min))
2989 (when not-fontified-p
2990 (while (re-search-forward "\\(https?\\|ftp\\)://[^ \t\n\"`({<>})']+" nil t)
2991 (add-text-properties (match-beginning 0) (match-end 0)
2992 '(font-lock-face info-xref
2993 mouse-face highlight
2994 help-echo "mouse-2: go to this URL"))))
2995
2996 (set-buffer-modified-p nil)))))
2997
2998
2999 ;; REPLACES ORIGINAL in `info.el':
3000 ;; 1. File name in face `info-file'.
3001 ;; 2. If `Info-fontify-quotations-flag', fontify `...' in face `info-quoted-name',
3002 ;; "..." in face `info-string', and ' in face `info-single-quote'.
3003 ;;
3004 (when (and (> emacs-major-version 22) (fboundp 'Info-breadcrumbs)) ; Emacs 23.2+
3005 (defun Info-fontify-node ()
3006 "Fontify the node."
3007 (save-excursion
3008 (let* ((inhibit-read-only t)
3009 (case-fold-search t)
3010 paragraph-markers
3011 (not-fontified-p ; the node hasn't already been fontified
3012 (not (let ((where (next-single-property-change (point-min) 'font-lock-face)))
3013 (and where (not (= where (point-max)))))))
3014 (fontify-visited-p ; visited nodes need to be re-fontified
3015 (and Info-fontify-visited-nodes
3016 ;; Don't take time to refontify visited nodes in huge nodes
3017 Info-fontify-maximum-menu-size
3018 (< (- (point-max) (point-min)) Info-fontify-maximum-menu-size)))
3019 rbeg rend)
3020
3021 ;; Fontify header line
3022 (goto-char (point-min))
3023 (when (and not-fontified-p (looking-at "^File: \\([^,: \t]+\\),?[ \t]+"))
3024 (put-text-property (match-beginning 1) (match-end 1) 'font-lock-face 'info-file))
3025 (goto-char (point-min))
3026 (when (and not-fontified-p (looking-at "^\\(File: [^,: \t]+,?[ \t]+\\)?"))
3027 (while (looking-at "[ \t]*\\([^:, \t\n]+\\):[ \t]+\\([^:,\t\n]+\\),?")
3028 (goto-char (match-end 0))
3029 (let* ((nbeg (match-beginning 2))
3030 (nend (match-end 2))
3031 (tbeg (match-beginning 1))
3032 (tag (match-string 1)))
3033 (if (string-equal (downcase tag) "node")
3034 (put-text-property nbeg nend 'font-lock-face 'info-header-node)
3035 (put-text-property nbeg nend 'font-lock-face 'info-header-xref)
3036 (put-text-property tbeg nend 'mouse-face 'highlight)
3037 (put-text-property tbeg nend
3038 'help-echo
3039 (concat "mouse-2: Go to node "
3040 (buffer-substring nbeg nend)))
3041 ;; Always set up the text property keymap.
3042 ;; It will either be used in the buffer
3043 ;; or copied in the header line.
3044 (put-text-property tbeg nend 'keymap
3045 (cond
3046 ((string-equal (downcase tag) "prev") Info-prev-link-keymap)
3047 ((string-equal (downcase tag) "next") Info-next-link-keymap)
3048 ((string-equal (downcase tag) "up" ) Info-up-link-keymap))))))
3049
3050 ;; Treat header line.
3051 (when Info-use-header-line
3052 (goto-char (point-min))
3053 (let* ((header-end (line-end-position))
3054 (header
3055 ;; If we find neither Next: nor Prev: link, show the entire
3056 ;; node header. Otherwise, don't show the File: and Node:
3057 ;; parts, to avoid wasting precious space on information that
3058 ;; is available in the mode line.
3059 (if (re-search-forward "\\(next\\|up\\|prev[ious]*\\): " header-end t)
3060 (progn (goto-char (match-beginning 1))
3061 (buffer-substring (point) header-end))
3062 (if (re-search-forward "node:[ \t]*[^ \t]+[ \t]*" header-end t)
3063 (concat "No next, prev or up links -- "
3064 (buffer-substring (point) header-end))
3065 (buffer-substring (point) header-end)))))
3066 (put-text-property (point-min) (1+ (point-min))
3067 'header-line (replace-regexp-in-string
3068 "%"
3069 ;; Preserve text properties on duplicated `%'.
3070 (lambda (s) (concat s s)) header))
3071 ;; Hide the part of the first line that is in the header, if it is just part.
3072 (cond ((and Info-breadcrumbs-in-header-flag (> Info-breadcrumbs-depth 0))
3073 (let ((ov (make-overlay (point-min) (1+ header-end))))
3074 (overlay-put ov 'display (Info-breadcrumbs))
3075 (overlay-put ov 'evaporate t)))
3076 ((not (bobp))
3077 ;; Hide the punctuation at the end, too.
3078 (skip-chars-backward " \t,")
3079 (put-text-property (point) header-end 'invisible t))))))
3080
3081 ;; Fontify `...' and "..."
3082 (goto-char (point-min))
3083 (when Info-fontify-quotations-flag (info-fontify-quotations))
3084
3085 ;; Fontify reference items: `-- Function:', `-- Variable:', etc.
3086 (goto-char (point-min))
3087 (when Info-fontify-reference-items-flag (info-fontify-reference-items))
3088
3089 ;; Fontify titles
3090 (goto-char (point-min))
3091 (when (and font-lock-mode not-fontified-p)
3092 (while (and (re-search-forward "\n\\([^ \t\n].+\\)\n\\(\\*\\*+\\|==+\\|--+\\|\\.\\.+\\)$"
3093 nil t)
3094 ;; Only consider it as an underlined title if the ASCII
3095 ;; underline has the same size as the text. A typical
3096 ;; counter example is when a continuation "..." is alone
3097 ;; on a line.
3098 (= (string-width (match-string 1))
3099 (string-width (match-string 2))))
3100 (let* ((c (preceding-char))
3101 (face (cond ((= c ?*) 'Info-title-1-face)
3102 ((= c ?=) 'Info-title-2-face)
3103 ((= c ?-) 'Info-title-3-face)
3104 (t 'Info-title-4-face))))
3105 (put-text-property (match-beginning 1) (match-end 1)
3106 'font-lock-face face))
3107 ;; This is a serious problem for trying to handle multiple
3108 ;; frame types at once. We want this text to be invisible
3109 ;; on frames that can display the font above.
3110 (when (memq (framep (selected-frame)) '(x pc w32 ns))
3111 (add-text-properties (1- (match-beginning 2)) (match-end 2)
3112 '(invisible t front-sticky nil rear-nonsticky t)))))
3113
3114 ;; Fontify cross references
3115 (goto-char (point-min))
3116 (when (or not-fontified-p fontify-visited-p)
3117 (while (re-search-forward
3118 "\\(\\*Note[ \n\t]+\\)\\([^:]*\\)\\(:[ \t]*\\([^.,:(]*\\)\\(\\(([^)]\
3119 *)\\)[^.,:]*\\)?[,:]?\n?\\)"
3120 nil t)
3121 (let ((start (match-beginning 0))
3122 (next (point))
3123 other-tag)
3124 (when not-fontified-p
3125 (when Info-hide-note-references
3126 (when (and (not (eq Info-hide-note-references 'hide))
3127 (> (line-number-at-pos) 4)) ; Skip breadcrumbs
3128 ;; *Note is often used where *note should have been
3129 (goto-char start)
3130 (skip-syntax-backward " ")
3131 (when (memq (char-before) '(?\( ?\[ ?\{))
3132 ;; Check whether the paren is preceded by
3133 ;; an end of sentence
3134 (skip-syntax-backward " ("))
3135 (setq other-tag (cond ((save-match-data (looking-back "\\<see"))
3136 "")
3137 ((save-match-data (looking-back "\\<in"))
3138 "")
3139 ((memq (char-before) '(nil ?\. ?! ??))
3140 "See ")
3141 ((save-match-data
3142 (save-excursion (search-forward "\n\n" start t)))
3143 "See ")
3144 (t "see "))))
3145 (goto-char next)
3146 (add-text-properties
3147 (match-beginning 1)
3148 (or (save-match-data
3149 ;; Don't hide \n after *Note
3150 (let ((start1 (match-beginning 1)))
3151 (and (string-match "\n" (match-string 1))
3152 (+ start1 (match-beginning 0)))))
3153 (match-end 1))
3154 (if other-tag
3155 `(display ,other-tag front-sticky nil rear-nonsticky t)
3156 '(invisible t front-sticky nil rear-nonsticky t))))
3157 (add-text-properties
3158 (match-beginning 2) (match-end 2)
3159 (list
3160 'help-echo (if (or (match-end 5)
3161 (not (equal (match-string 4) "")))
3162 (concat "mouse-2: go to " (or (match-string 5)
3163 (match-string 4)))
3164 "mouse-2: go to this node")
3165 'mouse-face 'highlight)))
3166 (when (or not-fontified-p fontify-visited-p)
3167 (setq rbeg (match-beginning 2)
3168 rend (match-end 2))
3169 (put-text-property
3170 rbeg rend
3171 'font-lock-face
3172 ;; Display visited nodes in a different face
3173 (if (and Info-fontify-visited-nodes
3174 (save-match-data
3175 (let* ((node
3176 (replace-regexp-in-string
3177 "^[ \t]+" ""
3178 (replace-regexp-in-string
3179 "[ \t\n]+" " "
3180 (or (match-string-no-properties 5)
3181 (and (not (equal (match-string 4) ""))
3182 (match-string-no-properties 4))
3183 (match-string-no-properties 2)))))
3184 (external-link-p (string-match "(\\([^)]+\\))\\([^)]*\\)" node))
3185 (file (if external-link-p
3186 (file-name-nondirectory
3187 (match-string-no-properties 1 node))
3188 Info-current-file))
3189 (hl Info-history-list)
3190 res)
3191 (when external-link-p
3192 (setq node (if (equal (match-string 2 node) "")
3193 "Top"
3194 (match-string-no-properties 2 node))))
3195 (while hl
3196 (if (and (string-equal node (nth 1 (car hl)))
3197 (equal file (if (and external-link-p (stringp (caar hl)))
3198 (file-name-nondirectory (caar hl))
3199 (caar hl))))
3200 (setq res (car hl)
3201 hl nil)
3202 (setq hl (cdr hl))))
3203 res))) 'info-xref-visited 'info-xref))
3204 ;; For multiline ref, unfontify newline and surrounding whitespace
3205 (save-excursion
3206 (goto-char rbeg)
3207 (save-match-data
3208 (while (re-search-forward "\\s-*\n\\s-*" rend t nil)
3209 (remove-text-properties (match-beginning 0) (match-end 0)
3210 '(font-lock-face t))))))
3211 (when not-fontified-p
3212 (when (memq Info-hide-note-references '(t hide))
3213 (add-text-properties (match-beginning 3) (match-end 3)
3214 '(invisible t front-sticky nil rear-nonsticky t))
3215 ;; Unhide the file name of the external reference in parens
3216 (if (and (match-string 6)
3217 (not (eq Info-hide-note-references 'hide)))
3218 (remove-text-properties
3219 (match-beginning 6) (match-end 6)
3220 '(invisible t front-sticky nil rear-nonsticky t)))
3221 ;; Unhide newline because hidden newlines cause too long lines
3222 (save-match-data
3223 (let ((beg3 (match-beginning 3))
3224 (end3 (match-end 3)))
3225 (if (and (string-match "\n[ \t]*" (match-string 3))
3226 (not (save-match-data (save-excursion (goto-char (1+ end3))
3227 (looking-at "[.)]*$")))))
3228 (remove-text-properties
3229 (+ beg3 (match-beginning 0))
3230 (+ beg3 (match-end 0))
3231 '(invisible t front-sticky nil rear-nonsticky t))))))
3232 (when (and Info-refill-paragraphs Info-hide-note-references)
3233 (push (set-marker (make-marker) start) paragraph-markers))))))
3234
3235 ;; Refill paragraphs (experimental feature)
3236 (when (and not-fontified-p Info-refill-paragraphs paragraph-markers)
3237 (let ((fill-nobreak-invisible t)
3238 (fill-individual-varying-indent nil)
3239 (paragraph-start "\f\\|[ \t]*[-*]\\|[ \t]*$")
3240 (paragraph-separate ".*\\.[ \t]*\n[ \t]\\|[ \t]*[-*]\\|[ \t\f]*$")
3241 (adaptive-fill-mode nil))
3242 (goto-char (point-max))
3243 (dolist (m paragraph-markers)
3244 (when (< m (point))
3245 (goto-char m)
3246 (beginning-of-line)
3247 (let ((beg (point)))
3248 (when (zerop (forward-paragraph))
3249 (fill-individual-paragraphs beg (point) nil nil)
3250 (goto-char beg))))
3251 (set-marker m nil))))
3252
3253 ;; Fontify menu items
3254 (goto-char (point-min))
3255 (when (and (or not-fontified-p fontify-visited-p)
3256 (search-forward "\n* Menu:" nil t)
3257 ;; Don't take time to annotate huge menus
3258 Info-fontify-maximum-menu-size
3259 (< (- (point-max) (point)) Info-fontify-maximum-menu-size))
3260 (let ((n 0)
3261 cont)
3262 (while (re-search-forward
3263 (concat "^\\* Menu:\\|\\(?:^\\* +\\(" Info-menu-entry-name-re "\\)\\(:"
3264 Info-node-spec-re "\\([ \t]*\\)\\)\\)")
3265 nil t)
3266 (when (match-beginning 1)
3267 (when not-fontified-p
3268 (setq n (1+ n))
3269 (if (and (<= n 9) (zerop (% n 3))) ; visual aids to help with 1-9 keys
3270 (put-text-property (match-beginning 0) (1+ (match-beginning 0))
3271 'font-lock-face 'info-menu-5)))
3272 (when not-fontified-p
3273 (add-text-properties
3274 (match-beginning 1) (match-end 1)
3275 (list 'help-echo (if (and (match-end 3)
3276 (not (equal (match-string 3) "")))
3277 (concat "mouse-2: go to " (match-string 3))
3278 "mouse-2: go to this node")
3279 'mouse-face 'highlight)))
3280 (when (or not-fontified-p fontify-visited-p)
3281 (put-text-property
3282 (match-beginning 1) (match-end 1)
3283 'font-lock-face
3284 ;; Display visited menu items in a different face
3285 (if (and Info-fontify-visited-nodes
3286 (save-match-data
3287 (let* ((node (if (equal (match-string 3) "")
3288 (match-string-no-properties 1)
3289 (match-string-no-properties 3)))
3290 (external-link-p (string-match "(\\([^)]+\\))\\([^)]*\\)" node))
3291 (file (if external-link-p
3292 (file-name-nondirectory
3293 (match-string-no-properties 1 node))
3294 Info-current-file))
3295 (hl Info-history-list)
3296 res)
3297 (when external-link-p
3298 (setq node (if (equal (match-string 2 node) "")
3299 "Top"
3300 (match-string-no-properties 2 node))))
3301 (while hl
3302 (if (and (string-equal node (nth 1 (car hl)))
3303 (equal file (if (and external-link-p (stringp (caar hl)))
3304 (file-name-nondirectory (caar hl))
3305 (caar hl))))
3306 (setq res (car hl)
3307 hl nil)
3308 (setq hl (cdr hl))))
3309 res))) 'info-xref-visited 'info-xref)))
3310 (when (and not-fontified-p
3311 (memq Info-hide-note-references '(t hide))
3312 (not (Info-index-node)))
3313 (put-text-property (match-beginning 2) (1- (match-end 6)) 'invisible t)
3314 ;; Unhide the file name in parens
3315 (if (and (match-end 4) (not (eq (char-after (match-end 4)) ?.)))
3316 (remove-text-properties (match-beginning 4) (match-end 4)
3317 '(invisible t)))
3318 ;; We need a stretchable space like :align-to but with
3319 ;; a minimum value.
3320 (put-text-property (1- (match-end 6)) (match-end 6) 'display
3321 (if (>= 22 (- (match-end 1)
3322 (match-beginning 0)))
3323 '(space :align-to 24)
3324 '(space :width 2)))
3325 (setq cont (looking-at "."))
3326 (while (and (= (forward-line 1) 0)
3327 (looking-at "\\([ \t]+\\)[^*\n]"))
3328 (put-text-property (match-beginning 1) (1- (match-end 1))
3329 'invisible t)
3330 (put-text-property (1- (match-end 1)) (match-end 1)
3331 'display
3332 (if cont
3333 '(space :align-to 26)
3334 '(space :align-to 24)))
3335 (setq cont t)))))))
3336
3337 ;; Fontify menu headers
3338 ;; Add the face `info-menu-header' to any header before a menu entry
3339 (goto-char (point-min))
3340 (when (and not-fontified-p (re-search-forward "^\\* Menu:" nil t))
3341 (put-text-property (match-beginning 0) (match-end 0)
3342 'font-lock-face 'info-menu-header)
3343 (while (re-search-forward "\n\n\\([^*\n ].*\\)\n\n?[*]" nil t)
3344 (put-text-property (match-beginning 1) (match-end 1)
3345 'font-lock-face 'info-menu-header)))
3346
3347 ;; Hide index line numbers
3348 (goto-char (point-min))
3349 (when (and not-fontified-p (Info-index-node))
3350 (while (re-search-forward "[ \t\n]*(line +[0-9]+)" nil t)
3351 (put-text-property (match-beginning 0) (match-end 0)
3352 'invisible t)))
3353
3354 ;; Fontify http and ftp references
3355 (goto-char (point-min))
3356 (when not-fontified-p
3357 (while (re-search-forward "\\(https?\\|ftp\\)://[^ \t\n\"`({<>})']+" nil t)
3358 (add-text-properties (match-beginning 0) (match-end 0)
3359 '(font-lock-face info-xref
3360 mouse-face highlight
3361 help-echo "mouse-2: go to this URL"))))
3362
3363 (set-buffer-modified-p nil)))))
3364
3365 (when (> emacs-major-version 22)
3366 (defvar Info-breadcrumbs-depth-internal Info-breadcrumbs-depth
3367 "Current breadcrumbs depth for Info."))
3368
3369
3370 ;; 1. I made this a global minor mode and turned it on by default, contrary to "the rules".
3371 ;; I did this so (a) users could easily customize it but (b) it would be on by default, otherwise.
3372 ;;
3373 ;; 2. Macro `define-minor-mode' is not defined in Emacs 20, so in order to be able to byte-compile
3374 ;; this file in Emacs 20, prohibit byte-compiling of the `define-minor-mode' call.
3375 ;;
3376 (when (> emacs-major-version 22)
3377 (eval '(define-minor-mode Info-breadcrumbs-in-mode-line-mode
3378 "Toggle the use of breadcrumbs in Info mode line.
3379 With arg, show breadcrumbs iff arg is positive.
3380 Change the default behavior by customizing option
3381 `Info-breadcrumbs-in-mode-line-mode'."
3382 :init-value t :global t :group 'mode-line :group 'Info-Plus
3383 (if (not Info-breadcrumbs-in-mode-line-mode)
3384 (setq Info-breadcrumbs-depth-internal 0
3385 mode-line-format default-mode-line-format)
3386 (setq Info-breadcrumbs-depth-internal Info-breadcrumbs-depth)
3387 (Info-insert-breadcrumbs-in-mode-line)))))
3388
3389 (when (> emacs-major-version 22)
3390 (defun Info-set-breadcrumbs-depth ()
3391 "Set current breadcrumbs depth to a value read from user.
3392 Update breadcrumbs display in mode line accordingly."
3393 (interactive)
3394 (setq Info-breadcrumbs-depth-internal (read-number "New breadcrumbs depth: "
3395 Info-breadcrumbs-depth-internal))
3396 (when Info-breadcrumbs-in-mode-line-mode (Info-insert-breadcrumbs-in-mode-line))))
3397
3398
3399 ;; Match has, inside "..." or `...', zero or more of these characters:
3400 ;; - any character except " or ', respectively
3401 ;; - \ followed by any character
3402 ;;
3403 ;; The `... in `...' is optional, so the regexp can also match just '.
3404 ;;
3405 ;; The regexp matches also `...' and "..." where at least one of the `, ', or "
3406 ;; is escaped by a backslash. So we check those cases explicitly and don't highlight them.
3407 (defvar info-quotation-regexp
3408 (if (< emacs-major-version 21)
3409 (concat "\"\\([^\"]\\|\\\\\\(.\\|[\n]\\)\\)*\"\\|" ; "..."
3410 "\\(`[^']*\\|\\\\\\(.\\|[\n]\\)\\)*'") ; `...'
3411 (concat "\"\\(?:[^\"]\\|\\\\\\(?:.\\|[\n]\\)\\)*\"\\|" ; "..."
3412 "\\(`[^']*\\|\\\\\\(.\\|[\n]\\)\\)*'")) ; `...'
3413
3414 "Regexp to match `...', \"...\", or just '.
3415 If ... contains \" or ' then that character must be backslashed.")
3416
3417 (defun info-fontify-quotations ()
3418 "Fontify `...', \"...\", and if `Info-fontify-single-quote-flag', just '.
3419 `...'\t- use face `info-quoted-name'
3420 \"...\"\t- use face `info-string'
3421 '\t- use face `info-single-quote'"
3422 (let ((regexp info-quotation-regexp)
3423 (property (if (> emacs-major-version 21) 'font-lock-face 'face)))
3424 (while (condition-case nil (re-search-forward regexp nil t) (error nil))
3425 (cond ((and (eq ?` (aref (match-string 0) 0)) ; Single-quoted backslashes: `\', `\\', `\\\', etc.
3426 (goto-char (match-beginning 0))
3427 (save-match-data (looking-at "\\(`\\\\+'\\)")))
3428 (put-text-property (1+ (match-beginning 0)) (1- (match-end 0)) property 'info-quoted-name)
3429 (goto-char (match-end 0)))
3430 ((and (eq ?` (aref (match-string 0) 0)) ; `...': If ` is preceded by \, then skip it
3431 (goto-char (match-beginning 0))
3432 (< (save-excursion (skip-chars-backward "\\\\")) 0))
3433 (goto-char (1+ (match-beginning 0))))
3434 ((eq ?` (aref (match-string 0) 0)) ; `...'
3435 (put-text-property (1+ (match-beginning 0)) (1- (match-end 0)) property 'info-quoted-name)
3436 (goto-char (match-end 0)) (forward-char 1))
3437 ((and (goto-char (match-beginning 0)) ; "...": If " preceded by \, then skip it
3438 (< (save-excursion (skip-chars-backward "\\\\")) 0))
3439 (goto-char (1+ (match-beginning 0))))
3440 ((and Info-fontify-single-quote-flag
3441 (string= "'" (buffer-substring (match-beginning 0) (match-end 0)))) ; Single ': 'foo
3442 (put-text-property (match-beginning 0) (match-end 0)
3443 property 'info-single-quote)
3444 (goto-char (match-end 0)) (forward-char 1))
3445 (t ; "..."
3446 (put-text-property (match-beginning 0) (match-end 0)
3447 property 'info-string)
3448 (goto-char (match-end 0)) (forward-char 1))))))
3449
3450 (defun info-fontify-reference-items ()
3451 "Fontify reference items such as \"Function:\" in Info buffer."
3452 (while
3453 (re-search-forward
3454 "^ --? \\(Function:\\|Variable:\\|Special Form:\\|\
3455 Command:\\|User Option:\\|Macro:\\|Syntax class:\\)\\(.*\\)"
3456 nil t)
3457 (let ((symb (intern (match-string 1))))
3458 (put-text-property (match-beginning 1)
3459 (match-end 1)
3460 (if (> emacs-major-version 21) 'font-lock-face 'face)
3461 (case symb
3462 ('Function: 'info-function-ref-item)
3463 ('Variable: 'info-variable-ref-item)
3464 ('Special\ Form: 'info-special-form-ref-item)
3465 ('Command: 'info-command-ref-item)
3466 ('User\ Option: 'info-user-option-ref-item)
3467 ('Macro: 'info-macro-ref-item)
3468 ('Syntax\ class: 'info-syntax-class-item)))
3469 (put-text-property (match-beginning 2) (match-end 2)
3470 (if (> emacs-major-version 21) 'font-lock-face 'face)
3471 'info-reference-item))))
3472
3473
3474 ;; REPLACES ORIGINAL in `info.el':
3475 ;; 1. Fits frame if `one-window-p'.
3476 ;; 2. Highlights the found regexp if `search-highlight'.
3477 ;;
3478 (unless (>= emacs-major-version 22)
3479 (defun Info-search (regexp)
3480 "Search for REGEXP, starting from point, and select node it's found in.
3481 Fits frame if `one-window-p'.
3482 Highlights current location of found regexp if `search-highlight'.
3483 Note that the highlighting remains, after the search is over.
3484 To remove the highlighting, just start an incremental search: \
3485 `\\[isearch-forward]'."
3486 (interactive "sSearch (regexp): ")
3487 (when transient-mark-mode (deactivate-mark))
3488 (if (equal regexp "") (setq regexp Info-last-search) (setq Info-last-search regexp))
3489 (when regexp
3490 (prog1
3491 (let ((found ()) current
3492 (onode Info-current-node)
3493 (ofile Info-current-file)
3494 (opoint (point))
3495 (ostart (window-start))
3496 (osubfile Info-current-subfile))
3497 (save-excursion
3498 (save-restriction
3499 (widen)
3500 (if (null Info-current-subfile)
3501 (progn (re-search-forward regexp) (setq found (point)))
3502 (condition-case err
3503 (progn (re-search-forward regexp) (setq found (point)))
3504 (search-failed nil)))))
3505 ;; Can only happen in subfile case -- else would have erred.
3506 (unless found
3507 (unwind-protect
3508 (let ((list ()))
3509 (with-current-buffer (marker-buffer Info-tag-table-marker)
3510 (goto-char (point-min))
3511 (search-forward "\n\^_\nIndirect:")
3512 (save-restriction
3513 (narrow-to-region (point) (progn (search-forward "\n\^_") (1- (point))))
3514 (goto-char (point-min))
3515 (search-forward (concat "\n" osubfile ": "))
3516 (beginning-of-line)
3517 (while (not (eobp))
3518 (re-search-forward "\\(^.*\\): [0-9]+$")
3519 (goto-char (+ (match-end 1) 2))
3520 (setq list (cons (cons (read (current-buffer))
3521 (buffer-substring (match-beginning 1)
3522 (match-end 1)))
3523 list))
3524 (goto-char (1+ (match-end 0))))
3525 (setq list (nreverse list)
3526 current (caar list)
3527 list (cdr list))))
3528 (while list
3529 (message "Searching subfile `%s'..." (cdr (car list)))
3530 (Info-read-subfile (car (car list)))
3531 (setq list (cdr list))
3532 ;; (goto-char (point-min))
3533 (when (re-search-forward regexp nil t)
3534 (setq found (point)
3535 list ())))
3536 (if found (message "") (signal 'search-failed (list regexp))))
3537 (unless found
3538 (Info-read-subfile osubfile)
3539 (goto-char opoint)
3540 (Info-select-node)
3541 (set-window-start (selected-window) ostart))))
3542 (widen)
3543 (goto-char found)
3544 (when search-highlight
3545 (isearch-highlight (match-beginning 0) (match-end 0)))
3546 (Info-select-node)
3547 ;; Use string-equal, not equal, to ignore text props.
3548 (or (and (string-equal onode Info-current-node)
3549 (equal ofile Info-current-file))
3550 (setq Info-history (cons (list ofile onode opoint) Info-history)))
3551 (when (and (one-window-p t) (not (window-minibuffer-p))
3552 (fboundp 'fit-frame) ; Defined in `fit-frame.el'.
3553 Info-fit-frame-flag)
3554 (fit-frame)))
3555 (when (interactive-p)
3556 (message (substitute-command-keys
3557 "Use \\<Info-mode-map>`\\[Info-search] RET' to search again for `%s'.")
3558 regexp))))))
3559
3560
3561 ;; REPLACES ORIGINAL in `info.el':
3562 ;; 1. Fits frame if `one-window-p'.
3563 ;; 2. Highlights the found regexp if `search-highlight'.
3564 ;;
3565 (when (= emacs-major-version 22)
3566 (defun Info-search (regexp &optional bound noerror count direction)
3567 "Search for REGEXP, starting from point, and select node it's found in.
3568 If DIRECTION is `backward', search in the reverse direction.
3569 Fits frame if `one-window-p'.
3570 Highlights current location of found regexp if `search-highlight'.
3571 Note that the highlighting remains, after the search is over.
3572 To remove the highlighting, just start an incremental search: \
3573 `\\[isearch-forward]'."
3574 (interactive
3575 (list (let ((prompt (if Info-search-history
3576 (format "Regexp search%s (default `%s'): "
3577 (if case-fold-search "" " case-sensitively")
3578 (car Info-search-history))
3579 (format "Regexp search%s: "
3580 (if case-fold-search "" " case-sensitively")))))
3581 (if (fboundp 'icicle-read-string-completing)
3582 (icicle-read-string-completing prompt nil nil 'Info-search-history)
3583 (read-string prompt nil 'Info-search-history)))))
3584 (when transient-mark-mode (deactivate-mark))
3585 (when (equal regexp "") (setq regexp (car Info-search-history)))
3586 (when regexp
3587 (prog1
3588 (let (found beg-found give-up
3589 (backward (eq direction 'backward))
3590 (onode Info-current-node)
3591 (ofile Info-current-file)
3592 (opoint (point))
3593 (opoint-min (point-min))
3594 (opoint-max (point-max))
3595 (ostart (window-start))
3596 (osubfile Info-current-subfile))
3597 (setq Info-search-case-fold case-fold-search) ; `Info-search-case-fold' is free here.
3598 (save-excursion
3599 (save-restriction
3600 (widen)
3601 (when backward
3602 ;; Hide Info file header for backward search
3603 (narrow-to-region (save-excursion
3604 (goto-char (point-min))
3605 (search-forward "\n\^_")
3606 (1- (point)))
3607 (point-max)))
3608 (while (and (not give-up)
3609 (save-match-data
3610 (or (null found)
3611 (if backward
3612 (isearch-range-invisible found beg-found)
3613 (isearch-range-invisible beg-found found))
3614 ;; Skip node header line
3615 (and (save-excursion (forward-line -1)
3616 (looking-at "\^_"))
3617 (forward-line (if backward -1 1)))
3618 ;; Skip Tag Table node
3619 (save-excursion
3620 (and (search-backward "\^_" nil t)
3621 (looking-at "\^_\nTag Table"))))))
3622 (let ((search-spaces-regexp Info-search-whitespace-regexp)) ; `Info-*' is free here.
3623 (if (if backward
3624 (re-search-backward regexp bound t)
3625 (re-search-forward regexp bound t))
3626 (setq found (point)
3627 beg-found (if backward (match-end 0) (match-beginning 0)))
3628 (setq give-up t))))))
3629
3630 (when (and isearch-mode Info-isearch-search ; `Info-isearch-search' is free here.
3631 (not Info-isearch-initial-node) ; `Info-isearch-initial-node' is free here.
3632 (not bound)
3633 (or give-up (and found (not (and (> found opoint-min)
3634 (< found opoint-max))))))
3635 (signal 'search-failed (list regexp "initial node")))
3636
3637 ;; If no subfiles, give error now.
3638 (if give-up
3639 (if (null Info-current-subfile)
3640 (let ((search-spaces-regexp Info-search-whitespace-regexp)) ; `Info-*' free here.
3641 (if backward (re-search-backward regexp) (re-search-forward regexp)))
3642 (setq found nil)))
3643
3644 (if (and bound (not found))
3645 (signal 'search-failed (list regexp)))
3646
3647 (unless (or found bound)
3648 (unwind-protect
3649 ;; Try other subfiles.
3650 (let ((list ()))
3651 (with-current-buffer (marker-buffer Info-tag-table-marker)
3652 (goto-char (point-min))
3653 (search-forward "\n\^_\nIndirect:")
3654 (save-restriction
3655 (narrow-to-region (point)
3656 (progn (search-forward "\n\^_")
3657 (1- (point))))
3658 (goto-char (point-min))
3659 ;; Find the subfile we just searched.
3660 (search-forward (concat "\n" osubfile ": "))
3661 ;; Skip that one.
3662 (forward-line (if backward 0 1))
3663 (if backward (forward-char -1))
3664 ;; Make a list of all following subfiles.
3665 ;; Each elt has the form (VIRT-POSITION . SUBFILENAME).
3666 (while (not (if backward (bobp) (eobp)))
3667 (if backward
3668 (re-search-backward "\\(^.*\\): [0-9]+$")
3669 (re-search-forward "\\(^.*\\): [0-9]+$"))
3670 (goto-char (+ (match-end 1) 2))
3671 (setq list (cons (cons (+ (point-min) (read (current-buffer)))
3672 (match-string-no-properties 1))
3673 list))
3674 (goto-char (if backward
3675 (1- (match-beginning 0))
3676 (1+ (match-end 0)))))
3677 ;; Put in forward order
3678 (setq list (nreverse list))))
3679 (while list
3680 (message "Searching subfile %s..." (cdr (car list)))
3681 (Info-read-subfile (car (car list)))
3682 (when backward
3683 ;; Hide Info file header for backward search
3684 (narrow-to-region (save-excursion
3685 (goto-char (point-min))
3686 (search-forward "\n\^_")
3687 (1- (point)))
3688 (point-max))
3689 (goto-char (point-max)))
3690 (setq list (cdr list)
3691 give-up nil
3692 found nil)
3693 (while (and (not give-up)
3694 (save-match-data
3695 (or (null found)
3696 (if backward
3697 (isearch-range-invisible found beg-found)
3698 (isearch-range-invisible beg-found found))
3699 ;; Skip node header line
3700 (and (save-excursion (forward-line -1)
3701 (looking-at "\^_"))
3702 (forward-line (if backward -1 1)))
3703 ;; Skip Tag Table node
3704 (save-excursion
3705 (and (search-backward "\^_" nil t)
3706 (looking-at "\^_\nTag Table"))))))
3707 (let ((search-spaces-regexp Info-search-whitespace-regexp)) ; Free var.
3708 (if (if backward
3709 (re-search-backward regexp nil t)
3710 (re-search-forward regexp nil t))
3711 (setq found (point)
3712 beg-found (if backward (match-end 0) (match-beginning 0)))
3713 (setq give-up t))))
3714 (when give-up (setq found nil))
3715 (when found (setq list ())))
3716 (if found (message "") (signal 'search-failed (list regexp))))
3717 (if (not found)
3718 (progn (Info-read-subfile osubfile)
3719 (goto-char opoint)
3720 (Info-select-node)
3721 (set-window-start (selected-window) ostart)))))
3722
3723 (if (and (string= osubfile Info-current-subfile)
3724 (> found opoint-min)
3725 (< found opoint-max))
3726 ;; Search landed in the same node
3727 (goto-char found)
3728 (widen)
3729 (goto-char found)
3730 (save-match-data (Info-select-node)))
3731
3732 ;; Highlight regexp.
3733 (when search-highlight
3734 (isearch-highlight (match-beginning 0) (match-end 0)))
3735
3736 ;; Use string-equal, not equal, to ignore text props.
3737 (or (and (string-equal onode Info-current-node)
3738 (equal ofile Info-current-file))
3739 (and isearch-mode isearch-wrapped
3740 (eq opoint (if isearch-forward opoint-min opoint-max)))
3741 (setq Info-history (cons (list ofile onode opoint) Info-history)))
3742 (when (and (one-window-p t) (not (window-minibuffer-p))
3743 (fboundp 'fit-frame) ; Defined in `fit-frame.el'.
3744 Info-fit-frame-flag)
3745 (fit-frame)))
3746 (unless isearch-mode
3747 (message (substitute-command-keys
3748 "Use \\<Info-mode-map>`\\[Info-search] RET' to search again for `%s'.")
3749 regexp))))))
3750
3751
3752 ;; REPLACES ORIGINAL in `info.el':
3753 ;; 1. Fits frame if `one-window-p'.
3754 ;; 2. Highlights the found regexp if `search-highlight'.
3755 ;;
3756 (when (> emacs-major-version 22)
3757 (defun Info-search (regexp &optional bound noerror count direction)
3758 "Search for REGEXP, starting from point, and select node it's found in.
3759 If DIRECTION is `backward', search in the reverse direction.
3760 Fits frame if `one-window-p'.
3761 Highlights current location of found regexp if `search-highlight'.
3762 Note that the highlighting remains, after the search is over.
3763 To remove the highlighting, just start an incremental search: \
3764 `\\[isearch-forward]'."
3765 (interactive
3766 (list (let ((prompt (if Info-search-history
3767 (format "Regexp search%s (default `%s'): "
3768 (if case-fold-search "" " case-sensitively")
3769 (car Info-search-history))
3770 (format "Regexp search%s: "
3771 (if case-fold-search "" " case-sensitively")))))
3772 (if (fboundp 'icicle-read-string-completing)
3773 (icicle-read-string-completing prompt nil nil 'Info-search-history)
3774 (read-string prompt nil 'Info-search-history)))))
3775 (deactivate-mark)
3776 (when (equal regexp "")
3777 (setq regexp (car Info-search-history)))
3778 (when regexp
3779 (prog1
3780 (let (found beg-found give-up
3781 (backward (eq direction 'backward))
3782 (onode Info-current-node)
3783 (ofile Info-current-file)
3784 (opoint (point))
3785 (opoint-min (point-min))
3786 (opoint-max (point-max))
3787 (ostart (window-start))
3788 (osubfile Info-current-subfile))
3789 (setq Info-search-case-fold case-fold-search) ; `Info-search-case-fold' is free here.
3790 (save-excursion
3791 (save-restriction
3792 (widen)
3793 (when backward
3794 ;; Hide Info file header for backward search
3795 (narrow-to-region (save-excursion
3796 (goto-char (point-min))
3797 (search-forward "\n\^_")
3798 (1- (point)))
3799 (point-max)))
3800 (while (and (not give-up)
3801 (or (null found)
3802 (not (funcall isearch-filter-predicate beg-found found))))
3803 (let ((search-spaces-regexp (and (or (not isearch-mode) isearch-regexp)
3804 ;; `Info-*' is free here.
3805 Info-search-whitespace-regexp)))
3806 (if (if backward
3807 (re-search-backward regexp bound t)
3808 (re-search-forward regexp bound t))
3809 (setq found (point)
3810 beg-found (if backward (match-end 0) (match-beginning 0)))
3811 (setq give-up t))))))
3812
3813 (when (and isearch-mode Info-isearch-search ; `Info-isearch-search' is free here.
3814 (not Info-isearch-initial-node) ; `Info-isearch-initial-node' is free here.
3815 (not bound)
3816 (or give-up (and found (not (and (> found opoint-min) (< found opoint-max))))))
3817 (signal 'search-failed (list regexp "initial node")))
3818
3819 ;; If no subfiles, give error now.
3820 (if give-up
3821 (if (null Info-current-subfile)
3822 (let ((search-spaces-regexp (and (or (not isearch-mode) isearch-regexp)
3823 ;; `Info-*' is free here.
3824 Info-search-whitespace-regexp)))
3825 (if backward (re-search-backward regexp) (re-search-forward regexp)))
3826 (setq found nil)))
3827
3828 (when (and bound (not found)) (signal 'search-failed (list regexp)))
3829
3830 (unless (or found bound)
3831 (unwind-protect
3832 ;; Try other subfiles.
3833 (let ((list ()))
3834 (with-current-buffer (marker-buffer Info-tag-table-marker)
3835 (goto-char (point-min))
3836 (search-forward "\n\^_\nIndirect:")
3837 (save-restriction
3838 (narrow-to-region (point)
3839 (progn (search-forward "\n\^_")
3840 (1- (point))))
3841 (goto-char (point-min))
3842 ;; Find the subfile we just searched.
3843 (search-forward (concat "\n" osubfile ": "))
3844 ;; Skip that one.
3845 (forward-line (if backward 0 1))