;; info.el --- info package for Emacs
-;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 1998,
+;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+;; 2010, 2011 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: help
(defcustom Info-breadcrumbs-depth 4
"Depth of breadcrumbs to display.
0 means do not display breadcrumbs."
- :type 'integer)
+ :version "23.1"
+ :type 'integer
+ :group 'info)
(defcustom Info-search-whitespace-regexp "\\s-+"
"If non-nil, regular expression to match a sequence of whitespace chars.
:group 'info)
(defvar Info-isearch-initial-node nil)
+(defvar Info-isearch-initial-history nil)
+(defvar Info-isearch-initial-history-list nil)
(defcustom Info-mode-hook
;; Try to obey obsolete Info-fontify settings.
(".info.gz". "gunzip")
(".info.z". "gunzip")
(".info.bz2" . ("bzip2" "-dc"))
+ (".info.xz". "unxz")
(".info". nil)
("-info.Z". "uncompress")
("-info.Y". "unyabba")
("-info.gz". "gunzip")
("-info.bz2" . ("bzip2" "-dc"))
("-info.z". "gunzip")
+ ("-info.xz". "unxz")
("-info". nil)
("/index.Z". "uncompress")
("/index.Y". "unyabba")
("/index.gz". "gunzip")
("/index.z". "gunzip")
("/index.bz2". ("bzip2" "-dc"))
+ ("/index.xz". "unxz")
("/index". nil)
(".Z". "uncompress")
(".Y". "unyabba")
(".gz". "gunzip")
(".z". "gunzip")
(".bz2" . ("bzip2" "-dc"))
+ (".xz". "unxz")
("". nil)))
"List of file name suffixes and associated decoding commands.
Each entry should be (SUFFIX . STRING); the file is given to
"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*")
+ (or (eq major-mode 'Info-mode) (pop-to-buffer "*info*"))
(let ((old-filename Info-current-file)
(old-nodename Info-current-node)
+ (old-buffer-name (buffer-name))
(pcolumn (current-column))
(pline (count-lines (point-min) (line-beginning-position)))
(wline (count-lines (point-min) (window-start)))
+ (old-history-forward Info-history-forward)
(old-history Info-history)
(new-history (and Info-current-file
(list Info-current-file Info-current-node (point)))))
(kill-buffer (current-buffer))
+ (pop-to-buffer (or old-buffer-name "*info*"))
+ (Info-mode)
(Info-find-node filename nodename)
+ (setq Info-history-forward old-history-forward)
(setq Info-history old-history)
(if (and (equal old-filename Info-current-file)
(equal old-nodename Info-current-node))
(let ((case-fold-search case-fold)
found)
(save-excursion
- (when (Info-node-at-bob-matching regexp)
- (setq found (point)))
- (while (and (not found)
- (search-forward "\n\^_" nil t))
- (forward-line 1)
- (let ((beg (point)))
- (forward-line 1)
- (when (re-search-backward regexp beg t)
- (beginning-of-line)
- (setq found (point)))))
- found)))
+ (if (Info-node-at-bob-matching regexp)
+ (setq found (point))
+ (while (and (not found)
+ (search-forward "\n\^_" nil t))
+ (forward-line 1)
+ (let ((beg (point)))
+ (forward-line 1)
+ (if (re-search-backward regexp beg t)
+ (setq found (line-beginning-position)))))))
+ found))
(defun Info-find-node-in-buffer (regexp)
"Find a node or anchor in the current buffer.
(Info-select-node)
(goto-char (point-min))
(forward-line 1) ; skip header line
- (when (> Info-breadcrumbs-depth 0) ; skip breadcrumbs line
- (forward-line 1))
+ ;; (when (> Info-breadcrumbs-depth 0) ; skip breadcrumbs line
+ ;; (forward-line 1))
(cond (anchorpos
(let ((new-history (list Info-current-file
(setq Info-isearch-initial-node
;; Don't stop at initial node for nonincremental search.
;; Otherwise this variable is set after first search failure.
- (and isearch-nonincremental Info-current-node)))
+ (and isearch-nonincremental Info-current-node))
+ (setq Info-isearch-initial-history Info-history
+ Info-isearch-initial-history-list Info-history-list)
+ (add-hook 'isearch-mode-end-hook 'Info-isearch-end nil t))
+
+(defun Info-isearch-end ()
+ ;; Remove intermediate nodes (visited while searching)
+ ;; from the history. Add only the last node (where Isearch ended).
+ (if (> (length Info-history)
+ (length Info-isearch-initial-history))
+ (setq Info-history
+ (nthcdr (- (length Info-history)
+ (length Info-isearch-initial-history)
+ 1)
+ Info-history)))
+ (if (> (length Info-history-list)
+ (length Info-isearch-initial-history-list))
+ (setq Info-history-list
+ (cons (car Info-history-list)
+ Info-isearch-initial-history-list)))
+ (remove-hook 'isearch-mode-end-hook 'Info-isearch-end t))
(defun Info-isearch-filter (beg-found found)
"Test whether the current search hit is a visible useful text.
completions default alt-default (start-point (point)) str i bol eol)
(save-excursion
;; Store end and beginning of line.
- (end-of-line)
- (setq eol (point))
- (beginning-of-line)
- (setq bol (point))
-
+ (setq eol (line-end-position)
+ bol (line-beginning-position))
(goto-char (point-min))
(while (re-search-forward "\\*note[ \n\t]+\\([^:]*\\):" nil t)
(setq str (match-string-no-properties 1))
(virtual-end
(and Info-scroll-prefer-subnodes
(save-excursion
- (beginning-of-line)
- (setq current-point (point))
+ (setq current-point (line-beginning-position))
(goto-char (point-min))
- (search-forward "\n* Menu:"
- current-point
- t)))))
+ (search-forward "\n* Menu:" current-point t)))))
(if (or virtual-end
(pos-visible-in-window-p (point-min) nil t))
(Info-last-preorder)
(add-to-list 'Info-virtual-nodes
'("\\`\\*Index.*\\*\\'"
(find-node . Info-virtual-index-find-node)
+ (slow . t)
))
(defvar Info-virtual-index-nodes nil
(toc-nodes . Info-apropos-toc-nodes)
(find-file . Info-apropos-find-file)
(find-node . Info-apropos-find-node)
+ (slow . t)
))
(defvar Info-apropos-file "*Apropos*"
filename)
(defvar finder-known-keywords)
-(defvar finder-package-info)
(declare-function find-library-name "find-func" (library))
(declare-function finder-unknown-keywords "finder" ())
(declare-function lm-commentary "lisp-mnt" (&optional file))
+(defvar finder-keywords-hash)
+(defvar package-alist) ; finder requires package
(defun Info-finder-find-node (filename nodename &optional no-going-back)
"Finder-specific implementation of Info-find-node-2."
+ (require 'finder)
(cond
((equal nodename "Top")
;; Display Top menu with descriptions of the keywords
(insert "Finder Keywords\n")
(insert "***************\n\n")
(insert "* Menu:\n\n")
- (mapc
- (lambda (assoc)
- (let ((keyword (car assoc)))
- (insert (format "* %-14s %s.\n"
- (concat (symbol-name keyword) "::")
- (cdr assoc)))))
- (append '((all . "All package info")
- (unknown . "unknown keywords"))
- finder-known-keywords)))
+ (dolist (assoc (append '((all . "All package info")
+ (unknown . "unknown keywords"))
+ finder-known-keywords))
+ (let ((keyword (car assoc)))
+ (insert (format "* %s %s.\n"
+ (concat (symbol-name keyword) ": "
+ "kw:" (symbol-name keyword) ".")
+ (cdr assoc))))))
((equal nodename "unknown")
;; Display unknown keywords
(insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
Info-finder-file nodename))
(insert "Finder Package Info\n")
(insert "*******************\n\n")
- (mapc (lambda (package)
- (insert (format "%s - %s\n"
- (format "*Note %s::" (nth 0 package))
- (nth 1 package)))
- (insert "Keywords: "
- (mapconcat (lambda (keyword)
- (format "*Note %s::" (symbol-name keyword)))
- (nth 2 package) ", ")
- "\n\n"))
- finder-package-info))
- ((string-match-p "\\.el\\'" nodename)
+ (dolist (package package-alist)
+ (insert (format "%s - %s\n"
+ (format "*Note %s::" (nth 0 package))
+ (nth 1 package)))))
+ ((string-match "\\`kw:" nodename)
+ (setq nodename (substring nodename (match-end 0)))
+ ;; Display packages that match the keyword
+ ;; or the list of keywords separated by comma.
+ (insert (format "\n\^_\nFile: %s, Node: kw:%s, Up: Top\n\n"
+ Info-finder-file nodename))
+ (insert "Finder Packages\n")
+ (insert "***************\n\n")
+ (insert
+ "The following packages match the keyword `" nodename "':\n\n")
+ (insert "* Menu:\n\n")
+ (let ((keywords
+ (mapcar 'intern (if (string-match-p "," nodename)
+ (split-string nodename ",[ \t\n]*" t)
+ (list nodename))))
+ hits desc)
+ (dolist (kw keywords)
+ (push (copy-tree (gethash kw finder-keywords-hash)) hits))
+ (setq hits (delete-dups (apply 'append hits)))
+ (dolist (package hits)
+ (setq desc (cdr-safe (assq package package-alist)))
+ (when (vectorp desc)
+ (insert (format "* %-16s %s.\n"
+ (concat (symbol-name package) "::")
+ (aref desc 2)))))))
+ (t
;; Display commentary section
(insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
Info-finder-file nodename))
(goto-char (point-min))
(while (re-search-forward "^;+ ?" nil t)
(replace-match "" nil nil))
- (buffer-string))))))
- (t
- ;; Display packages that match the keyword
- ;; or the list of keywords separated by comma.
- (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
- Info-finder-file nodename))
- (insert "Finder Packages\n")
- (insert "***************\n\n")
- (insert
- "The following packages match the keyword `" nodename "':\n\n")
- (insert "* Menu:\n\n")
- (let ((keywords
- (mapcar 'intern (if (string-match-p "," nodename)
- (split-string nodename ",[ \t\n]*" t)
- (list nodename)))))
- (mapc
- (lambda (package)
- (unless (memq nil (mapcar (lambda (k) (memq k (nth 2 package)))
- keywords))
- (insert (format "* %-16s %s.\n"
- (concat (nth 0 package) "::")
- (nth 1 package)))))
- finder-package-info)))))
+ (buffer-string))))))))
;;;###autoload
(defun info-finder (&optional keywords)
((setq node (Info-get-token (point) "Prev: " "Prev: \\([^,\n\t]*\\)"))
(Info-goto-node node fork)))
node))
+
+(defun Info-mouse-follow-link (click)
+ "Follow a link where you click."
+ (interactive "e")
+ (let* ((position (event-start click))
+ (posn-string (and position (posn-string position)))
+ (string (car-safe posn-string))
+ (string-pos (cdr-safe posn-string))
+ (link-args (and string string-pos
+ (get-text-property string-pos 'link-args string))))
+ (when link-args
+ (Info-goto-node link-args))))
+
\f
(defvar Info-mode-map
(let ((map (make-keymap)))
(defvar info-tool-bar-map
(let ((map (make-sparse-keymap)))
(tool-bar-local-item-from-menu 'Info-history-back "left-arrow" map Info-mode-map
- :rtl "right-arrow")
+ :rtl "right-arrow"
+ :label "Back"
+ :vert-only t)
(tool-bar-local-item-from-menu 'Info-history-forward "right-arrow" map Info-mode-map
- :rtl "left-arrow")
+ :rtl "left-arrow"
+ :label "Forward"
+ :vert-only t)
+ (define-key-after map [separator-1] menu-bar-separator)
(tool-bar-local-item-from-menu 'Info-prev "prev-node" map Info-mode-map
:rtl "next-node")
(tool-bar-local-item-from-menu 'Info-next "next-node" map Info-mode-map
:rtl "prev-node")
- (tool-bar-local-item-from-menu 'Info-up "up-node" map Info-mode-map)
- (tool-bar-local-item-from-menu 'Info-top-node "home" map Info-mode-map)
+ (tool-bar-local-item-from-menu 'Info-up "up-node" map Info-mode-map
+ :vert-only t)
+ (define-key-after map [separator-2] menu-bar-separator)
+ (tool-bar-local-item-from-menu 'Info-top-node "home" map Info-mode-map
+ :vert-only t)
(tool-bar-local-item-from-menu 'Info-goto-node "jump-to" map Info-mode-map)
- (tool-bar-local-item-from-menu 'Info-index "index" map Info-mode-map)
- (tool-bar-local-item-from-menu 'Info-search "search" map Info-mode-map)
- (tool-bar-local-item-from-menu 'Info-exit "exit" map Info-mode-map)
+ (define-key-after map [separator-3] menu-bar-separator)
+ (tool-bar-local-item-from-menu 'Info-index "index" map Info-mode-map
+ :label "Index")
+ (tool-bar-local-item-from-menu 'Info-search "search" map Info-mode-map
+ :vert-only t)
+ (tool-bar-local-item-from-menu 'Info-exit "exit" map Info-mode-map
+ :vert-only t)
map))
(defvar Info-menu-last-node nil)
keymap)
"Keymap to put on the Up link in the text or the header line.")
-(defun Info-insert-breadcrumbs ()
+(defvar Info-link-keymap
+ (let ((keymap (make-sparse-keymap)))
+ (define-key keymap [header-line mouse-1] 'Info-mouse-follow-link)
+ (define-key keymap [header-line mouse-2] 'Info-mouse-follow-link)
+ (define-key keymap [header-line down-mouse-1] 'ignore)
+ (define-key keymap [mouse-2] 'Info-mouse-follow-link)
+ (define-key keymap [follow-link] 'mouse-face)
+ keymap)
+ "Keymap to put on the link in the text or the header line.")
+
+(defun Info-breadcrumbs ()
(let ((nodes (Info-toc-nodes Info-current-file))
(node Info-current-node)
(crumbs ())
- (depth Info-breadcrumbs-depth))
+ (depth Info-breadcrumbs-depth)
+ line)
;; Get ancestors from the cached parent-children node info
(while (and (not (equal "Top" node)) (> depth 0))
(file-name-nondirectory Info-current-file)
;; Some legacy code can still use a symbol.
Info-current-file)))))
- (insert (if (bolp) "" " > ")
- (cond
- ((null node) "...")
- ((equal node Info-current-node)
- ;; No point linking to ourselves.
- (propertize text 'font-lock-face 'info-header-node))
- (t
- (concat "*Note " text "::"))))))
- (insert "\n"))))
+ (setq line (concat
+ line
+ (if (null line) "" " > ")
+ (cond
+ ((null node) "...")
+ ((equal node Info-current-node)
+ ;; No point linking to ourselves.
+ (propertize text 'font-lock-face 'info-header-node))
+ (t
+ (propertize text
+ 'mouse-face 'highlight
+ 'font-lock-face 'info-header-xref
+ 'help-echo "mouse-2: Go to node"
+ 'keymap Info-link-keymap
+ 'link-args text)))))))
+ (setq line (concat line "\n")))
+ ;; (font-lock-append-text-property 0 (length line)
+ ;; 'font-lock-face 'header-line line)
+ line))
(defun Info-fontify-node ()
"Fontify the node."
((string-equal (downcase tag) "next") Info-next-link-keymap)
((string-equal (downcase tag) "up" ) Info-up-link-keymap))))))
- (when (> Info-breadcrumbs-depth 0)
- (Info-insert-breadcrumbs))
+ ;; (when (> Info-breadcrumbs-depth 0)
+ ;; (insert (Info-breadcrumbs)))
;; Treat header line.
(when Info-use-header-line
;; that is in the header, if it is just part.
(cond
((> Info-breadcrumbs-depth 0)
- (put-text-property (point-min) (1+ header-end) 'invisible t))
+ (let ((ov (make-overlay (point-min) (1+ header-end))))
+ (overlay-put ov 'display (Info-breadcrumbs))
+ (overlay-put ov 'evaporate t)))
((not (bobp))
;; Hide the punctuation at the end, too.
(skip-chars-backward " \t,")
(defun Info-desktop-buffer-misc-data (desktop-dirname)
"Auxiliary information to be saved in desktop file."
- (unless (Info-virtual-file-p Info-current-file)
- (list Info-current-file Info-current-node)))
+ (list Info-current-file
+ Info-current-node
+ ;; Additional data as an association list.
+ (delq nil (list
+ (and Info-history
+ (cons 'history Info-history))
+ (and (Info-virtual-fun
+ 'slow Info-current-file Info-current-node)
+ (cons 'slow t))))))
(defun Info-restore-desktop-buffer (desktop-buffer-file-name
desktop-buffer-name
desktop-buffer-misc)
"Restore an Info buffer specified in a desktop file."
- (let ((first (nth 0 desktop-buffer-misc))
- (second (nth 1 desktop-buffer-misc)))
- (when (and first second)
- (when desktop-buffer-name
- (set-buffer (get-buffer-create desktop-buffer-name))
- (Info-mode))
- (Info-find-node first second)
- (current-buffer))))
+ (let* ((file (nth 0 desktop-buffer-misc))
+ (node (nth 1 desktop-buffer-misc))
+ (data (nth 2 desktop-buffer-misc))
+ (hist (assq 'history data))
+ (slow (assq 'slow data)))
+ ;; Don't restore nodes slow to regenerate.
+ (unless slow
+ (when (and file node)
+ (when desktop-buffer-name
+ (set-buffer (get-buffer-create desktop-buffer-name))
+ (Info-mode))
+ (Info-find-node file node)
+ (when hist
+ (setq Info-history (cdr hist)))
+ (current-buffer)))))
(add-to-list 'desktop-buffer-mode-handlers
'(Info-mode . Info-restore-desktop-buffer))
;;;; Bookmark support
-(declare-function bookmark-make-record-default "bookmark" (&optional pos-only))
+(declare-function bookmark-make-record-default
+ "bookmark" (&optional no-file no-context posn))
(declare-function bookmark-prop-get "bookmark" (bookmark prop))
(declare-function bookmark-default-handler "bookmark" (bmk))
(declare-function bookmark-get-bookmark-record "bookmark" (bmk))
"This implements the `bookmark-make-record-function' type (which see)
for Info nodes."
`(,Info-current-node
- ,@(bookmark-make-record-default 'point-only)
+ ,@(bookmark-make-record-default 'no-file)
(filename . ,Info-current-file)
(info-node . ,Info-current-node)
(handler . Info-bookmark-jump)))
(provide 'info)
-;; arch-tag: f2480fe2-2139-40c1-a49b-6314991164ac
;;; info.el ends here