X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/5186b4bdfdd295c865a2efab3fc0e51ff5892968..9c0c2af5a157eca18c86f644121f7eac5488dbda:/lisp/info.el diff --git a/lisp/info.el b/lisp/info.el index 9ab060e7db..47af5bb815 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1,6 +1,7 @@ ;;; info.el --- info package for Emacs -;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002 +;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, +;; 2002, 2003 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -26,6 +27,12 @@ ;;; Commentary: ;; Note that nowadays we expect info files to be made using makeinfo. +;; In particular we make these assumptions: +;; - a menu item MAY contain colons but not colon-space ": " +;; - a menu item ending with ": " (but not ":: ") is an index entry +;; - a node name MAY NOT contain a colon +;; This distinction is to support indexing of computer programming +;; language terms that may contain ":" but not ": ". ;;; Code: @@ -65,7 +72,7 @@ The Lisp code is executed when the node is selected.") (defface info-menu-5 '((((class color)) (:foreground "red1")) (t (:underline t))) - "Face for the fifth and nineth `*' in an Info menu." + "Face for every third `*' in an Info menu." :group 'info) (defface info-xref @@ -76,12 +83,12 @@ The Lisp code is executed when the node is selected.") :group 'info) (defcustom Info-fontify-maximum-menu-size 100000 - "*Maximum size of menu to fontify if `Info-fontify' is non-nil." + "*Maximum size of menu to fontify if `font-lock-mode' is non-nil." :type 'integer :group 'info) (defcustom Info-use-header-line t - "*Non-nil means to put the beginning-of-node links in an emacs header-line. + "*Non-nil means to put the beginning-of-node links in an Emacs header-line. A header-line does not scroll with the rest of the buffer." :type 'boolean :group 'info) @@ -98,9 +105,10 @@ A header-line does not scroll with the rest of the buffer." (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 +If nil, meaning not yet initialized, Info uses the environment variable INFOPATH to initialize it, or `Info-default-directory-list' -if there is no INFOPATH variable in the environment. +if there is no INFOPATH variable in the environment, or the +concatenation of the two if INFOPATH ends with a colon. When `Info-directory-list' is initialized from the value of `Info-default-directory-list', and Emacs is installed in one of the @@ -127,12 +135,11 @@ a version of Emacs without installing it.") (defcustom Info-additional-directory-list nil "List of additional directories to search for Info documentation files. -These directories are searched after those in `Info-directory-list', and -they are not searched for merging the `dir' file." +These directories are searched after those in `Info-directory-list'." :type '(repeat directory) :group 'info) -(defcustom Info-scroll-prefer-subnodes t +(defcustom Info-scroll-prefer-subnodes nil "*If non-nil, \\\\[Info-scroll-up] in a menu visits subnodes. If this is non-nil, and you scroll far enough in a node that its menu appears on the screen, the next \\\\[Info-scroll-up] @@ -142,10 +149,32 @@ that you visit a subnode before getting to the end of the menu. Setting this option to nil results in behavior similar to the stand-alone Info reader program, which visits the first subnode from the menu only when you hit the end of the current node." + :version "21.4" :type 'boolean :group 'info) -(defcustom Info-mode-hook '(turn-on-font-lock) +(defcustom Info-hide-note-references t + "*If non-nil, hide the tag and section reference in *note and * menu items. +Also replaces the \"*note\" text with \"see\". +If value is non-nil but not t, the reference section is still shown." + :version "21.4" + :type '(choice (const :tag "No reformatting" nil) + (const :tag "Replace tag and hide reference" t) + (other :tag "Replace only tag" tag)) + :group 'info) + +(defcustom Info-refill-paragraphs nil + "*If non-nil, attempt to refill paragraphs with hidden references. +This refilling may accidentally remove explicit line breaks in the info +file, so be prepared for a few surprises if you enable this feature." + :version "21.4" + :type 'boolean + :group 'info) + +(defcustom Info-mode-hook + ;; Try to obey obsolete Info-fontify settings. + (unless (and (boundp 'Info-fontify) (null Info-fontify)) + '(turn-on-font-lock)) "Hooks run when `info-mode' is called." :type 'hook :group 'info) @@ -265,8 +294,9 @@ be last in the list.") "Insert the contents of an info file in the current buffer. Do the right thing if the file has been compressed or zipped." (let* ((tail Info-suffix-list) - (lfn (or (not (fboundp 'msdos-long-file-names)) - (msdos-long-file-names))) + (lfn (if (fboundp 'msdos-long-file-names) + (msdos-long-file-names) + t)) (check-short (and (fboundp 'msdos-long-file-names) lfn)) fullname decoder done) @@ -319,51 +349,59 @@ Do the right thing if the file has been compressed or zipped." (car decoder) t t nil (cdr decoder)))) (insert-file-contents fullname visit)))) +(defun Info-default-dirs () + (let ((source (expand-file-name "info/" source-directory)) + (sibling (if installation-directory + (expand-file-name "info/" installation-directory) + (if invocation-directory + (let ((infodir (expand-file-name + "../info/" + invocation-directory))) + (if (file-exists-p infodir) + infodir + (setq infodir (expand-file-name + "../../../info/" + invocation-directory)) + (and (file-exists-p infodir) + infodir)))))) + alternative) + (setq alternative + (if (and sibling (file-exists-p sibling)) + ;; Uninstalled, Emacs builddir != srcdir. + sibling + ;; Uninstalled, builddir == srcdir + 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))))))) + (defun info-initialize () "Initialize `Info-directory-list', if that hasn't been done yet." (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) - (if invocation-directory - (let ((infodir (expand-file-name - "../info/" - invocation-directory))) - (if (file-exists-p infodir) - infodir - (setq infodir (expand-file-name - "../../../info/" - invocation-directory)) - (and (file-exists-p infodir) - infodir)))))) - alternative) + (let ((path (getenv "INFOPATH"))) (setq Info-directory-list (prune-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))))))))))) + (if (string-match ":\\'" path) + (append (split-string (substring path 0 -1) + (regexp-quote path-separator)) + (Info-default-dirs)) + (split-string path (regexp-quote path-separator))) + (Info-default-dirs))))))) ;;;###autoload (defun info-other-window (&optional file) @@ -405,6 +443,12 @@ in all the directories in that path." (pop-to-buffer "*info*") (Info-directory)))) +;;;###autoload +(defun info-emacs-manual () + "Display the Emacs manual in Info mode." + (interactive) + (info "emacs")) + ;;;###autoload (defun info-standalone () "Run Emacs as a standalone Info reader. @@ -474,8 +518,9 @@ it says do not attempt further (recursive) error recovery." (expand-file-name (downcase filename) (car dirs))) ;; Try several variants of specified name. (let ((suffix-list Info-suffix-list) - (lfn (or (not (fboundp 'msdos-long-file-names)) - (msdos-long-file-names)))) + (lfn (if (fboundp 'msdos-long-file-names) + (msdos-long-file-names) + t))) (while (and suffix-list (not found)) (cond ((info-file-exists-p (info-insert-file-contents-1 @@ -519,6 +564,40 @@ else defaults to \"Top\"." (set (make-local-variable 'Info-current-file) t) (Info-find-node-2 nil nodename)) +;; It's perhaps a bit nasty to kill the *info* buffer to force a re-read, +;; but at least it keeps this routine (which is only for the benefit of +;; makeinfo-buffer) out of the way of normal operations. +;; +(defun Info-revert-find-node (filename nodename) + "Go to an info node FILENAME and NODENAME, re-reading disk contents. +When *info* is already displaying FILENAME and NODENAME, the window position +is preserved, if possible." + (pop-to-buffer "*info*") + (let ((old-filename Info-current-file) + (old-nodename Info-current-node) + (pcolumn (current-column)) + (pline (count-lines (point-min) (line-beginning-position))) + (wline (count-lines (point-min) (window-start))) + (old-history Info-history) + (new-history (and Info-current-file + (list Info-current-file Info-current-node (point))))) + (kill-buffer (current-buffer)) + (Info-find-node filename nodename) + (setq Info-history old-history) + (if (and (equal old-filename Info-current-file) + (equal old-nodename Info-current-node)) + (progn + ;; note goto-line is no good, we want to measure from point-min + (beginning-of-buffer) + (forward-line wline) + (set-window-start (selected-window) (point)) + (beginning-of-buffer) + (forward-line pline) + (move-to-column pcolumn)) + ;; only add to the history when coming from a different file+node + (if new-history + (setq Info-history (cons new-history Info-history)))))) + (defun Info-find-in-tag-table-1 (marker regexp case-fold) "Find a node in a tag table. MARKER specifies the buffer and position to start searching at. @@ -529,12 +608,11 @@ If a match was found, value is a list (FOUND-ANCHOR POS MODE), where FOUND-ANCHOR is non-nil if a `Ref:' was matched, POS is the position where the match was found, and MODE is `major-mode' of the buffer in which the match was found." - (let ((case-fold-search case-fold) - found-mode guesspos found-anchor) + (let ((case-fold-search case-fold)) (save-excursion (set-buffer (marker-buffer marker)) (goto-char marker) - + ;; Search tag table (beginning-of-line) (when (re-search-forward regexp nil t) @@ -578,7 +656,7 @@ Value is the position at which a match was found, or nil if not found." (beginning-of-line) (setq found (point))))) found))) - + (defun Info-find-node-in-buffer (regexp) "Find a node or anchor in the current buffer. REGEXP is a regular expression matching nodes or references. Its first @@ -588,7 +666,7 @@ This function looks for a case-sensitive match first. If none is found, a case-insensitive match is tried." (or (Info-find-node-in-buffer-1 regexp nil) (Info-find-node-in-buffer-1 regexp t))) - + (defun Info-find-node-2 (filename nodename &optional no-going-back) (buffer-disable-undo (current-buffer)) (or (eq major-mode 'Info-mode) @@ -667,20 +745,19 @@ a case-insensitive match is tried." (if (stringp nodename) (regexp-quote nodename) "") - "\\) *[,\t\n\177]")) - (nodepos nil)) + "\\) *[,\t\n\177]"))) (catch 'foo - + ;; First, search a tag table, if any (when (marker-position Info-tag-table-marker) (let* ((m Info-tag-table-marker) (found (Info-find-in-tag-table m regexp))) - + (when found ;; FOUND is (ANCHOR POS MODE). (setq guesspos (nth 1 found)) - + ;; If this is an indirect file, determine which ;; file really holds this node and read it in. (unless (eq (nth 2 found) 'Info-mode) @@ -697,7 +774,7 @@ a case-insensitive match is tried." ;; Else we may have a node, which we search for: (goto-char (max (point-min) (- (byte-to-position 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 @@ -756,17 +833,16 @@ a case-insensitive match is tried." (insert Info-dir-contents) (goto-char (point-min))) (let ((dirs (if Info-additional-directory-list - (append Info-directory-list - Info-additional-directory-list) - Info-directory-list)) + (append Info-directory-list + Info-additional-directory-list) + Info-directory-list)) + (dir-file-attrs nil) ;; 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) - ;; Search the directory list for the directory file. (while dirs (let ((truename (file-truename (expand-file-name (car dirs))))) @@ -797,19 +873,19 @@ a case-insensitive match is tried." (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))) + (set (make-local-variable 'Info-dir-file-name) + file) + (push (current-buffer) buffers) + (push (cons file attrs) dir-file-attrs)) (error (kill-buffer (current-buffer)))))))) - (or (cdr dirs) (setq Info-dir-contents-directory - (file-name-as-directory (car dirs)))) + (unless (cdr dirs) + (set (make-local-variable 'Info-dir-contents-directory) + (file-name-as-directory (car dirs)))) (setq dirs (cdr dirs)))) (or buffers (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. ;; The definition of `Info-directory-list' puts it first on that @@ -823,48 +899,36 @@ a case-insensitive match is tried." (insert-buffer buffer) ;; Look at each of the other buffers one by one. - (while others - (let ((other (car others)) - ;; Bind this in case the user sets it to nil. - (case-fold-search t) - this-buffer-nodes) + (dolist (other others) + (let (this-buffer-nodes) ;; In each, find all the menus. - (save-excursion - (set-buffer other) + (with-current-buffer other (goto-char (point-min)) ;; Find each menu, and add an elt to NODES for it. (while (re-search-forward "^\\* Menu:" nil t) - (let (beg nodename end) - (forward-line 1) - (while (and (eolp) (not (eobp))) - (forward-line 1)) - (setq beg (point)) - (or (search-backward "\n\^_" nil 'move) - (looking-at "\^_") - (signal 'search-failed (list "\n\^_"))) + (while (and (zerop (forward-line 1)) (eolp))) + (let ((beg (point)) + nodename end) + (re-search-backward "^\^_") (search-forward "Node: ") - (setq nodename (Info-following-node-name)) + (setq nodename + (and (looking-at (Info-following-node-name-re)) + (match-string 1))) (search-forward "\n\^_" nil 'move) (beginning-of-line) (setq end (point)) - (setq this-buffer-nodes - (cons (list nodename other beg end) - this-buffer-nodes)))) + (push (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))) + (message "No `top' node in %s" Info-dir-file-name))))) ;; Add to the main menu a menu item for each other node. - (let ((case-fold-search t) - (re-search-forward "^\\* Menu:"))) + (re-search-forward "^\\* Menu:") (forward-line 1) (let ((menu-items '("top")) - (nodes nodes) - (case-fold-search t) (end (save-excursion (search-forward "\^_" nil t) (point)))) - (while nodes - (let ((nodename (car (car nodes)))) + (dolist (node nodes) + (let ((nodename (car node))) (save-excursion (or (member (downcase nodename) menu-items) (re-search-forward (concat "^\\* +" @@ -873,13 +937,12 @@ a case-insensitive match is tried." end t) (progn (insert "* " nodename "::" "\n") - (setq menu-items (cons nodename menu-items)))))) - (setq nodes (cdr nodes)))) + (push nodename menu-items))))))) ;; Now take each node of each of the other buffers ;; and merge it into the main buffer. - (while nodes + (dolist (node nodes) (let ((case-fold-search t) - (nodename (car (car nodes)))) + (nodename (car node))) (goto-char (point-min)) ;; Find the like-named node in the main buffer. (if (re-search-forward (concat "^\^_.*\n.*Node: " @@ -895,19 +958,82 @@ a case-insensitive match is tried." (insert "\^_\nFile: dir\tNode: " nodename "\n\n* Menu:\n\n")) ;; Merge the text from the other buffer's menu ;; into the menu in the like-named node in the main buffer. - (apply 'insert-buffer-substring (cdr (car nodes)))) - (setq nodes (cdr nodes))) + (apply 'insert-buffer-substring (cdr node)))) + (Info-dir-remove-duplicates) ;; Kill all the buffers we just made. - (while buffers - (kill-buffer (car buffers)) - (setq buffers (cdr buffers))) + (mapc 'kill-buffer buffers) (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))) + (message "Composing main Info directory...done")) + (set (make-local-variable 'Info-dir-contents) (buffer-string)) + (set (make-local-variable 'Info-dir-file-attributes) dir-file-attrs))) (setq default-directory Info-dir-contents-directory)) +(defvar Info-streamline-headings + '(("Emacs" . "Emacs") + ("Programming" . "Programming") + ("Libraries" . "Libraries") + ("World Wide Web\\|Net Utilities" . "Net Utilities")) + "List of elements (RE . NAME) to merge headings matching RE to NAME.") + +(defun Info-dir-remove-duplicates () + (let (limit) + (goto-char (point-min)) + ;; Remove duplicate headings in the same menu. + (while (search-forward "\n* Menu:" nil t) + (setq limit (save-excursion (search-forward "\n" nil t))) + ;; Look for the next heading to unify. + (while (re-search-forward "^\\(\\w.*\\)\n\\*" limit t) + (let ((name (match-string 1)) + (start (match-beginning 0)) + (entries nil) re) + ;; Check whether this heading should be streamlined. + (save-match-data + (dolist (x Info-streamline-headings) + (when (string-match (car x) name) + (setq name (cdr x)) + (setq re (car x))))) + (if re (replace-match name t t nil 1)) + (goto-char (if (re-search-forward "^[^* \n\t]" limit t) + (match-beginning 0) + (or limit (point-max)))) + ;; Look for other headings of the same category and merge them. + (save-excursion + (while (re-search-forward "^\\(\\w.*\\)\n\\*" limit t) + (when (if re (save-match-data (string-match re (match-string 1))) + (equal name (match-string 1))) + (forward-line 0) + ;; Delete redundant heading. + (delete-region (match-beginning 0) (point)) + ;; Push the entries onto `text'. + (push + (delete-and-extract-region + (point) + (if (re-search-forward "^[^* \n\t]" nil t) + (match-beginning 0) + (or limit (point-max)))) entries)))) + ;; Insert the entries just found. + (while (= (line-beginning-position 0) (1- (point))) + (backward-char)) + (dolist (entry (nreverse entries)) + (insert entry) + (while (= (line-beginning-position 0) (1- (point))) + (delete-region (1- (point)) (point)))) + + ;; Now remove duplicate entries under the same heading. + (let ((seen nil) + (limit (point))) + (goto-char start) + (while (re-search-forward "^* \\([^:\n]+:\\(:\\|[^.\n]+\\).\\)" + limit 'move) + (let ((x (match-string 1))) + (if (member-ignore-case x seen) + (delete-region (match-beginning 0) + (progn (re-search-forward "^[^ \t]" nil t) + (match-beginning 0))) + (push x seen)))))))))) + ;; Note that on entry to this function the current-buffer must be the ;; *info* buffer; not the info tags buffer. (defun Info-read-subfile (nodepos) @@ -959,13 +1085,64 @@ a case-insensitive match is tried." (if (numberp nodepos) (+ (- nodepos lastfilepos) (point))))) -(defvar Info-header-line nil - "If the info node header is hidden, the text of the header.") -(put 'Info-header-line 'risky-local-variable t) +(defun Info-unescape-quotes (value) + "Unescape double quotes and backslashes in VALUE" + (let ((start 0) + (unquote value)) + (while (string-match "[^\\\"]*\\(\\\\\\)[\\\\\"]" unquote start) + (setq unquote (replace-match "" t t unquote 1)) + (setq start (- (match-end 0) 1))) + unquote)) + +;; As of Texinfo 4.6, makeinfo writes constructs like +;; \0\h[image param=value ...\h\0] +;; into the Info file for handling images. +(defun Info-split-parameter-string (parameter-string) + "Return alist of (\"KEY\" . \"VALUE\") from PARAMETER-STRING; a + whitespace separated list of KEY=VALUE pairs. If VALUE + contains whitespace or double quotes, it must be quoted in + double quotes and any double quotes or backslashes must be + escaped (\\\",\\\\)." + (let ((start 0) + (parameter-alist)) + (while (string-match + "\\s *\\([^=]+\\)=\\(?:\\([^\\s \"]+\\)\\|\\(?:\"\\(\\(?:[^\\\"]\\|\\\\[\\\\\"]\\)*\\)\"\\)\\)" + parameter-string start) + (setq start (match-end 0)) + (push (cons (match-string 1 parameter-string) + (or (match-string 2 parameter-string) + (Info-unescape-quotes + (match-string 3 parameter-string)))) + parameter-alist)) + parameter-alist)) + +(defun Info-display-images-node () + "Display images in current node." + (save-excursion + (let ((inhibit-read-only t) + (case-fold-search t)) + (goto-char (point-min)) + (while (re-search-forward + "\\(\0\b[[]image\\(\\(?:[^\b]\\|[^\0]+\b\\)*\\)\0\b[]]\\)" + nil t) + (let* ((start (match-beginning 1)) + (parameter-alist (Info-split-parameter-string (match-string 2))) + (src (cdr (assoc-string "src" parameter-alist))) + (image-file (if src (if (file-name-absolute-p src) src + (concat default-directory src)) + "")) + (image (if (file-exists-p image-file) + (create-image image-file) + "[broken image]"))) + (message "Found image: %S" image-file) + (if (not (get-text-property start 'display)) + (add-text-properties + start (point) `(display ,image rear-nonsticky (display))))))) + (set-buffer-modified-p nil))) (defun Info-select-node () -"Select the info node that point is in. -Bind this in case the user sets it to nil." + "Select the info node that point is in." + ;; Bind this in case the user sets it to nil. (let ((case-fold-search t)) (save-excursion ;; Find beginning of node. @@ -998,10 +1175,7 @@ Bind this in case the user sets it to nil." (point-max))) (if Info-enable-active-nodes (eval active-expression)) (Info-fontify-node) - (if Info-use-header-line - (Info-setup-header-line) - (setq Info-header-line nil) - (setq header-line-format nil)) ; so the header line isn't displayed + (Info-display-images-node) (run-hooks 'Info-selection-hook))))) (defun Info-set-mode-line () @@ -1016,29 +1190,6 @@ Bind this in case the user sets it to nil." ") " (or Info-current-node "")))))) -;; Skip the node header and make it into a header-line. This function -;; should be called when the node is already narrowed. -(defun Info-setup-header-line () - (goto-char (point-min)) - (let* ((case-fold-search t) - (header-end (save-excursion (forward-line 1) (1- (point)))) - ;; If we find neither Next: nor Prev: link, show the entire - ;; node header. Otherwise, don't show the File: and Node: - ;; parts, to avoid wasting precious space on information that - ;; is available in the mode line. - (header-beg (if (re-search-forward - "\\(next\\|prev[ious]*\\): " - header-end t) - (match-beginning 1) - (point)))) - (set (make-local-variable 'Info-header-line) - (buffer-substring header-beg header-end)) - (setq header-line-format 'Info-header-line) -;;; It is useful to be able to copy the links line out of the buffer -;;; with M-w. -;;; (narrow-to-region (1+ header-end) (point-max)) - )) - ;; Go to an info node specified with a filename-and-nodename string ;; of the sort that is found in pointers in nodes. @@ -1061,8 +1212,8 @@ If FORK is a string, it is the name to use for the new buffer." nodename) (setq filename (if (= (match-beginning 1) (match-end 1)) "" - (substring nodename (match-beginning 2) (match-end 2))) - nodename (substring nodename (match-beginning 3) (match-end 3))) + (match-string 2 nodename)) + nodename (match-string 3 nodename)) (let ((trim (string-match "\\s *\\'" filename))) (if trim (setq filename (substring filename 0 trim)))) (let ((trim (string-match "\\s *\\'" nodename))) @@ -1177,7 +1328,7 @@ If FORK is a string, it is the name to use for the new buffer." (when (equal regexp "") (setq regexp (car Info-search-history))) (when regexp - (let ((found ()) current + (let (found beg-found give-up (onode Info-current-node) (ofile Info-current-file) (opoint (point)) @@ -1186,49 +1337,70 @@ If FORK is a string, it is the name to use for the new buffer." (save-excursion (save-restriction (widen) + (while (and (not give-up) + (or (null found) + (isearch-range-invisible beg-found found))) + (if (re-search-forward regexp nil t) + (setq found (point) beg-found (match-beginning 0)) + (setq give-up t))))) + ;; If no subfiles, give error now. + (if give-up (if (null Info-current-subfile) - (progn (re-search-forward regexp) (setq found (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)) + (re-search-forward regexp) + (setq found nil))) + + (unless found + (unwind-protect + ;; Try other subfiles. + (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)))) (goto-char (point-min)) - (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)) + ;; Find the subfile we just searched. + (search-forward (concat "\n" osubfile ": ")) + ;; Skip that one. + (forward-line 1) + ;; Make a list of all following subfiles. + ;; Each elt has the form (VIRT-POSITION . SUBFILENAME). + (while (not (eobp)) + (re-search-forward "\\(^.*\\): [0-9]+$") + (goto-char (+ (match-end 1) 2)) + (setq list (cons (cons (+ (point-min) + (read (current-buffer))) + (match-string-no-properties 1)) + list)) + (goto-char (1+ (match-end 0)))) + ;; Put in forward order + (setq list (nreverse list)))) + (while list + (message "Searching subfile %s..." (cdr (car list))) + (Info-read-subfile (car (car list))) + (setq list (cdr list)) + (setq give-up nil found nil) + (while (and (not give-up) + (or (null found) + (isearch-range-invisible beg-found found))) (if (re-search-forward regexp nil t) - (setq found (point) list ()))) + (setq found (point) beg-found (match-beginning 0)) + (setq give-up t))) + (if give-up + (setq found nil)) (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))))) + (setq list nil))) + (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) @@ -1241,39 +1413,38 @@ If FORK is a string, it is the name to use for the new buffer." (defun Info-extract-pointer (name &optional errorname) "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. -Bind this in case the user sets it to nil." +if ERRORNAME is nil, just return nil." + ;; Bind this in case the user sets it to nil. (let ((case-fold-search t)) (save-excursion - (save-restriction - (goto-char (point-min)) -;;; (when Info-header-line -;;; ;; expose the header line in the buffer -;;; (widen) -;;; (forward-line -1)) - (let ((bound (point))) - (forward-line 1) - (cond ((re-search-backward (concat name ":") bound t) - (goto-char (match-end 0)) - (Info-following-node-name)) - ((not (eq errorname t)) - (error "Node has no %s" - (capitalize (or errorname name)))))))))) - -(defun Info-following-node-name (&optional allowedchars) - "Return the node name in the buffer following point. + (goto-char (point-min)) + (let ((bound (point))) + (forward-line 1) + (cond ((re-search-backward + (concat name ":" (Info-following-node-name-re)) bound t) + (match-string 1)) + ((not (eq errorname t)) + (error "Node has no %s" + (capitalize (or errorname name))))))))) + +(defun Info-following-node-name-re (&optional allowedchars) + "Return a regexp matching a node name. ALLOWEDCHARS, if non-nil, goes within [...] to make a regexp -saying which chars may appear in the node name." - (skip-chars-forward " \t") - (buffer-substring-no-properties - (point) - (progn - (while (looking-at (concat "[" (or allowedchars "^,\t\n") "]")) - (skip-chars-forward (concat (or allowedchars "^,\t\n") "(")) - (if (looking-at "(") - (skip-chars-forward "^)"))) - (skip-chars-backward " ") - (point)))) +saying which chars may appear in the node name. +Submatch 1 is the complete node name. +Submatch 2 if non-nil is the parenthesized file name part of the node name. +Submatch 3 is the local part of the node name. +End of submatch 0, 1, and 3 are the same, so you can safely concat." + (concat "[ \t]*" ;Skip leading space. + "\\(\\(([^)]+)\\)?" ;Node name can start with a file name. + "\\([" (or allowedchars "^,\t\n") "]*" ;Any number of allowed chars. + "[" (or allowedchars "^,\t\n") " ]" ;The last char can't be a space. + "\\|\\)\\)")) ;Allow empty node names. + +;;; For compatibility; other files have used this name. +(defun Info-following-node-name () + (and (looking-at (Info-following-node-name-re)) + (match-string 1))) (defun Info-next () "Go to the next node of this node." @@ -1332,9 +1503,7 @@ FOOTNOTENAME may be an abbreviation of the reference name." (goto-char (point-min)) (while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t) - (setq str (buffer-substring-no-properties - (match-beginning 1) - (1- (point)))) + (setq str (match-string-no-properties 1)) ;; See if this one should be the default. (and (null default) (<= (match-beginning 0) start-point) @@ -1354,23 +1523,14 @@ FOOTNOTENAME may be an abbreviation of the reference name." (if (eq default t) (setq default str)) (if (eq alt-default t) (setq alt-default str)) ;; Don't add this string if it's a duplicate. - ;; We use a loop instead of "(assoc str completions)" because - ;; we want to do a case-insensitive compare. - (let ((tail completions) - (tem (downcase str))) - (while (and tail - (not (string-equal tem (downcase (car (car tail)))))) - (setq tail (cdr tail))) - (or tail - (setq completions - (cons (cons str nil) - completions)))))) + (or (assoc-string str completions t) + (push str completions)))) ;; If no good default was found, try an alternate. (or default (setq default alt-default)) ;; If only one cross-reference found, then make it default. (if (eq (length completions) 1) - (setq default (car (car completions)))) + (setq default (car completions))) (if completions (let ((input (completing-read (if default (concat @@ -1385,7 +1545,7 @@ FOOTNOTENAME may be an abbreviation of the reference name." (unless footnotename (error "No reference was specified")) - (let (target beg i (str (concat "\\*note " (regexp-quote footnotename))) + (let (target 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)))) @@ -1396,25 +1556,30 @@ FOOTNOTENAME may be an abbreviation of the reference name." (error "No cross-reference named %s" footnotename)) (goto-char (+ (match-beginning 0) 5)) (setq target - (Info-extract-menu-node-name "Bad format cross reference" t))) + (Info-extract-menu-node-name t))) (while (setq i (string-match "[ \t\n]+" target i)) (setq target (concat (substring target 0 i) " " (substring target (match-end 0)))) (setq i (+ i 1))) (Info-goto-node target))) -(defun Info-extract-menu-node-name (&optional errmessage multi-line) +(defconst Info-menu-entry-name-re "\\(?:[^:]\\|:[^:,.;() \t\n]\\)*" + ;; We allow newline because this is also used in Info-follow-reference, + ;; where the xref name might be wrapped over two lines. + "Regexp that matches a menu entry name upto but not including the colon. +Because of ambiguities, this should be concatenated with something like +`:' and `Info-following-node-name-re'.") + +(defun Info-extract-menu-node-name (&optional multi-line) (skip-chars-forward " \t\n") - (let ((beg (point)) - str i) - (skip-chars-forward "^:") - (forward-char 1) - (setq str - (if (looking-at ":") - (buffer-substring-no-properties beg (1- (point))) - (skip-chars-forward " \t\n") - (Info-following-node-name (if multi-line "^.,\t" "^.,\t\n")))) - (replace-regexp-in-string "[ \n]+" " " str))) + (when (looking-at (concat Info-menu-entry-name-re ":\\(:\\|" + (Info-following-node-name-re + (if multi-line "^.,\t" "^.,\t\n")) "\\)")) + (replace-regexp-in-string + "[ \n]+" " " + (or (match-string 2) + ;; If the node name is the menu entry name (using `entry::'). + (buffer-substring (match-beginning 0) (1- (match-beginning 1))))))) ;; No one calls this. ;;(defun Info-menu-item-sequence (list) @@ -1426,6 +1591,10 @@ FOOTNOTENAME may be an abbreviation of the reference name." (defvar Info-complete-next-re nil) (defvar Info-complete-cache nil) +(defconst Info-node-spec-re + (concat (Info-following-node-name-re "^.,:") "[,:.]") + "Regexp to match the text after a : until the terminating `.'.") + (defun Info-complete-menu-item (string predicate action) ;; This uses two dynamically bound variables: ;; - `Info-complete-menu-buffer' which contains the buffer in which @@ -1434,6 +1603,9 @@ FOOTNOTENAME may be an abbreviation of the reference name." ;; also look for menu items in subsequent nodes as long as those ;; nodes' names match `Info-complete-next-re'. This feature is currently ;; only used for completion in Info-index. + + ;; Note that `Info-complete-menu-buffer' could be current already, + ;; so we want to save point. (save-excursion (set-buffer Info-complete-menu-buffer) (let ((completion-ignore-case t) @@ -1447,7 +1619,7 @@ FOOTNOTENAME may be an abbreviation of the reference name." (concat "\n\\* +" (regexp-quote string) ":") nil t) (let ((pattern (concat "\n\\* +\\(" (regexp-quote string) - "[^:\t\n]*\\):")) + Info-menu-entry-name-re "\\):" Info-node-spec-re)) completions) ;; Check the cache. (if (and (equal (nth 0 Info-complete-cache) Info-current-file) @@ -1473,9 +1645,9 @@ FOOTNOTENAME may be an abbreviation of the reference name." (unless (equal Info-current-node orignode) (Info-goto-node orignode)) ;; Update the cache. - (setq Info-complete-cache - (list Info-current-file Info-current-node - Info-complete-next-re string completions))) + (set (make-local-variable 'Info-complete-cache) + (list Info-current-file Info-current-node + Info-complete-next-re string completions))) (if action (all-completions string completions predicate) (try-completion string completions predicate))))))) @@ -1505,7 +1677,9 @@ new buffer." (save-excursion (goto-char p) (end-of-line) - (if (re-search-backward "\n\\* +\\([^:\t\n]*\\):" beg t) + (if (re-search-backward (concat "\n\\* +\\(" + Info-menu-entry-name-re + "\\):") beg t) (setq default (match-string-no-properties 1)))))) (let ((item nil)) (while (null item) @@ -1603,28 +1777,10 @@ N is the digit argument used to invoke this command." (not (string-match "\\" Info-current-node))) (Info-goto-node (Info-extract-menu-counting 1)) t) - ((save-excursion - (save-restriction - (let (limit) - (when Info-header-line - (goto-char (point-min)) - (widen) - (forward-line -1) - (setq limit (point)) - (forward-line 1)) - (search-backward "next:" limit t)))) + ((save-excursion (search-backward "next:" nil t)) (Info-next) t) - ((and (save-excursion - (save-restriction - (let (limit) - (when Info-header-line - (goto-char (point-min)) - (widen) - (forward-line -1) - (setq limit (point)) - (forward-line 1)) - (search-backward "up:" limit t)))) + ((and (save-excursion (search-backward "up:" nil t)) ;; Use string-equal, not equal, to ignore text props. (not (string-equal (downcase (Info-extract-pointer "up")) "top"))) @@ -1670,6 +1826,7 @@ N is the digit argument used to invoke this command." (quit-window))) (defun Info-next-menu-item () + "Go to the node of the next menu item." (interactive) ;; Bind this in case the user sets it to nil. (let* ((case-fold-search t) @@ -1683,6 +1840,7 @@ N is the digit argument used to invoke this command." (error "No more items in menu")))) (defun Info-last-menu-item () + "Go to the node of the previous menu item." (interactive) (save-excursion (forward-line 1) @@ -1802,7 +1960,7 @@ parent node." (search-forward "\n* Menu:" current-point t))))) - (if (or virtual-end + (if (or virtual-end (pos-visible-in-window-p (point-min) nil t)) (Info-last-preorder) (scroll-down)))) @@ -1857,6 +2015,7 @@ parent node." (let ((Info-history nil)) (Info-goto-node (Info-extract-menu-node-name)))) +;;;###autoload (defun Info-index (topic) "Look up a string TOPIC in the index for this file. The index is defined as the first node in the top level menu whose @@ -1870,14 +2029,17 @@ Give a blank topic name to go to the Index node itself." (list (let ((Info-complete-menu-buffer (clone-buffer)) (Info-complete-next-re "\\")) + (if (equal Info-current-file "dir") + (error "The Info directory node has no index; use m to select a manual")) (unwind-protect (with-current-buffer Info-complete-menu-buffer (Info-goto-index) (completing-read "Index topic: " 'Info-complete-menu-item)) (kill-buffer Info-complete-menu-buffer))))) + (if (equal Info-current-file "dir") + (error "The Info directory node has no index; use m to select a manual")) (let ((orignode Info-current-node) - (rnode nil) - (pattern (format "\n\\* +\\([^\n:]*%s[^\n:]*\\):[ \t]*\\([^.\n]*\\)\\.[ \t]*\\([0-9]*\\)" + (pattern (format "\n\\* +\\([^\n]*%s[^\n]*\\):[ \t]+\\([^.\n]*\\)\\.[ \t]*\\([0-9]*\\)" (regexp-quote topic))) node (case-fold-search t)) @@ -1898,8 +2060,8 @@ Give a blank topic name to go to the Index node itself." (push (list (match-string-no-properties 1) (match-string-no-properties 2) Info-current-node - (string-to-int (concat "0" - (match-string 3)))) + (string-to-number (concat "0" + (match-string 3)))) matches)) (and (setq node (Info-extract-pointer "next" t)) (string-match "\\" node))) @@ -1937,7 +2099,7 @@ Give a blank topic name to go to the Index node itself." (car (car Info-index-alternatives)) (nth 2 (car Info-index-alternatives)) (if (cdr Info-index-alternatives) - "(Press `,' for more)" + "(`,' tries to find next)" "(Only match)"))) (defun Info-find-index-name (name) @@ -1946,13 +2108,20 @@ Give a blank topic name to go to the Index node itself." (if (or (re-search-forward (format "[a-zA-Z]+: %s\\( \\|$\\)" (regexp-quote name)) nil t) + ;; Find a function definition with a return type. + (re-search-forward (format + "[a-zA-Z]+: [a-zA-Z0-9_ *&]+ %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) + (search-forward name nil t) + ;; Try again without the " <1>" makeinfo can append + (and (string-match "\\`\\(.*\\) <[0-9]+>\\'" name) + (Info-find-index-name (match-string 1 name)))) + (progn (beginning-of-line) t) ;; non-nil for recursive call (goto-char (point-min))))) (defun Info-undefined () @@ -2041,12 +2210,22 @@ At end of the node's text, moves to the next node, or up if none." (Info-next-preorder))) (defun Info-follow-nearest-node () - "\\Follow a node reference near point. -Like \\[Info-menu], \\[Info-follow-reference], \\[Info-next], \\[Info-prev] or \\[Info-up] command, depending on where point is. -If no reference to follow, moves to the next node, or up if none." + "Follow a node reference near point. +If point is on a reference, follow that reference. Otherwise, +if point is in a menu item description, follow that menu item." (interactive) (or (Info-try-follow-nearest-node) - (Info-next-preorder))) + (when (save-excursion + (search-backward "\n* menu:" nil t)) + (save-excursion + (beginning-of-line) + (while (not (or (bobp) (looking-at "[^ \t]\\|[ \t]*$"))) + (beginning-of-line 0)) + (when (looking-at "\\* +\\([^\t\n]*\\):") + (Info-goto-node + (Info-extract-menu-item (match-string-no-properties 1))) + t))) + (error "Point neither on reference nor in menu item description"))) ;; Common subroutine. (defun Info-try-follow-nearest-node () @@ -2056,9 +2235,11 @@ If no reference to follow, moves to the next node, or up if none." ((setq node (Info-get-token (point) "\\*note[ \n]" "\\*note[ \n]\\([^:]*\\):")) (Info-follow-reference node)) + ;; menu item: node name ((setq node (Info-get-token (point) "\\* +" "\\* +\\([^:]*\\)::")) (Info-goto-node node)) - ((Info-get-token (point) "\\* +" "\\* +\\([^:]*\\):") + ;; menu item: index entry + ((Info-get-token (point) "\\* +" "\\* +\\(.*\\): ") (beginning-of-line) (forward-char 2) (setq node (Info-extract-menu-node-name)) @@ -2083,7 +2264,8 @@ If no reference to follow, moves to the next node, or up if none." (define-key Info-mode-map " " 'Info-scroll-up) (define-key Info-mode-map "\C-m" 'Info-follow-nearest-node) (define-key Info-mode-map "\t" 'Info-next-reference) - (define-key Info-mode-map "\e\t" 'Info-prev-reference) + (define-key Info-mode-map [(shift tab)] 'Info-prev-reference) + (define-key Info-mode-map [backtab] 'Info-prev-reference) (define-key Info-mode-map "1" 'Info-nth-menu-item) (define-key Info-mode-map "2" 'Info-nth-menu-item) (define-key Info-mode-map "3" 'Info-nth-menu-item) @@ -2222,9 +2404,7 @@ If no reference to follow, moves to the next node, or up if none." (save-excursion (goto-char (point-min)) (while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t) - (setq str (buffer-substring - (match-beginning 1) - (1- (point)))) + (setq str (match-string 1)) (setq i 0) (while (setq i (string-match "[ \n\t]+" str i)) (setq str (concat (substring str 0 i) " " @@ -2315,7 +2495,7 @@ Moving within a node: \\[beginning-of-buffer] Go to beginning of node. Advanced commands: -\\[Info-exit] Quit Info: reselect previously selected buffer. +\\[Info-copy-current-node-name] Put name of current info node in the kill ring. \\[Info-edit] Edit contents of selected node. 1 Pick first item in node's menu. 2, 3, 4, 5 Pick second ... fifth item in node's menu. @@ -2345,11 +2525,16 @@ Advanced commands: (setq Info-tag-table-buffer nil) (make-local-variable 'Info-history) (make-local-variable 'Info-index-alternatives) + (setq header-line-format + (if Info-use-header-line + '(:eval (get-text-property (point-min) 'header-line)) + nil)) ; so the header line isn't displayed (set (make-local-variable 'tool-bar-map) info-tool-bar-map) ;; 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 'clone-buffer-hook 'Info-clone-buffer-hook nil t) + (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) (Info-set-mode-line) (run-hooks 'Info-mode-hook)) @@ -2477,8 +2662,7 @@ The locations are of the format used in `Info-history', i.e. ;; Bind Info-history to nil, to prevent the index nodes from ;; getting into the node history. (let ((Info-history nil) - (exact nil) - node found) + node) (Info-goto-node (Info-extract-menu-node-name)) (while (progn @@ -2499,8 +2683,12 @@ The locations are of the format used in `Info-history', i.e. "Go to the Info node in the Emacs manual for command COMMAND. The command is found by looking up in Emacs manual's indices or in another manual found via COMMAND's `info-file' property or -the variable `Info-file-list-for-emacs'." +the variable `Info-file-list-for-emacs'. COMMAND must be a symbol +or string." (interactive "CFind documentation for command: ") + ;; If command is given as a string, convert it to a symbol. + (if (stringp command) + (setq command (intern command))) (or (commandp command) (signal 'wrong-type-argument (list 'commandp command))) (let ((where (Info-find-emacs-command-nodes command))) @@ -2584,42 +2772,83 @@ the variable `Info-file-list-for-emacs'." "Face for headers in Info menus." :group 'info) +(defun Info-escape-percent (string) + "Double all occurrences of `%' in STRING. + +Return a new string with all `%' characters replaced by `%%'. +Preserve text properties." + (let ((start 0) + (end (length string)) + mb me m matches) + (save-match-data + (while (and (< start end) (string-match "%" string start)) + (setq mb (match-beginning 0) + me (1+ mb) + m (substring string mb me) + matches (cons m + (cons m + (cons (substring string start mb) + matches))) + start me)) + (push (substring string start end) matches) + (apply #'concat (nreverse matches))))) + (defun Info-fontify-menu-headers () "Add the face `info-menu-header' to any header before a menu entry." (save-excursion (goto-char (point-min)) - (when (re-search-forward "\\* Menu:" nil t) + (when (re-search-forward "^\\* Menu:" nil t) (put-text-property (match-beginning 0) (match-end 0) 'font-lock-face 'info-menu-header) (while (re-search-forward "\n\n\\([^*\n ].*\\)\n\n?[*]" nil t) (put-text-property (match-beginning 1) (match-end 1) 'font-lock-face 'info-menu-header))))) +(defvar Info-next-link-keymap + (let ((keymap (make-sparse-keymap))) + (define-key keymap [header-line mouse-1] 'Info-next) + (define-key keymap [header-line mouse-2] 'Info-next) + (define-key keymap [header-line down-mouse-1] 'ignore) + (define-key keymap [mouse-2] 'Info-next) + keymap) + "Keymap to put on the Next link in the text or the header line.") + +(defvar Info-prev-link-keymap + (let ((keymap (make-sparse-keymap))) + (define-key keymap [header-line mouse-1] 'Info-prev) + (define-key keymap [header-line mouse-2] 'Info-prev) + (define-key keymap [header-line down-mouse-1] 'ignore) + (define-key keymap [mouse-2] 'Info-prev) + keymap) + "Keymap to put on the Prev link in the text or the header line.") + + +(defvar Info-up-link-keymap + (let ((keymap (make-sparse-keymap))) + (define-key keymap [header-line mouse-1] 'Info-up) + (define-key keymap [header-line mouse-2] 'Info-up) + (define-key keymap [header-line down-mouse-1] 'ignore) + (define-key keymap [mouse-2] 'Info-up) + keymap) + "Keymap to put on the Up link in the text or the header line.") + (defun Info-fontify-node () - ;; Only fontify the node if it hasn't already been done. [We pass in - ;; LIMIT arg to `next-property-change' because it seems to search past - ;; (point-max).] - (unless (and (< (next-property-change (point-min) nil (point-max)) - (point-max)) - ;; But do put the text properties if the local-map property - ;; is inconsistent with Info-use-header-line's value. - (eq - (= (next-single-property-change - (point-min) 'local-map nil (point-max)) - (point-max)) - (null Info-use-header-line))) + ;; Only fontify the node if it hasn't already been done. + (unless (let ((where (next-property-change (point-min)))) + (and where (not (= where (point-max))))) (save-excursion - (let ((buffer-read-only nil) - (case-fold-search t)) + (let ((inhibit-read-only t) + (case-fold-search t) + paragraph-markers) (goto-char (point-min)) - (when (looking-at "^File: [^,: \t]+,?[ \t]+") + (when (looking-at "^\\(File: [^,: \t]+,?[ \t]+\\)?") (goto-char (match-end 0)) (while (looking-at "[ \t]*\\([^:, \t\n]+\\):[ \t]+\\([^:,\t\n]+\\),?") (goto-char (match-end 0)) (let* ((nbeg (match-beginning 2)) (nend (match-end 2)) (tbeg (match-beginning 1)) - (tag (buffer-substring tbeg (match-end 1)))) + (tag (match-string 1))) (if (string-equal tag "Node") (put-text-property nbeg nend 'font-lock-face 'info-header-node) (put-text-property nbeg nend 'font-lock-face 'info-header-xref) @@ -2628,24 +2857,42 @@ the variable `Info-file-list-for-emacs'." 'help-echo (concat "Go to node " (buffer-substring nbeg nend))) - ;; Don't bind mouse events on the header line if we - ;; aren't going to display the header line. - (when Info-use-header-line - (let ((fun (cdr (assoc tag '(("Prev" . Info-prev) - ("Next" . Info-next) - ("Up" . Info-up)))))) - (when fun - (let ((keymap (make-sparse-keymap))) - (define-key keymap [header-line mouse-1] fun) - (define-key keymap [header-line mouse-2] fun) - (put-text-property tbeg nend 'local-map keymap))))) - (if (not Info-use-header-line) - ;; In case they switched Info-use-header-line off - ;; in the middle of an Info session, some text - ;; properties may have been left lying around from - ;; past visits of this node. Remove them. - (remove-text-properties tbeg nend '(local-map nil))) - )))) + ;; Always set up the text property keymap. + ;; It will either be used in the buffer + ;; or copied in the header line. + (put-text-property tbeg nend 'keymap + (cond + ((equal tag "Prev") Info-prev-link-keymap) + ((equal tag "Next") Info-next-link-keymap) + ((equal tag "Up") Info-up-link-keymap)))))) + (when Info-use-header-line + (goto-char (point-min)) + (let ((header-end (line-end-position)) + header) + ;; If we find neither Next: nor Prev: link, show the entire + ;; node header. Otherwise, don't show the File: and Node: + ;; parts, to avoid wasting precious space on information that + ;; is available in the mode line. + (if (re-search-forward + "\\(next\\|up\\|prev[ious]*\\): " + header-end t) + (progn + (goto-char (match-beginning 1)) + (setq header (buffer-substring (point) header-end))) + (if (re-search-forward "node:[ \t]*[^ \t]+[ \t]*" header-end t) + (setq header + (concat "No next, prev or up links -- " + (buffer-substring (point) header-end))) + (setq header (buffer-substring (point) header-end)))) + + (put-text-property (point-min) (1+ (point-min)) + 'header-line (Info-escape-percent header)) + ;; Hide the part of the first line + ;; that is in the header, if it is just part. + (unless (bobp) + ;; Hide the punctuation at the end, too. + (skip-chars-backward " \t,") + (put-text-property (point) header-end 'invisible t))))) (goto-char (point-min)) (while (re-search-forward "\n\\([^ \t\n].+\\)\n\\(\\*+\\|=+\\|-+\\|\\.+\\)$" nil t) @@ -2661,32 +2908,124 @@ the variable `Info-file-list-for-emacs'." ;; frame types at once. We want this text to be invisible ;; on frames that can display the font above. (when (memq (framep (selected-frame)) '(x pc w32 mac)) - (add-text-properties (match-beginning 2) (1+ (match-end 2)) - '(invisible t intangible t)))) + (add-text-properties (1- (match-beginning 2)) (match-end 2) + '(invisible t front-sticky nil rear-nonsticky t)))) (goto-char (point-min)) - (while (re-search-forward "\\*Note[ \n\t]+\\([^:]*\\):" nil t) - (if (= (char-after (1- (match-beginning 0))) ?\") ; hack - nil - (add-text-properties (match-beginning 1) (match-end 1) - '(font-lock-face info-xref - mouse-face highlight - help-echo "mouse-2: go to this node")))) + (while (re-search-forward "\\(\\*Note[ \t]*\\)\n?[ \t]*\\([^:]*\\)\\(:[^.,:(]*\\(([^)]*)[^.,:]*\\)?[,:]?\n?\\)" nil t) + (unless (= (char-after (1- (match-beginning 0))) ?\") ; hack + (let ((start (match-beginning 0)) + (next (point)) + (hide-tag Info-hide-note-references) + other-tag) + (when hide-tag + ;; *Note is often used where *note should have been + (goto-char start) + (skip-syntax-backward " ") + (setq other-tag + (cond ((memq (char-before) '(nil ?\. ?! ??)) + "See ") + ((memq (char-before) '(?\, ?\; ?\: ?-)) + "see ") + ((memq (char-before) '(?\( ?\[ ?\{)) + ;; Check whether the paren is preceded by + ;; an end of sentence + (skip-syntax-backward " (") + (if (memq (char-before) '(nil ?\. ?! ??)) + "See " + "see ")) + ((save-match-data (looking-at "\n\n")) + "See "))) + (goto-char next)) + (if hide-tag + (add-text-properties (match-beginning 1) (match-end 1) + '(invisible t front-sticky nil rear-nonsticky t))) + (add-text-properties + (match-beginning 2) (match-end 2) + (cons 'help-echo + (cons (if (match-end 4) + (concat "mouse-2: go to " (match-string 4)) + "mouse-2: go to this node") + '(font-lock-face info-xref + mouse-face highlight)))) + (when (eq Info-hide-note-references t) + (add-text-properties (match-beginning 3) (match-end 3) + '(invisible t front-sticky nil rear-nonsticky t))) + (when other-tag + (save-excursion + (goto-char (match-beginning 1)) + (insert other-tag))) + (when (and Info-refill-paragraphs + (or hide-tag (eq Info-hide-note-references t))) + (push (set-marker (make-marker) start) + paragraph-markers))))) + + (when (and Info-refill-paragraphs + paragraph-markers) + (let ((fill-nobreak-invisible t) + (fill-individual-varying-indent nil) + (paragraph-start "\f\\|[ \t]*[-*]\\|[ \t]*$") + (paragraph-separate ".*\\.[ \t]*\n[ \t]\\|[ \t]*[-*]\\|[ \t\f]*$") + (adaptive-fill-mode nil)) + (goto-char (point-max)) + (while paragraph-markers + (let ((m (car paragraph-markers))) + (setq paragraph-markers (cdr paragraph-markers)) + (when (< m (point)) + (goto-char m) + (beginning-of-line) + (let ((beg (point))) + (when (zerop (forward-paragraph)) + (fill-individual-paragraphs beg (point) nil nil) + (goto-char beg)))) + (set-marker m nil))))) + (goto-char (point-min)) - (if (and (search-forward "\n* Menu:" nil t) - (not (string-match "\\" Info-current-node)) - ;; Don't take time to annotate huge menus - (< (- (point-max) (point)) Info-fontify-maximum-menu-size)) - (let ((n 0)) - (while (re-search-forward "^\\* +\\([^:\t\n]*\\):" nil t) - (setq n (1+ n)) - (if (zerop (% n 3)) ; visual aids to help with 1-9 keys - (put-text-property (match-beginning 0) - (1+ (match-beginning 0)) - 'font-lock-face 'info-menu-5)) - (add-text-properties (match-beginning 1) (match-end 1) - '(font-lock-face info-xref - mouse-face highlight - help-echo "mouse-2: go to this node"))))) + (when (and (search-forward "\n* Menu:" nil t) + (not (string-match "\\" Info-current-node)) + ;; Don't take time to annotate huge menus + (< (- (point-max) (point)) Info-fontify-maximum-menu-size)) + (let ((n 0) + cont) + (while (re-search-forward + (concat "^\\* +\\(" Info-menu-entry-name-re "\\)\\(:" + Info-node-spec-re "\\([ \t]*\\)\\)") + nil t) + (setq n (1+ n)) + (if (and (<= n 9) (zerop (% n 3))) ; visual aids to help with 1-9 keys + (put-text-property (match-beginning 0) + (1+ (match-beginning 0)) + 'font-lock-face 'info-menu-5)) + (add-text-properties + (match-beginning 1) (match-end 1) + (cons 'help-echo + (cons + (if (match-end 3) + (concat "mouse-2: go to " (match-string 3)) + "mouse-2: go to this node") + '(font-lock-face info-xref + mouse-face highlight)))) + (when (eq Info-hide-note-references t) + (put-text-property (match-beginning 2) (1- (match-end 6)) + 'invisible t) + ;; We need a stretchable space like :align-to but with + ;; a minimum value. + (put-text-property (1- (match-end 6)) (match-end 6) 'display + (if (>= 22 (- (match-end 1) + (match-beginning 0))) + '(space :align-to 24) + '(space :width 2))) + (setq cont (looking-at ".")) + (while (and (= (forward-line 1) 0) + (looking-at "\\([ \t]+\\)[^*\n]")) + (put-text-property (match-beginning 1) (1- (match-end 1)) + 'invisible t) + (put-text-property (1- (match-end 1)) (match-end 1) + 'display + (if cont + '(space :align-to 26) + '(space :align-to 24))) + (setq cont t)))))) + (Info-fontify-menu-headers) (set-buffer-modified-p nil))))) @@ -2781,14 +3120,13 @@ specific node to expand." (select-frame cf) (if completions (speedbar-with-writable - (while completions + (dolist (completion completions) (speedbar-make-tag-line 'bracket ?+ 'Info-speedbar-expand-node - (cdr (car completions)) - (car (car completions)) + (cdr completion) + (car completion) 'Info-speedbar-goto-node - (cdr (car completions)) - 'info-xref depth) - (setq completions (cdr completions))) + (cdr completion) + 'info-xref depth)) t) nil)))) @@ -2807,10 +3145,9 @@ The INDENT level is ignored." (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 (not (string-match "^(\\([^)]+\\))\\([^.]+\\)$" node)) + (error "Invalid node %s" node) + (Info-find-node (match-string 1 node) (match-string 2 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. @@ -2847,10 +3184,9 @@ Optional THISFILE represends the filename of" (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)) + (if (not (string-match "^(\\([^)]+\\))\\([^.]+\\)$" nodespec)) + (error "Invalid node specification %s" nodespec) + (Info-find-node (match-string 1 nodespec) (match-string 2 nodespec))) ;; Scan the created buffer (goto-char (point-min)) (let ((completions nil) @@ -2861,18 +3197,20 @@ Optional THISFILE represends the filename of" (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)))) + (push (cons name + (if (looking-at " *\\(([^)]+)[^.\n]+\\)\\.") + (match-string 1) + (if (looking-at " *\\(([^)]+)\\)\\.") + (concat (match-string 1) "Top") + (concat "(" thisfile ")" + (if (looking-at " \\([^.]+\\).") + (match-string 1) + name))))) + completions))) (nreverse completions)))) ;;; Info mode node listing +;; FIXME: Seems not to be used. -stef (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." @@ -2893,4 +3231,5 @@ BUFFER is the buffer speedbar is requesting buttons for." (provide 'info) +;;; arch-tag: f2480fe2-2139-40c1-a49b-6314991164ac ;;; info.el ends here