;;; info.el --- info package for Emacs.
-;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 97 Free Software
+;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 97, 98, 99, 2000 Free Software
;; Foundation, Inc.
;; Maintainer: FSF
;;; Code:
+(eval-when-compile (require 'jka-compr))
+
(defgroup info nil
"Info subsystem"
:group 'help
:group 'info)
(defface info-node
- '((t (:bold t :italic t)))
+ '((((class color)) (:foreground "brown" :bold t :italic t))
+ (t (:bold t :italic t)))
"Face for Info node names."
:group 'info)
(defface info-menu-5
- '((t (:underline t)))
+ '((((class color)) (:foreground "red1"))
+ (t (:underline t)))
"Face for the fifth and tenth `*' in an Info menu."
:group 'info)
(defface info-xref
- '((t (:bold t)))
+ '((((class color)) (:foreground "magenta4" :bold t))
+ (t (:bold t)))
"Face for Info cross-references."
:group 'info)
-(defcustom Info-fontify-maximum-menu-size 30000
+(defcustom Info-fontify-maximum-menu-size 100000
"*Maximum size of menu to fontify if `Info-fontify' is non-nil."
:type 'integer
:group 'info)
-(defvar Info-directory-list
- (let ((path (getenv "INFOPATH"))
- ;; This is for older Emacs versions
- ;; which might get this info.el from the Texinfo distribution.
- (path-separator (if (boundp 'path-separator) path-separator
- (if (eq system-type 'ms-dos) ";" ":")))
- (source (expand-file-name "info/" source-directory))
- (sibling (if installation-directory
- (expand-file-name "info/" installation-directory)))
- alternative)
- (if path
- (let ((list nil)
- idx)
- (while (> (length path) 0)
- (setq idx (or (string-match path-separator path) (length path))
- list (cons (substring path 0 idx) list)
- path (substring path (min (1+ idx)
- (length path)))))
- (nreverse list))
- (if (and sibling (file-exists-p sibling))
- (setq alternative sibling)
- (setq alternative source))
- (if (or (member alternative Info-default-directory-list)
- (not (file-exists-p alternative))
- ;; On DOS/NT, we use movable executables always,
- ;; and we must always find the Info dir at run time.
- (if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt))
- nil
- ;; Use invocation-directory for Info only if we used it for
- ;; exec-directory also.
- (not (string= exec-directory
- (expand-file-name "lib-src/"
- installation-directory)))))
- Info-default-directory-list
- (reverse (cons alternative
- (cdr (reverse Info-default-directory-list)))))))
+(defvar Info-directory-list nil
"List of directories to search for Info documentation files.
nil means not yet initialized. In this case, Info uses the environment
variable INFOPATH to initialize it, or `Info-default-directory-list'
(defvar Info-current-file nil
"Info file that Info is now looking at, or nil.
This is the name that was specified in Info, not the actual file name.
-It doesn't contain directory names or file name extensions added by Info.")
+It doesn't contain directory names or file name extensions added by Info.
+Can also be t when using `Info-on-current-buffer'.")
(defvar Info-current-subfile nil
"Info subfile that is actually in the *info* buffer now,
(defvar Info-standalone nil
"Non-nil if Emacs was started solely as an Info browser.")
-
+\f
(defvar Info-suffix-list
;; The MS-DOS list should work both when long file names are
;; supported (Windows 9X), and when only 8+3 file names are available.
(if (eq system-type 'ms-dos)
'( (".gz" . "gunzip")
(".z" . "gunzip")
+ (".bz2" . "bzip2 -dc")
(".inz" . "gunzip")
(".igz" . "gunzip")
(".info.Z" . "gunzip")
(".info.Y". "unyabba")
(".info.gz". "gunzip")
(".info.z". "gunzip")
+ (".info.bz2" . "bzip2 -dc")
(".info". nil)
("-info.Z". "uncompress")
("-info.Y". "unyabba")
("-info.gz". "gunzip")
+ ("-info.bz2" . "bzip2 -dc")
("-info.z". "gunzip")
("-info". nil)
("/index.Z". "uncompress")
("/index.Y". "unyabba")
("/index.gz". "gunzip")
("/index.z". "gunzip")
+ ("/index.bz2". "bzip2 -dc")
("/index". nil)
(".Z". "uncompress")
(".Y". "unyabba")
(".gz". "gunzip")
(".z". "gunzip")
+ (".bz2" . "bzip2 -dc")
("". nil)))
"List of file name suffixes and associated decoding commands.
Each entry should be (SUFFIX . STRING); the file is given to
(- ext-len ext-left)))
suffix))))
+(defun info-file-exists-p (filename)
+ (and (file-exists-p filename)
+ (not (file-directory-p filename))))
+
(defun info-insert-file-contents (filename &optional visit)
"Insert the contents of an info file in the current buffer.
Do the right thing if the file has been compressed or zipped."
decoder (cdr (car tail))))
;; Try adding suffixes to FILENAME and see if we can find something.
(while (and tail
- (not (file-exists-p (info-insert-file-contents-1
- filename (car (car tail))))))
+ (not (info-file-exists-p (info-insert-file-contents-1
+ filename (car (car tail))))))
(setq tail (cdr tail)))
;; If we found a file with a suffix, set DECODER according to the suffix
;; and set FULLNAME to the file's actual name.
default-directory)))
(call-process-region (point-min) (point-max) decoder t t)))
(insert-file-contents fullname visit))))
+\f
+;; Initialize Info-directory-list, if that hasn't been done yet.
+(defun info-initialize ()
+ (unless Info-directory-list
+ (let ((path (getenv "INFOPATH"))
+ (source (expand-file-name "info/" source-directory))
+ (sibling (if installation-directory
+ (expand-file-name "info/" installation-directory)))
+ alternative)
+ (setq Info-directory-list
+ (if path
+ (split-string path (regexp-quote path-separator))
+ (if (and sibling (file-exists-p sibling))
+ ;; Uninstalled, Emacs builddir != srcdir.
+ (setq alternative sibling)
+ ;; Uninstalled, builddir == srcdir
+ (setq alternative source))
+ (if (or (member alternative Info-default-directory-list)
+ ;; On DOS/NT, we use movable executables always,
+ ;; and we must always find the Info dir at run time.
+ (if (memq system-type '(ms-dos windows-nt))
+ nil
+ ;; Use invocation-directory for Info
+ ;; only if we used it for exec-directory also.
+ (not (string= exec-directory
+ (expand-file-name "lib-src/"
+ installation-directory))))
+ (not (file-exists-p alternative)))
+ Info-default-directory-list
+ ;; `alternative' contains the Info files that came with this
+ ;; version, so we should look there first. `Info-insert-dir'
+ ;; currently expects to find `alternative' first on the list.
+ (cons alternative
+ (reverse (cdr (reverse Info-default-directory-list))))))))))
+;;;###autoload
+(defun info-other-window (&optional file)
+ "Like `info' but show the Info buffer in another window."
+ (interactive (if current-prefix-arg
+ (list (read-file-name "Info file name: " nil nil t))))
+ (let (same-window-buffer-names)
+ (info file)))
+
;;;###autoload (add-hook 'same-window-buffer-names "*info*")
;;;###autoload
"Enter Info, the documentation browser.
Optional argument FILE specifies the file to examine;
the default is the top-level directory of Info.
+Called from a program, FILE may specify an Info node of the form
+`(FILENAME)NODENAME'.
In interactive use, a prefix argument directs this command
to read a file name from the minibuffer.
(interactive (if current-prefix-arg
(list (read-file-name "Info file name: " nil nil t))))
(if file
- (progn (pop-to-buffer "*info*")
- (Info-goto-node (concat "(" file ")")))
+ (progn
+ (pop-to-buffer "*info*")
+ ;; If argument already contains parentheses, don't add another set
+ ;; since the argument will then be parsed improperly. This also
+ ;; has the added benefit of allowing node names to be included
+ ;; following the parenthesized filename.
+ (if (and (stringp file) (string-match "(.*)" file))
+ (Info-goto-node file)
+ (Info-goto-node (concat "(" file ")"))))
(if (get-buffer "*info*")
(pop-to-buffer "*info*")
(Info-directory))))
(nth 1 err) err)))
(save-buffers-kill-emacs)))
(info)))
+\f
+;; See if the the accessible portion of the buffer begins with a node
+;; delimiter, and the node header line which follows matches REGEXP.
+;; Typically, this test will be followed by a loop that examines the
+;; rest of the buffer with (search-forward "\n\^_"), and it's a pity
+;; to have the overhead of this special test inside the loop.
+
+;; This function changes match-data, but supposedly the caller might
+;; want to use the results of re-search-backward.
+
+;; The return value is the value of point at the beginning of matching
+;; REGERXP, if the function succeeds, nil otherwise.
+(defun Info-node-at-bob-matching (regexp)
+ (and (bobp) ; are we at beginning of buffer?
+ (looking-at "\^_") ; does it begin with node delimiter?
+ (let (beg)
+ (forward-line 1)
+ (setq beg (point))
+ (forward-line 1) ; does the line after delimiter match REGEXP?
+ (re-search-backward regexp beg t))))
;; Go to an info node specified as separate filename and nodename.
;; no-going-back is non-nil if recovering from an error in this function;
;; it says do not attempt further (recursive) error recovery.
(defun Info-find-node (filename nodename &optional no-going-back)
+ (info-initialize)
;; Convert filename to lower case if not found as specified.
;; Expand it.
- (if filename
+ (if (stringp filename)
(let (temp temp-downcase found)
- (setq filename (substitute-in-file-name filename))
- (if (string= (downcase filename) "dir")
- (setq found t)
- (let ((dirs (if (string-match "^\\./" filename)
- ;; If specified name starts with `./'
- ;; then just try current directory.
- '("./")
- (if (file-name-absolute-p filename)
- ;; No point in searching for an
- ;; absolute file name
- '(nil)
- (if Info-additional-directory-list
- (append Info-directory-list
- Info-additional-directory-list)
- Info-directory-list)))))
- ;; Search the directory list for file FILENAME.
- (while (and dirs (not found))
- (setq temp (expand-file-name filename (car dirs)))
- (setq temp-downcase
- (expand-file-name (downcase filename) (car dirs)))
- ;; Try several variants of specified name.
- (let ((suffix-list Info-suffix-list))
- (while (and suffix-list (not found))
- (cond ((file-exists-p
- (info-insert-file-contents-1
- temp (car (car suffix-list))))
- (setq found temp))
- ((file-exists-p
- (info-insert-file-contents-1
- temp-downcase (car (car suffix-list))))
- (setq found temp-downcase)))
- (setq suffix-list (cdr suffix-list))))
- (setq dirs (cdr dirs)))))
- (if found
- (setq filename found)
- (error "Info file %s does not exist" filename))))
+ (setq filename (substitute-in-file-name filename))
+ (if (string= (downcase filename) "dir")
+ (setq found t)
+ (let ((dirs (if (string-match "^\\./" filename)
+ ;; If specified name starts with `./'
+ ;; then just try current directory.
+ '("./")
+ (if (file-name-absolute-p filename)
+ ;; No point in searching for an
+ ;; absolute file name
+ '(nil)
+ (if Info-additional-directory-list
+ (append Info-directory-list
+ Info-additional-directory-list)
+ Info-directory-list)))))
+ ;; Search the directory list for file FILENAME.
+ (while (and dirs (not found))
+ (setq temp (expand-file-name filename (car dirs)))
+ (setq temp-downcase
+ (expand-file-name (downcase filename) (car dirs)))
+ ;; Try several variants of specified name.
+ (let ((suffix-list Info-suffix-list))
+ (while (and suffix-list (not found))
+ (cond ((info-file-exists-p
+ (info-insert-file-contents-1
+ temp (car (car suffix-list))))
+ (setq found temp))
+ ((info-file-exists-p
+ (info-insert-file-contents-1
+ temp-downcase (car (car suffix-list))))
+ (setq found temp-downcase)))
+ (setq suffix-list (cdr suffix-list))))
+ (setq dirs (cdr dirs)))))
+ (if found
+ (setq filename found)
+ (error "Info file %s does not exist" filename))))
+ ;; Record the node we are leaving.
+ (if (and Info-current-file (not no-going-back))
+ (setq Info-history
+ (cons (list Info-current-file Info-current-node (point))
+ Info-history)))
;; Go into info buffer.
(or (eq major-mode 'Info-mode) (pop-to-buffer "*info*"))
+ (Info-find-node-2 filename nodename no-going-back))
+
+(defun Info-on-current-buffer (&optional nodename)
+ "Use the `Info-mode' to browse the current info buffer.
+If a prefix arg is provided, it queries for the NODENAME which
+else defaults to `Top'."
+ (interactive
+ (list (if current-prefix-arg
+ (completing-read "Node name: " (Info-build-node-completions)
+ nil t "Top")
+ "Top")))
+ (Info-mode)
+ (set (make-local-variable 'Info-current-file) t)
+ (Info-find-node-2 nil nodename))
+
+(defun Info-find-node-2 (filename nodename &optional no-going-back)
(buffer-disable-undo (current-buffer))
(or (eq major-mode 'Info-mode)
(Info-mode))
- ;; Record the node we are leaving.
- (if (and Info-current-file (not no-going-back))
- (setq Info-history
- (cons (list Info-current-file Info-current-node (point))
- Info-history)))
(widen)
(setq Info-current-node nil)
(unwind-protect
- (progn
- ;; Switch files if necessary
- (or (null filename)
- (equal Info-current-file filename)
- (let ((buffer-read-only nil))
- (setq Info-current-file nil
- Info-current-subfile nil
- Info-current-file-completions nil
- buffer-file-name nil)
- (erase-buffer)
- (if (eq filename t)
- (Info-insert-dir)
- (info-insert-file-contents filename t)
- (setq default-directory (file-name-directory filename)))
- (set-buffer-modified-p nil)
- ;; See whether file has a tag table. Record the location if yes.
- (goto-char (point-max))
- (forward-line -8)
- ;; Use string-equal, not equal, to ignore text props.
- (if (not (or (string-equal nodename "*")
- (not
- (search-forward "\^_\nEnd tag table\n" nil t))))
- (let (pos)
- ;; We have a tag table. Find its beginning.
- ;; Is this an indirect file?
- (search-backward "\nTag table:\n")
- (setq pos (point))
- (if (save-excursion
- (forward-line 2)
- (looking-at "(Indirect)\n"))
- ;; It is indirect. Copy it to another buffer
- ;; and record that the tag table is in that buffer.
- (let ((buf (current-buffer))
- (tagbuf
- (or Info-tag-table-buffer
- (generate-new-buffer " *info tag table*"))))
- (setq Info-tag-table-buffer tagbuf)
- (save-excursion
- (set-buffer tagbuf)
+ ;; Bind case-fold-search in case the user sets it to nil.
+ (let ((case-fold-search t)
+ anchorpos)
+ ;; Switch files if necessary
+ (or (null filename)
+ (equal Info-current-file filename)
+ (let ((buffer-read-only nil))
+ (setq Info-current-file nil
+ Info-current-subfile nil
+ Info-current-file-completions nil
+ buffer-file-name nil)
+ (erase-buffer)
+ (if (eq filename t)
+ (Info-insert-dir)
+ (info-insert-file-contents filename t)
+ (setq default-directory (file-name-directory filename)))
+ (set-buffer-modified-p nil)
+ ;; See whether file has a tag table. Record the location if yes.
+ (goto-char (point-max))
+ (forward-line -8)
+ ;; Use string-equal, not equal, to ignore text props.
+ (if (not (or (string-equal nodename "*")
+ (not
+ (search-forward "\^_\nEnd tag table\n" nil t))))
+ (let (pos)
+ ;; We have a tag table. Find its beginning.
+ ;; Is this an indirect file?
+ (search-backward "\nTag table:\n")
+ (setq pos (point))
+ (if (save-excursion
+ (forward-line 2)
+ (looking-at "(Indirect)\n"))
+ ;; It is indirect. Copy it to another buffer
+ ;; and record that the tag table is in that buffer.
+ (let ((buf (current-buffer))
+ (tagbuf
+ (or Info-tag-table-buffer
+ (generate-new-buffer " *info tag table*"))))
+ (setq Info-tag-table-buffer tagbuf)
+ (save-excursion
+ (set-buffer tagbuf)
(buffer-disable-undo (current-buffer))
- (setq case-fold-search t)
- (erase-buffer)
- (insert-buffer-substring buf))
- (set-marker Info-tag-table-marker
- (match-end 0) tagbuf))
- (set-marker Info-tag-table-marker pos)))
- (set-marker Info-tag-table-marker nil))
- (setq Info-current-file
- (if (eq filename t) "dir" filename))))
- ;; Use string-equal, not equal, to ignore text props.
- (if (string-equal nodename "*")
- (progn (setq Info-current-node nodename)
- (Info-set-mode-line))
- ;; Search file for a suitable node.
+ (setq case-fold-search t)
+ (erase-buffer)
+ (insert-buffer-substring buf))
+ (set-marker Info-tag-table-marker
+ (match-end 0) tagbuf))
+ (set-marker Info-tag-table-marker pos)))
+ (set-marker Info-tag-table-marker nil))
+ (setq Info-current-file
+ (if (eq filename t) "dir" filename))))
+ ;; Use string-equal, not equal, to ignore text props.
+ (if (string-equal nodename "*")
+ (progn (setq Info-current-node nodename)
+ (Info-set-mode-line))
+ ;; Possibilities:
+ ;;
+ ;; 1. Anchor found in tag table
+ ;; 2. Anchor *not* in tag table
+ ;;
+ ;; 3. Node found in tag table
+ ;; 4. Node *not* found in tag table, but found in file
+ ;; 5. Node *not* in tag table, and *not* in file
+ ;;
+ ;; *Or* the same, but in an indirect subfile.
+
+ ;; Search file for a suitable node.
(let ((guesspos (point-min))
- (regexp (concat "Node: *" (regexp-quote nodename) " *[,\t\n\177]")))
- ;; First get advice from tag table if file has one.
- ;; Also, if this is an indirect info file,
- ;; read the proper subfile into this buffer.
- (if (marker-position Info-tag-table-marker)
- (save-excursion
- (let ((m Info-tag-table-marker)
- found found-mode)
- (save-excursion
- (set-buffer (marker-buffer m))
- (goto-char m)
- (beginning-of-line) ;so re-search will work.
- (setq found (re-search-forward regexp nil t))
- (if found
- (setq guesspos (read (current-buffer))))
- (setq found-mode major-mode))
- (if found
- (progn
- ;; If this is an indirect file, determine
- ;; which file really holds this node and
- ;; read it in.
- (if (not (eq found-mode 'Info-mode))
- ;; Note that the current buffer must be
- ;; the *info* buffer on entry to
- ;; Info-read-subfile. Thus the hackery
- ;; above.
- (setq guesspos (Info-read-subfile guesspos))))
- (error "No such node: %s" nodename)))))
- (goto-char (max (point-min) (- guesspos 1000)))
- ;; Now search from our advised position (or from beg of buffer)
- ;; to find the actual node.
- (catch 'foo
- (while (search-forward "\n\^_" nil t)
- (forward-line 1)
- (let ((beg (point)))
- (forward-line 1)
- (if (re-search-backward regexp beg t)
- (throw 'foo t))))
- (error "No such node: %s" nodename)))
- (Info-select-node)))
+ (regexp
+ (concat "\\(Node:\\|Ref:\\) *\\("
+ (regexp-quote nodename)
+ "\\) *[,\t\n\177]"))
+ (nodepos nil))
+
+ ;; First, search a tag table, if any
+ (if (marker-position Info-tag-table-marker)
+ (let ((found-in-tag-table t)
+ found-anchor
+ found-mode
+ (m Info-tag-table-marker))
+ (save-excursion
+ (set-buffer (marker-buffer m))
+ (goto-char m)
+ (beginning-of-line) ; so re-search will work.
+
+ ;; Search tag table
+ (catch 'foo
+ (while (re-search-forward regexp nil t)
+ (setq found-anchor
+ (string-equal "Ref:" (match-string 1)))
+ (or nodepos (setq nodepos (point))
+ (if (string-equal (match-string 2) nodename)
+ (throw 'foo t))))
+ (if nodepos
+ (goto-char nodepos)
+ (setq found-in-tag-table nil)))
+ (if found-in-tag-table
+ (setq guesspos (1+ (read (current-buffer)))))
+ (setq found-mode major-mode))
+
+ ;; Indirect file among split files
+ (if found-in-tag-table
+ (progn
+ ;; If this is an indirect file, determine
+ ;; which file really holds this node and
+ ;; read it in.
+ (if (not (eq found-mode 'Info-mode))
+ ;; Note that the current buffer must be
+ ;; the *info* buffer on entry to
+ ;; Info-read-subfile. Thus the hackery
+ ;; above.
+ (setq guesspos (Info-read-subfile guesspos)))))
+
+ ;; Handle anchor
+ (if found-anchor
+ (goto-char (setq anchorpos guesspos))
+
+ ;; Else we may have a node, which we search for:
+ (let ((guesschar
+ (or (byte-to-position guesspos)
+ (if (< (position-bytes (point-max)) guesspos)
+ (point-max)
+ (point-min)))))
+ (goto-char (max (point-min)
+ (- guesschar 1000))))
+ ;; Now search from our advised position
+ ;; (or from beg of buffer)
+ ;; to find the actual node.
+ ;; First, check whether the node is right
+ ;; where we are, in case the buffer begins
+ ;; with a node.
+ (setq nodepos nil)
+ (or (Info-node-at-bob-matching regexp)
+ (catch 'foo
+ (while (search-forward "\n\^_" nil t)
+ (forward-line 1)
+ (let ((beg (point)))
+ (forward-line 1)
+ (if (re-search-backward regexp beg t)
+ (if (string-equal (match-string 2) nodename)
+ (progn
+ (beginning-of-line)
+ (throw 'foo t))
+ (or nodepos
+ (setq nodepos (point)))))))
+ (if nodepos
+ (progn
+ (goto-char nodepos)
+ (beginning-of-line))
+ (error
+ "No such anchor in tag table or node in tag table or file: %s"
+ nodename))))))
+ (goto-char (max (point-min) (- guesspos 1000)))
+ ;; Now search from our advised position (or from beg of buffer)
+ ;; to find the actual node.
+ ;; First, check whether the node is right where we are, in case
+ ;; the buffer begins with a node.
+ (setq nodepos nil)
+ (or (Info-node-at-bob-matching regexp)
+ (catch 'foo
+ (while (search-forward "\n\^_" nil t)
+ (forward-line 1)
+ (let ((beg (point)))
+ (forward-line 1)
+ (if (re-search-backward regexp beg t)
+ (if (string-equal (match-string 2) nodename)
+ (throw 'foo t)
+ (or nodepos
+ (setq nodepos (point)))))))
+ (if nodepos
+ (goto-char nodepos)
+ (error "No such node: %s" nodename))))))
+ (Info-select-node)
+ (goto-char (or anchorpos (point-min)))))
;; If we did not finish finding the specified node,
;; go back to the previous one.
(or Info-current-node no-going-back (null Info-history)
- (let ((hist (car Info-history)))
- (setq Info-history (cdr Info-history))
- (Info-find-node (nth 0 hist) (nth 1 hist) t)
- (goto-char (nth 2 hist)))))
- (goto-char (point-min)))
+ (let ((hist (car Info-history)))
+ (setq Info-history (cdr Info-history))
+ (Info-find-node (nth 0 hist) (nth 1 hist) t)
+ (goto-char (nth 2 hist))))))
;; Cache the contents of the (virtual) dir file, once we have merged
;; it for the first time, so we can save time subsequently.
;; constructed Info-dir-contents.
(defvar Info-dir-file-attributes nil)
+(defvar Info-dir-file-name nil)
+
;; Construct the Info directory node by merging the files named `dir'
;; from various directories. Set the *info* buffer's
;; default-directory to the first directory we actually get any text
;; since we used it.
(eval (cons 'and
(mapcar '(lambda (elt)
- (let ((curr (file-attributes (car elt))))
+ (let ((curr (file-attributes
+ ;; Handle symlinks
+ (file-truename (car elt)))))
+
;; Don't compare the access time.
(if curr (setcar (nthcdr 4 curr) 0))
(setcar (nthcdr 4 (cdr elt)) 0)
(equal (cdr elt) curr)))
Info-dir-file-attributes))))
- (insert Info-dir-contents)
+ (progn
+ (insert Info-dir-contents)
+ (goto-char (point-min)))
(let ((dirs Info-directory-list)
+ ;; Bind this in case the user sets it to nil.
+ (case-fold-search t)
+ ;; This is set non-nil if we find a problem in some input files.
+ problems
buffers buffer others nodes dirs-done)
(setq Info-dir-file-attributes nil)
(or buffers
(message "Composing main Info directory..."))
(set-buffer (generate-new-buffer " info dir"))
- (insert-file-contents file)
- (setq buffers (cons (current-buffer) buffers)
- Info-dir-file-attributes
- (cons (cons file attrs)
- Info-dir-file-attributes))))))
+ (condition-case nil
+ (progn
+ (insert-file-contents file)
+ (make-local-variable 'Info-dir-file-name)
+ (setq Info-dir-file-name file)
+ (setq buffers (cons (current-buffer) buffers)
+ Info-dir-file-attributes
+ (cons (cons file attrs)
+ Info-dir-file-attributes)))
+ (error (kill-buffer (current-buffer))))))))
(or (cdr dirs) (setq Info-dir-contents-directory
(file-name-as-directory (car dirs))))
(setq dirs (cdr dirs))))
(error "Can't find the Info directory node"))
;; Distinguish the dir file that comes with Emacs from all the
;; others. Yes, that is really what this is supposed to do.
- ;; If it doesn't work, fix it.
- (setq buffer (car buffers)
- others (cdr buffers))
+ ;; The definition of `Info-directory-list' puts it first on that
+ ;; list and so last in `buffers' at this point.
+ (setq buffer (car (last buffers))
+ others (delq buffer buffers))
;; Insert the entire original dir file as a start; note that we've
;; already saved its default directory to use as the default
;; Look at each of the other buffers one by one.
(while others
- (let ((other (car others)))
+ (let ((other (car others))
+ this-buffer-nodes)
;; In each, find all the menus.
(save-excursion
(set-buffer other)
(let (beg nodename end)
(forward-line 1)
(setq beg (point))
- (search-backward "\n\^_")
+ (or (search-backward "\n\^_" nil 'move)
+ (looking-at "\^_")
+ (signal 'search-failed (list "\n\^_")))
(search-forward "Node: ")
(setq nodename (Info-following-node-name))
(search-forward "\n\^_" nil 'move)
(beginning-of-line)
(setq end (point))
- (setq nodes (cons (list nodename other beg end) nodes))))))
+ (setq this-buffer-nodes
+ (cons (list nodename other beg end)
+ this-buffer-nodes))))
+ (if (assoc-ignore-case "top" this-buffer-nodes)
+ (setq nodes (nconc this-buffer-nodes nodes))
+ (setq problems t)
+ (message "No `top' node in %s" Info-dir-file-name))))
(setq others (cdr others)))
;; Add to the main menu a menu item for each other node.
(re-search-forward "^\\* Menu:")
(let ((nodename (car (car nodes))))
(goto-char (point-min))
;; Find the like-named node in the main buffer.
- (if (re-search-forward (concat "\n\^_.*\n.*Node: "
+ (if (re-search-forward (concat "^\^_.*\n.*Node: "
(regexp-quote nodename)
"[,\n\t]")
nil t)
(while buffers
(kill-buffer (car buffers))
(setq buffers (cdr buffers)))
- (message "Composing main Info directory...done"))
+ (goto-char (point-min))
+ (if problems
+ (message "Composing main Info directory...problems encountered, see `*Messages*'")
+ (message "Composing main Info directory...done")))
(setq Info-dir-contents (buffer-string)))
(setq default-directory Info-dir-contents-directory))
(save-excursion
(set-buffer (marker-buffer Info-tag-table-marker))
(goto-char (point-min))
- (search-forward "\n\^_")
+ (or (looking-at "\^_")
+ (search-forward "\n\^_"))
(forward-line 2)
(catch 'foo
(while (not (looking-at "\^_"))
(set-buffer-modified-p nil)
(setq Info-current-subfile lastfilename)))
(goto-char (point-min))
- (search-forward "\n\^_")
+ (if (looking-at "\^_")
+ (forward-char 1)
+ (search-forward "\n\^_"))
(if (numberp nodepos)
(+ (- nodepos lastfilepos) (point)))))
;; Select the info node that point is in.
(defun Info-select-node ()
- (save-excursion
- ;; Find beginning of node.
- (search-backward "\n\^_")
- (forward-line 2)
- ;; Get nodename spelled as it is in the node.
- (re-search-forward "Node:[ \t]*")
- (setq Info-current-node
- (buffer-substring-no-properties (point)
- (progn
- (skip-chars-forward "^,\t\n")
- (point))))
- (Info-set-mode-line)
- ;; Find the end of it, and narrow.
- (beginning-of-line)
- (let (active-expression)
- (narrow-to-region (point)
- (if (re-search-forward "\n[\^_\f]" nil t)
- (prog1
- (1- (point))
- (if (looking-at "[\n\^_\f]*execute: ")
- (progn
- (goto-char (match-end 0))
- (setq active-expression
- (read (current-buffer))))))
- (point-max)))
- (if Info-enable-active-nodes (eval active-expression))
- (if Info-fontify (Info-fontify-node))
- (run-hooks 'Info-selection-hook))))
+ ;; Bind this in case the user sets it to nil.
+ (let ((case-fold-search t))
+ (save-excursion
+ ;; Find beginning of node.
+ (if (search-backward "\n\^_" nil 'move)
+ (forward-line 2)
+ (if (looking-at "\^_")
+ (forward-line 1)
+ (signal 'search-failed (list "\n\^_"))))
+ ;; Get nodename spelled as it is in the node.
+ (re-search-forward "Node:[ \t]*")
+ (setq Info-current-node
+ (buffer-substring-no-properties (point)
+ (progn
+ (skip-chars-forward "^,\t\n")
+ (point))))
+ (Info-set-mode-line)
+ ;; Find the end of it, and narrow.
+ (beginning-of-line)
+ (let (active-expression)
+ (narrow-to-region (point)
+ (if (re-search-forward "\n[\^_\f]" nil t)
+ (prog1
+ (1- (point))
+ (if (looking-at "[\n\^_\f]*execute: ")
+ (progn
+ (goto-char (match-end 0))
+ (setq active-expression
+ (read (current-buffer))))))
+ (point-max)))
+ (if Info-enable-active-nodes (eval active-expression))
+ (if Info-fontify (Info-fontify-node))
+ (run-hooks 'Info-selection-hook)))))
(defun Info-set-mode-line ()
(setq mode-line-buffer-identification
(concat
" Info: ("
(if Info-current-file
- (file-name-nondirectory Info-current-file)
+ (file-name-nondirectory (if (stringp Info-current-file)
+ Info-current-file
+ (or buffer-file-name "")))
"")
")"
(or Info-current-node ""))))
;; Go to an info node specified with a filename-and-nodename string
;; of the sort that is found in pointers in nodes.
-(defun Info-goto-node (nodename)
- "Go to info node named NAME. Give just NODENAME or (FILENAME)NODENAME."
- (interactive (list (Info-read-node-name "Goto node: ")))
+(defun Info-goto-node (nodename &optional fork)
+ "Go to info node named NAME. Give just NODENAME or (FILENAME)NODENAME.
+If FORK is non-nil, show the node in a new info buffer.
+If FORK is a string, it is the name to use for the new buffer."
+ (interactive (list (Info-read-node-name "Goto node: ") current-prefix-arg))
+ (info-initialize)
+ (if fork
+ (set-buffer
+ (clone-buffer (concat "*info-" (if (stringp fork) fork nodename) "*") t)))
(let (filename)
(string-match "\\s *\\((\\s *\\([^\t)]*\\)\\s *)\\s *\\|\\)\\(.*\\)"
nodename)
(Info-find-node (if (equal filename "") nil filename)
(if (equal nodename "") "Top" nodename))))
+(defvar Info-read-node-completion-table)
+
;; This function is used as the "completion table" while reading a node name.
-;; It does completion using the alist in completion-table
+;; It does completion using the alist in Info-read-node-completion-table
;; unless STRING starts with an open-paren.
(defun Info-read-node-name-1 (string predicate code)
(let ((no-completion (and (> (length string) 0) (eq (aref string 0) ?\())))
(cond ((eq code nil)
(if no-completion
string
- (try-completion string completion-table predicate)))
+ (try-completion string Info-read-node-completion-table predicate)))
((eq code t)
(if no-completion
nil
- (all-completions string completion-table predicate)))
+ (all-completions string Info-read-node-completion-table predicate)))
((eq code 'lambda)
(if no-completion
t
- (assoc string completion-table))))))
+ (assoc string Info-read-node-completion-table))))))
(defun Info-read-node-name (prompt &optional default)
(let* ((completion-ignore-case t)
- (completion-table (Info-build-node-completions))
+ (Info-read-node-completion-table (Info-build-node-completions))
(nodename (completing-read prompt 'Info-read-node-name-1 nil t)))
(if (equal nodename "")
(or default
(defun Info-build-node-completions ()
(or Info-current-file-completions
- (let ((compl nil))
+ (let ((compl nil)
+ ;; Bind this in case the user sets it to nil.
+ (case-fold-search t)
+ (node-regexp "Node: *\\([^,\n]*\\) *[,\n\t]"))
(save-excursion
(save-restriction
(if (marker-buffer Info-tag-table-marker)
(goto-char marker)
(while (re-search-forward "\nNode: \\(.*\\)\177" nil t)
(setq compl
- (cons (list (buffer-substring (match-beginning 1)
- (match-end 1)))
+ (cons (list (match-string-no-properties 1))
compl))))
(widen)
(goto-char (point-min))
+ ;; If the buffer begins with a node header, process that first.
+ (if (Info-node-at-bob-matching node-regexp)
+ (setq compl (list (match-string-no-properties 1))))
+ ;; Now for the rest of the nodes.
(while (search-forward "\n\^_" nil t)
(forward-line 1)
(let ((beg (point)))
(forward-line 1)
- (if (re-search-backward "Node: *\\([^,\n]*\\) *[,\n\t]"
- beg t)
+ (if (re-search-backward node-regexp beg t)
(setq compl
- (cons (list (buffer-substring (match-beginning 1)
- (match-end 1)))
+ (cons (list (match-string-no-properties 1))
compl))))))))
+ (setq compl (cons '("*") compl))
(setq Info-current-file-completions compl))))
\f
(defun Info-restore-point (hl)
(if (equal regexp "")
(setq regexp Info-last-search)
(setq Info-last-search regexp))
- (let ((found ()) current
- (onode Info-current-node)
- (ofile Info-current-file)
- (opoint (point))
- (ostart (window-start))
- (osubfile Info-current-subfile))
- (save-excursion
- (save-restriction
- (widen)
- (if (null Info-current-subfile)
- (progn (re-search-forward regexp) (setq found (point)))
- (condition-case err
+ (when regexp
+ (let ((found ()) current
+ (onode Info-current-node)
+ (ofile Info-current-file)
+ (opoint (point))
+ (ostart (window-start))
+ (osubfile Info-current-subfile))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (if (null Info-current-subfile)
(progn (re-search-forward regexp) (setq found (point)))
- (search-failed nil)))))
- (if (not found) ;can only happen in subfile case -- else would have erred
- (unwind-protect
- (let ((list ()))
- (save-excursion
- (set-buffer (marker-buffer Info-tag-table-marker))
- (goto-char (point-min))
- (search-forward "\n\^_\nIndirect:")
- (save-restriction
- (narrow-to-region (point)
- (progn (search-forward "\n\^_")
- (1- (point))))
+ (condition-case err
+ (progn (re-search-forward regexp) (setq found (point)))
+ (search-failed nil)))))
+ (if (not found) ;can only happen in subfile case -- else would have erred
+ (unwind-protect
+ (let ((list ()))
+ (save-excursion
+ (set-buffer (marker-buffer Info-tag-table-marker))
(goto-char (point-min))
- (search-forward (concat "\n" osubfile ": "))
- (beginning-of-line)
- (while (not (eobp))
- (re-search-forward "\\(^.*\\): [0-9]+$")
- (goto-char (+ (match-end 1) 2))
- (setq list (cons (cons (read (current-buffer))
- (buffer-substring
- (match-beginning 1) (match-end 1)))
- list))
- (goto-char (1+ (match-end 0))))
- (setq list (nreverse list)
- current (car (car list))
- list (cdr list))))
- (while list
- (message "Searching subfile %s..." (cdr (car list)))
- (Info-read-subfile (car (car list)))
- (setq list (cdr list))
-;; (goto-char (point-min))
- (if (re-search-forward regexp nil t)
- (setq found (point) list ())))
- (if found
- (message "")
- (signal 'search-failed (list regexp))))
- (if (not found)
- (progn (Info-read-subfile osubfile)
- (goto-char opoint)
- (Info-select-node)
- (set-window-start (selected-window) ostart)))))
+ (search-forward "\n\^_\nIndirect:")
+ (save-restriction
+ (narrow-to-region (point)
+ (progn (search-forward "\n\^_")
+ (1- (point))))
+ (goto-char (point-min))
+ (search-forward (concat "\n" osubfile ": "))
+ (beginning-of-line)
+ (while (not (eobp))
+ (re-search-forward "\\(^.*\\): [0-9]+$")
+ (goto-char (+ (match-end 1) 2))
+ (setq list (cons (cons (read (current-buffer))
+ (match-string-no-properties 1))
+ list))
+ (goto-char (1+ (match-end 0))))
+ (setq list (nreverse list)
+ current (car (car list))
+ list (cdr list))))
+ (while list
+ (message "Searching subfile %s..." (cdr (car list)))
+ (Info-read-subfile (car (car list)))
+ (setq list (cdr list))
+;;; (goto-char (point-min))
+ (if (re-search-forward regexp nil t)
+ (setq found (point) list ())))
+ (if found
+ (message "")
+ (signal 'search-failed (list regexp))))
+ (if (not found)
+ (progn (Info-read-subfile osubfile)
+ (goto-char opoint)
+ (Info-select-node)
+ (set-window-start (selected-window) ostart)))))
(widen)
(goto-char found)
(Info-select-node)
(or (and (string-equal onode Info-current-node)
(equal ofile Info-current-file))
(setq Info-history (cons (list ofile onode opoint)
- Info-history)))))
+ Info-history))))))
\f
;; Extract the value of the node-pointer named NAME.
;; If there is none, use ERRORNAME in the error message;
;; if ERRORNAME is nil, just return nil.
(defun Info-extract-pointer (name &optional errorname)
- (save-excursion
- (goto-char (point-min))
- (forward-line 1)
- (if (re-search-backward (concat name ":") nil t)
- (progn
- (goto-char (match-end 0))
- (Info-following-node-name))
- (if (eq errorname t)
- nil
- (error "Node has no %s" (capitalize (or errorname name)))))))
+ ;; Bind this in case the user sets it to nil.
+ (let ((case-fold-search t))
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line 1)
+ (if (re-search-backward (concat name ":") nil t)
+ (progn
+ (goto-char (match-end 0))
+ (Info-following-node-name))
+ (if (eq errorname t)
+ nil
+ (error "Node has no %s" (capitalize (or errorname name))))))))
;; Return the node name in the buffer following point.
;; ALLOWEDCHARS, if non-nil, goes within [...] to make a regexp
If SAME-FILE is non-nil, do not move to a different Info file."
(interactive)
(let ((node (Info-extract-pointer "up")))
- (and same-file
+ (and (or same-file (not (stringp Info-current-file)))
(string-match "^(" node)
(error "Up node is in another Info file"))
(Info-goto-node node))
(setq Info-history (cdr Info-history))
(goto-char opoint)))
+;;;###autoload
(defun Info-directory ()
"Go to the Info directory node."
(interactive)
NAME may be an abbreviation of the reference name."
(interactive
(let ((completion-ignore-case t)
+ (case-fold-search t)
completions default alt-default (start-point (point)) str i bol eol)
(save-excursion
;; Store end and beginning of line.
(goto-char (point-min))
(while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t)
- (setq str (buffer-substring
+ (setq str (buffer-substring-no-properties
(match-beginning 1)
(1- (point))))
;; See if this one should be the default.
(list (if (equal input "")
default input)))
(error "No cross-references in this node"))))
- (let (target beg i (str (concat "\\*note " (regexp-quote footnotename))))
+
+ (unless footnotename
+ (error "No reference was specified"))
+
+ (let (target beg i (str (concat "\\*note " (regexp-quote footnotename)))
+ (case-fold-search t))
(while (setq i (string-match " " str i))
(setq str (concat (substring str 0 i) "[ \t\n]+" (substring str (1+ i))))
(setq i (+ i 6)))
;; (Info-menu (car list))
;; (setq list (cdr list))))
+(defvar Info-complete-menu-buffer)
+
(defun Info-complete-menu-item (string predicate action)
(let ((case-fold-search t))
(cond ((eq action nil)
(goto-char (point-min))
(search-forward "\n* Menu:")
(while (re-search-forward pattern nil t)
- (setq completions (cons (cons (format "%s"
- (buffer-substring
- (match-beginning 1)
- (match-end 1)))
- (match-beginning 1))
- completions))))
+ (setq completions
+ (cons (cons (match-string-no-properties 1)
+ (match-beginning 1))
+ completions))))
(try-completion string completions predicate)))
((eq action t)
(let (completions
(goto-char (point-min))
(search-forward "\n* Menu:")
(while (re-search-forward pattern nil t)
- (setq completions (cons (cons (format "%s"
- (buffer-substring
- (match-beginning 1)
- (match-end 1)))
- (match-beginning 1))
+ (setq completions (cons (cons
+ (match-string-no-properties 1)
+ (match-beginning 1))
completions))))
(all-completions string completions predicate)))
(t
nil t))))))
-(defun Info-menu (menu-item)
+(defun Info-menu (menu-item &optional fork)
"Go to node for menu item named (or abbreviated) NAME.
Completion is allowed, and the menu item point is on is the default."
(interactive
(save-excursion
(goto-char p)
(end-of-line)
- (re-search-backward "\n\\* +\\([^:\t\n]*\\):" beg t)
- (setq default (format "%s" (buffer-substring
- (match-beginning 1)
- (match-end 1)))))))
+ (if (re-search-backward "\n\\* +\\([^:\t\n]*\\):" beg t)
+ (setq default (match-string-no-properties 1))))))
(let ((item nil))
(while (null item)
(setq item (let ((completion-ignore-case t)
(setq item default)
;; ask again
(setq item nil))))
- (list item))))
+ (list item current-prefix-arg))))
;; there is a problem here in that if several menu items have the same
;; name you can only go to the node of the first with this command.
- (Info-goto-node (Info-extract-menu-item menu-item)))
+ (Info-goto-node (Info-extract-menu-item menu-item) (if fork menu-item)))
(defun Info-extract-menu-item (menu-item)
(setq menu-item (regexp-quote menu-item))
- (save-excursion
- (goto-char (point-min))
- (or (search-forward "\n* menu:" nil t)
- (error "No menu in this node"))
- (or (re-search-forward (concat "\n\\* +" menu-item ":") nil t)
- (re-search-forward (concat "\n\\* +" menu-item) nil t)
- (error "No such item in menu"))
- (beginning-of-line)
- (forward-char 2)
- (Info-extract-menu-node-name)))
+ (let ((case-fold-search t))
+ (save-excursion
+ (goto-char (point-min))
+ (or (search-forward "\n* menu:" nil t)
+ (error "No menu in this node"))
+ (or (re-search-forward (concat "\n\\* +" menu-item ":") nil t)
+ (re-search-forward (concat "\n\\* +" menu-item) nil t)
+ (error "No such item in menu"))
+ (beginning-of-line)
+ (forward-char 2)
+ (Info-extract-menu-node-name))))
;; If COUNT is nil, use the last item in the menu.
(defun Info-extract-menu-counting (count)
- (save-excursion
- (goto-char (point-min))
- (or (search-forward "\n* menu:" nil t)
- (error "No menu in this node"))
- (if count
- (or (search-forward "\n* " nil t count)
- (error "Too few items in menu"))
- (while (search-forward "\n* " nil t)
- nil))
- (Info-extract-menu-node-name)))
+ (let ((case-fold-search t))
+ (save-excursion
+ (goto-char (point-min))
+ (or (search-forward "\n* menu:" nil t)
+ (error "No menu in this node"))
+ (if count
+ (or (search-forward "\n* " nil t count)
+ (error "Too few items in menu"))
+ (while (search-forward "\n* " nil t)
+ nil))
+ (Info-extract-menu-node-name))))
(defun Info-nth-menu-item ()
"Go to the node of the Nth menu item.
(interactive)
(if Info-standalone
(save-buffers-kill-emacs)
- (bury-buffer)))
+ (quit-window)))
(defun Info-next-menu-item ()
(interactive)
- (save-excursion
- (forward-line -1)
- (search-forward "\n* menu:" nil t)
- (or (search-forward "\n* " nil t)
- (error "No more items in menu"))
- (Info-goto-node (Info-extract-menu-node-name))))
+ (let ((node
+ (save-excursion
+ (forward-line -1)
+ (search-forward "\n* menu:" nil t)
+ (and (search-forward "\n* " nil t)
+ (Info-extract-menu-node-name)))))
+ (if node (Info-goto-node node)
+ (error "No more items in menu"))))
(defun Info-last-menu-item ()
(interactive)
"Move cursor to the next cross-reference or menu item in the node."
(interactive)
(let ((pat "\\*note[ \n\t]*\\([^:]*\\):\\|^\\* .*:")
- (old-pt (point)))
+ (old-pt (point))
+ (case-fold-search t))
(or (eobp) (forward-char 1))
(or (re-search-forward pat nil t)
(progn
"Move cursor to the previous cross-reference or menu item in the node."
(interactive)
(let ((pat "\\*note[ \n\t]*\\([^:]*\\):\\|^\\* .*:")
- (old-pt (point)))
+ (old-pt (point))
+ (case-fold-search t))
(or (re-search-backward pat nil t)
(progn
(goto-char (point-max))
(rnode nil)
(pattern (format "\n\\* +\\([^\n:]*%s[^\n:]*\\):[ \t]*\\([^.\n]*\\)\\.[ \t]*\\([0-9]*\\)"
(regexp-quote topic)))
- node)
+ node
+ (case-fold-search t))
(Info-goto-node "Top")
(or (search-forward "\n* menu:" nil t)
(error "No index"))
(goto-char (point-min))
(while (re-search-forward pattern nil t)
(setq matches
- (cons (list (buffer-substring (match-beginning 1)
- (match-end 1))
- (buffer-substring (match-beginning 2)
- (match-end 2))
+ (cons (list (match-string-no-properties 1)
+ (match-string-no-properties 2)
Info-current-node
(string-to-int (concat "0"
- (buffer-substring
- (match-beginning 3)
- (match-end 3)))))
+ (match-string 3))))
matches)))
(and (setq node (Info-extract-pointer "next" t))
(string-match "\\<Index\\>" node)))
(defun Info-find-index-name (name)
"Move point to the place within the current node where NAME is defined."
- (if (or (re-search-forward (format
- "[a-zA-Z]+: %s\\( \\|$\\)"
- (regexp-quote name)) nil t)
- (search-forward (format "`%s'" name) nil t)
- (and (string-match "\\`.*\\( (.*)\\)\\'" name)
- (search-forward
- (format "`%s'" (substring name 0 (match-beginning 1)))
- nil t))
- (search-forward name nil t))
- (beginning-of-line)
- (goto-char (point-min))))
+ (let ((case-fold-search t))
+ (if (or (re-search-forward (format
+ "[a-zA-Z]+: %s\\( \\|$\\)"
+ (regexp-quote name)) nil t)
+ (search-forward (format "`%s'" name) nil t)
+ (and (string-match "\\`.*\\( (.*)\\)\\'" name)
+ (search-forward
+ (format "`%s'" (substring name 0 (match-beginning 1)))
+ nil t))
+ (search-forward name nil t))
+ (beginning-of-line)
+ (goto-char (point-min)))))
(defun Info-undefined ()
"Make command be undefined in Info."
nil: return nil
t: beep
a string: signal an error, using that string."
- (save-excursion
- (goto-char pos)
- ;; First look for a match for START that goes across POS.
- (while (and (not (bobp)) (> (point) (- pos (length start)))
- (not (looking-at start)))
- (forward-char -1))
- ;; If we did not find one, search back for START
- ;; (this finds only matches that end at or before POS).
- (or (looking-at start)
- (progn
- (goto-char pos)
- (re-search-backward start (max (point-min) (- pos 200)) 'yes)))
- (let (found)
- (while (and (re-search-forward all (min (point-max) (+ pos 200)) 'yes)
- (not (setq found (and (<= (match-beginning 0) pos)
- (> (match-end 0) pos))))))
- (if (and found (<= (match-beginning 0) pos)
- (> (match-end 0) pos))
- (buffer-substring (match-beginning 1) (match-end 1))
- (cond ((null errorstring)
- nil)
- ((eq errorstring t)
- (beep)
- nil)
- (t
- (error "No %s around position %d" errorstring pos)))))))
+ (let ((case-fold-search t))
+ (save-excursion
+ (goto-char pos)
+ ;; First look for a match for START that goes across POS.
+ (while (and (not (bobp)) (> (point) (- pos (length start)))
+ (not (looking-at start)))
+ (forward-char -1))
+ ;; If we did not find one, search back for START
+ ;; (this finds only matches that end at or before POS).
+ (or (looking-at start)
+ (progn
+ (goto-char pos)
+ (re-search-backward start (max (point-min) (- pos 200)) 'yes)))
+ (let (found)
+ (while (and (re-search-forward all (min (point-max) (+ pos 200)) 'yes)
+ (not (setq found (and (<= (match-beginning 0) pos)
+ (> (match-end 0) pos))))))
+ (if (and found (<= (match-beginning 0) pos)
+ (> (match-end 0) pos))
+ (match-string-no-properties 1)
+ (cond ((null errorstring)
+ nil)
+ ((eq errorstring t)
+ (beep)
+ nil)
+ (t
+ (error "No %s around position %d" errorstring pos))))))))
(defun Info-mouse-follow-nearest-node (click)
"\\<Info-mode-map>Follow a node reference near point.
(Info-follow-reference node))
((setq node (Info-get-token (point) "\\* +" "\\* +\\([^:]*\\)::"))
(Info-goto-node node))
- ((setq node (Info-get-token (point) "\\* +" "\\* +\\([^:]*\\):"))
- (Info-menu node))
+ ((Info-get-token (point) "\\* +" "\\* +\\([^:]*\\):")
+ (beginning-of-line)
+ (forward-char 2)
+ (setq node (Info-extract-menu-node-name))
+ (Info-goto-node node))
((setq node (Info-get-token (point) "Up: " "Up: \\([^,\n\t]*\\)"))
(Info-goto-node node))
((setq node (Info-get-token (point) "Next: " "Next: \\([^,\n\t]*\\)"))
(define-key Info-mode-map "s" 'Info-search)
;; For consistency with Rmail.
(define-key Info-mode-map "\M-s" 'Info-search)
+ (define-key Info-mode-map "\M-n" 'clone-buffer)
(define-key Info-mode-map "t" 'Info-top-node)
(define-key Info-mode-map "u" 'Info-up)
(define-key Info-mode-map "," 'Info-index-next)
(easy-menu-define Info-mode-menu Info-mode-map
"Menu for info files."
'("Info"
- ["Up" Info-up (Info-check-pointer "up")]
- ["Next" Info-next (Info-check-pointer "next")]
- ["Previous" Info-prev (Info-check-pointer "prev[ious]*")]
+ ["Up" Info-up (Info-check-pointer "up")
+ :help "Go up in the Info tree"]
+ ["Next" Info-next (Info-check-pointer "next")
+ :help "Go to the next node"]
+ ["Previous" Info-prev (Info-check-pointer "prev[ious]*")
+ :help "Go to the previous node"]
+ ["Backward" Info-backward-node t
+ :help "Go backward one node, considering all as a sequence"]
+ ["Forward" Info-forward-node t
+ :help "Go forward one node, considering all as a sequence"]
+ ["Top" Info-top-node t
+ :help "Go to top node of file"]
+ ["Final node" Info-final-node t
+ :help "Go to final node in this file"]
("Menu item" ["You should never see this" report-emacs-bug t])
("Reference" ["You should never see this" report-emacs-bug t])
- ["Search..." Info-search t]
- ["Goto node..." Info-goto-node t]
- ["Last" Info-last Info-history]
+ ["Search..." Info-search t
+ :help "Search for regular expression in this Info file"]
+ ["Goto node..." Info-goto-node t
+ :help "Go to a named node]"]
+ ["Last" Info-last Info-history
+ :help "Go to the last node you were at"]
+ ("Index..."
+ ["Lookup a String" Info-index t
+ :help "Look for a string in the index items"]
+ ["Next Matching Item" Info-index-next t
+ :help "Look for another occurrence of previous item"])
["Exit" Info-exit t]))
(defvar Info-menu-last-node nil)
;; Update reference menu. Code stolen from `Info-follow-reference'.
(let ((items nil)
str i entries current
- (number 0))
+ (number 0)
+ (case-fold-search t))
(save-excursion
(goto-char (point-min))
(while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t)
;; This is for the sake of the invisible text we use handling titles.
(make-local-variable 'line-move-ignore-invisible)
(setq line-move-ignore-invisible t)
+ (add-hook (make-local-hook 'clone-buffer-hook) 'Info-clone-buffer-hook nil t)
(Info-set-mode-line)
(run-hooks 'Info-mode-hook))
+(defun Info-clone-buffer-hook ()
+ (when (bufferp Info-tag-table-buffer)
+ (setq Info-tag-table-buffer
+ (with-current-buffer Info-tag-table-buffer (clone-buffer)))
+ (let ((m Info-tag-table-marker))
+ (when (and (markerp m) (marker-position m))
+ (setq Info-tag-table-marker
+ (with-current-buffer Info-tag-table-buffer
+ (copy-marker (marker-position m))))))))
+
(defvar Info-edit-map nil
"Local keymap used within `e' command of Info.")
(if Info-edit-map
(message "Tags may have changed. Use Info-tagify if necessary")))
\f
(defvar Info-file-list-for-emacs
- '("ediff" "forms" "gnus" "info" ("mh" . "mh-e") "sc")
+ '("ediff" "forms" "gnus" "info" ("mh" . "mh-e") "sc" "message"
+ ("dired" . "dired-x") ("c" . "ccmode") "viper")
"List of Info files that describe Emacs commands.
An element can be a file name, or a list of the form (PREFIX . FILE)
where PREFIX is a name prefix and FILE is the file to look in.
(goto-char (point-max))
(while (re-search-backward cmd-desc nil t)
(setq where (cons (list Info-current-file
- (buffer-substring
- (match-beginning 1)
- (match-end 1))
+ (match-string-no-properties 1)
0)
where)))
where)))
(t
(Info-goto-emacs-command-node command)))))
\f
+(defface Info-title-1-face
+ '((t (:family "helv" :height 240 :weight bold)))
+ "Face for Info titles at level 1."
+ :group 'info)
+
+(defface Info-title-2-face
+ '((t (:family "helv" :height 180 :weight bold)))
+ "Face for Info titles at level 2."
+ :group 'info)
+
+(defface Info-title-3-face
+ '((t (:family "helv" :height 160 :weight bold)))
+ "Face for Info titles at level 3."
+ :group 'info)
+
(defcustom Info-title-face-alist
- '((?* bold underline)
- (?= bold-italic underline)
- (?- italic underline))
+ '((?* (face (variable-pitch bold) display (height (+ 4))))
+ (?= (face (variable-pitch bold) display (height (+ 3))))
+ (?- (face (variable-pitch bold) display (height (+ 2)))))
"*Alist of face or list of faces to use for pseudo-underlined titles.
The alist key is the character the title is underlined with (?*, ?= or ?-)."
:type '(repeat (list character face face))
(defun Info-fontify-node ()
(save-excursion
- (let ((buffer-read-only nil))
+ (let ((buffer-read-only nil)
+ (case-fold-search t))
(goto-char (point-min))
(when (looking-at "^File: [^,: \t]+,?[ \t]+")
(goto-char (match-end 0))
(goto-char (point-min))
(while (re-search-forward "\n\\([^ \t\n].+\\)\n\\(\\*+\\|=+\\|-+\\)$"
nil t)
- (put-text-property (match-beginning 1) (match-end 1)
- 'face
- (cdr (assq (preceding-char) Info-title-face-alist)))
+ (let ((c (preceding-char))
+ face)
+ (cond ((= c ?*) (setq face 'Info-title-1-face))
+ ((= c ?=) (setq face 'Info-title-2-face))
+ (t (setq face 'Info-title-3-face)))
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'face face))
;; This is a serious problem for trying to handle multiple
;; frame types at once. We want this text to be invisible
;; on frames that can display the font above.
;;; Speedbar support:
;; These functions permit speedbar to display the "tags" in the
;; current info node.
+(eval-when-compile (require 'speedbar))
-(eval-when-compile (require 'speedbspec))
+(defvar Info-speedbar-key-map nil
+ "Keymap used when in the info display mode.")
-(defvar Info-last-speedbar-node nil
- "Last node viewed with speedbar in the form '(NODE FILE).")
+(defun Info-install-speedbar-variables ()
+ "Install those variables used by speedbar to enhance Info."
+ (if Info-speedbar-key-map
+ nil
+ (setq Info-speedbar-key-map (speedbar-make-specialized-keymap))
+
+ ;; Basic tree features
+ (define-key Info-speedbar-key-map "e" 'speedbar-edit-line)
+ (define-key Info-speedbar-key-map "\C-m" 'speedbar-edit-line)
+ (define-key Info-speedbar-key-map "+" 'speedbar-expand-line)
+ (define-key Info-speedbar-key-map "-" 'speedbar-contract-line)
+ )
+
+ (speedbar-add-expansion-list '("Info" Info-speedbar-menu-items
+ Info-speedbar-key-map
+ Info-speedbar-hierarchy-buttons)))
(defvar Info-speedbar-menu-items
- '(["Browse Item On Line" speedbar-edit-line t])
+ '(["Browse Node" speedbar-edit-line t]
+ ["Expand Node" speedbar-expand-line
+ (save-excursion (beginning-of-line)
+ (looking-at "[0-9]+: *.\\+. "))]
+ ["Contract Node" speedbar-contract-line
+ (save-excursion (beginning-of-line)
+ (looking-at "[0-9]+: *.-. "))]
+ )
"Additional menu-items to add to speedbar frame.")
+;; Make sure our special speedbar major mode is loaded
+(if (featurep 'speedbar)
+ (Info-install-speedbar-variables)
+ (add-hook 'speedbar-load-hook 'Info-install-speedbar-variables))
+
+;;; Info hierarchy display method
+;;;###autoload
+(defun Info-speedbar-browser ()
+ "Initialize speedbar to display an info node browser.
+This will add a speedbar major display mode."
+ (interactive)
+ (require 'speedbar)
+ ;; Make sure that speedbar is active
+ (speedbar-frame-mode 1)
+ ;; Now, throw us into Info mode on speedbar.
+ (speedbar-change-initial-expansion-list "Info")
+ )
+
+(defun Info-speedbar-hierarchy-buttons (directory depth &optional node)
+ "Display an Info directory hierarchy in speedbar.
+DIRECTORY is the current directory in the attached frame.
+DEPTH is the current indentation depth.
+NODE is an optional argument that is used to represent the
+specific node to expand."
+ (if (and (not node)
+ (save-excursion (goto-char (point-min))
+ (let ((case-fold-search t))
+ (looking-at "Info Nodes:"))))
+ ;; Update our "current node" maybe?
+ nil
+ ;; We cannot use the generic list code, that depends on all leaves
+ ;; being known at creation time.
+ (if (not node)
+ (speedbar-with-writable (insert "Info Nodes:\n")))
+ (let ((completions nil)
+ (cf (selected-frame)))
+ (select-frame speedbar-attached-frame)
+ (save-window-excursion
+ (setq completions
+ (Info-speedbar-fetch-file-nodes (or node '"(dir)top"))))
+ (select-frame cf)
+ (if completions
+ (speedbar-with-writable
+ (while completions
+ (speedbar-make-tag-line 'bracket ?+ 'Info-speedbar-expand-node
+ (cdr (car completions))
+ (car (car completions))
+ 'Info-speedbar-goto-node
+ (cdr (car completions))
+ 'info-xref depth)
+ (setq completions (cdr completions)))
+ t)
+ nil))))
+
+(defun Info-speedbar-goto-node (text node indent)
+ "When user clicks on TEXT, goto an info NODE.
+The INDENT level is ignored."
+ (select-frame speedbar-attached-frame)
+ (let* ((buff (or (get-buffer "*info*")
+ (progn (info) (get-buffer "*info*"))))
+ (bwin (get-buffer-window buff 0)))
+ (if bwin
+ (progn
+ (select-window bwin)
+ (raise-frame (window-frame bwin)))
+ (if speedbar-power-click
+ (let ((pop-up-frames t)) (select-window (display-buffer buff)))
+ (select-frame speedbar-attached-frame)
+ (switch-to-buffer buff)))
+ (let ((junk (string-match "^(\\([^)]+\\))\\([^.]+\\)$" node))
+ (file (match-string 1 node))
+ (node (match-string 2 node)))
+ (Info-find-node file node)
+ ;; If we do a find-node, and we were in info mode, restore
+ ;; the old default method. Once we are in info mode, it makes
+ ;; sense to return to whatever method the user was using before.
+ (if (string= speedbar-initial-expansion-list-name "Info")
+ (speedbar-change-initial-expansion-list
+ speedbar-previously-used-expansion-list-name)))))
+
+(defun Info-speedbar-expand-node (text token indent)
+ "Expand the node the user clicked on.
+TEXT is the text of the button we clicked on, a + or - item.
+TOKEN is data related to this node (NAME . FILE).
+INDENT is the current indentation depth."
+ (cond ((string-match "+" text) ;we have to expand this file
+ (speedbar-change-expand-button-char ?-)
+ (if (speedbar-with-writable
+ (save-excursion
+ (end-of-line) (forward-char 1)
+ (Info-speedbar-hierarchy-buttons nil (1+ indent) token)))
+ (speedbar-change-expand-button-char ?-)
+ (speedbar-change-expand-button-char ??)))
+ ((string-match "-" text) ;we have to contract this node
+ (speedbar-change-expand-button-char ?+)
+ (speedbar-delete-subblock indent))
+ (t (error "Ooops... not sure what to do")))
+ (speedbar-center-buffer-smartly))
+
+(defun Info-speedbar-fetch-file-nodes (nodespec)
+ "Fetch the subnodes from the info NODESPEC.
+NODESPEC is a string of the form: (file)node.
+Optional THISFILE represends the filename of"
+ (save-excursion
+ ;; Set up a buffer we can use to fake-out Info.
+ (set-buffer (get-buffer-create "*info-browse-tmp*"))
+ (if (not (equal major-mode 'Info-mode))
+ (Info-mode))
+ ;; Get the node into this buffer
+ (let ((junk (string-match "^(\\([^)]+\\))\\([^.]+\\)$" nodespec))
+ (file (match-string 1 nodespec))
+ (node (match-string 2 nodespec)))
+ (Info-find-node file node))
+ ;; Scan the created buffer
+ (goto-char (point-min))
+ (let ((completions nil)
+ (case-fold-search t)
+ (thisfile (progn (string-match "^(\\([^)]+\\))" nodespec)
+ (match-string 1 nodespec))))
+ ;; Always skip the first one...
+ (re-search-forward "\n\\* \\([^:\t\n]*\\):" nil t)
+ (while (re-search-forward "\n\\* \\([^:\t\n]*\\):" nil t)
+ (let ((name (match-string 1)))
+ (if (looking-at " *\\(([^)]+)[^.\n]+\\)\\.")
+ (setq name (cons name (match-string 1)))
+ (if (looking-at " *\\(([^)]+)\\)\\.")
+ (setq name (cons name (concat (match-string 1) "Top")))
+ (if (looking-at " \\([^.]+\\).")
+ (setq name
+ (cons name (concat "(" thisfile ")" (match-string 1))))
+ (setq name (cons name (concat "(" thisfile ")" name))))))
+ (setq completions (cons name completions))))
+ (nreverse completions))))
+
+;;; Info mode node listing
(defun Info-speedbar-buttons (buffer)
"Create a speedbar display to help navigation in an Info file.
BUFFER is the buffer speedbar is requesting buttons for."
- (goto-char (point-min))
- (if (and (looking-at "<Directory>")
- (save-excursion
- (set-buffer buffer)
- (and (equal (car Info-last-speedbar-node) Info-current-node)
- (equal (cdr Info-last-speedbar-node) Info-current-file))))
- nil
- (erase-buffer)
- (speedbar-insert-button "<Directory>" 'info-xref 'highlight
- 'Info-speedbar-button
- 'Info-directory)
- (speedbar-insert-button "<Top>" 'info-xref 'highlight
- 'Info-speedbar-button
- 'Info-top-node)
- (speedbar-insert-button "<Last>" 'info-xref 'highlight
- 'Info-speedbar-button
- 'Info-last)
- (speedbar-insert-button "<Up>" 'info-xref 'highlight
- 'Info-speedbar-button
- 'Info-up)
- (speedbar-insert-button "<Next>" 'info-xref 'highlight
- 'Info-speedbar-button
- 'Info-next)
- (speedbar-insert-button "<Prev>" 'info-xref 'highlight
- 'Info-speedbar-button
- 'Info-prev)
- (let ((completions nil))
- (save-excursion
- (set-buffer buffer)
- (setq Info-last-speedbar-node
- (cons Info-current-node Info-current-file))
- (goto-char (point-min))
- ;; Always skip the first one...
- (re-search-forward "\n\\* +\\([^:\t\n]*\\):" nil t)
- (while (re-search-forward "\n\\* +\\([^:\t\n]*\\):" nil t)
- (setq completions (cons (buffer-substring (match-beginning 1)
- (match-end 1))
- completions))))
- (setq completions (nreverse completions))
- (while completions
- (speedbar-make-tag-line nil nil nil nil
- (car completions) 'Info-speedbar-menu
- nil 'info-node 0)
- (setq completions (cdr completions))))))
-
-(defun Info-speedbar-button (text token indent)
- "Called when user clicks <Directory> from speedbar.
-TEXT, TOKEN, and INDENT are unused."
- (speedbar-with-attached-buffer
- (funcall token)
- (setq Info-last-speedbar-node nil)
- (speedbar-update-contents)))
-
-(defun Info-speedbar-menu (text token indent)
- "Goto the menu node specified in TEXT.
-TOKEN and INDENT are not used."
- (speedbar-with-attached-buffer
- (Info-menu text)
- (setq Info-last-speedbar-node nil)
- (speedbar-update-contents)))
+ (if (save-excursion (goto-char (point-min))
+ (let ((case-fold-search t))
+ (not (looking-at "Info Nodes:"))))
+ (erase-buffer))
+ (Info-speedbar-hierarchy-buttons nil 0)
+ )
+
+(dolist (mess '("^Node has no Previous$"
+ "^No menu in this node$"
+ "^Node has no Next$"
+ "^No \".*\" in index$"))
+ (add-to-list 'debug-ignored-errors mess))
(provide 'info)
HCoop / bpt / emacs.git / blobdiff