: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-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.
(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*"
(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 (format "* %-14s %s.\n"
(concat (symbol-name keyword) "::")
(cdr assoc)))))
- (cons '(unknown . "unknown keywords")
+ (append '((all . "All package info")
+ (unknown . "unknown keywords"))
finder-known-keywords)))
((equal nodename "unknown")
;; Display unknown keywords
(concat (symbol-name (car assoc)) "::")
(cdr assoc))))
(finder-unknown-keywords)))
+ ((equal nodename "all")
+ ;; Display all package info.
+ (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)
;; Display commentary section
(insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
(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
"The following packages match the keyword `" nodename "':\n\n")
(insert "* Menu:\n\n")
- (let ((id (intern nodename)))
+ (let ((keywords
+ (mapcar 'intern (if (string-match-p "," nodename)
+ (split-string nodename ",[ \t\n]*" t)
+ (list nodename)))))
(mapc
- (lambda (x)
- (when (memq id (cadr (cdr x)))
+ (lambda (package)
+ (unless (memq nil (mapcar (lambda (k) (memq k (nth 2 package)))
+ keywords))
(insert (format "* %-16s %s.\n"
- (concat (car x) "::")
- (cadr x)))))
+ (concat (nth 0 package) "::")
+ (nth 1 package)))))
finder-package-info)))))
;;;###autoload
-(defun info-finder ()
- "Display descriptions of the keywords in the Finder virtual manual."
- (interactive)
+(defun info-finder (&optional keywords)
+ "Display descriptions of the keywords in the Finder virtual manual.
+In interactive use, a prefix argument directs this command to read
+a list of keywords separated by comma. After that, it displays a node
+with a list packages that contain all specified keywords."
+ (interactive
+ (when current-prefix-arg
+ (require 'finder)
+ (list
+ (completing-read-multiple
+ "Keywords (separated by comma): "
+ (mapcar 'symbol-name (mapcar 'car (append finder-known-keywords
+ (finder-unknown-keywords))))
+ nil t))))
(require 'finder)
- (Info-find-node Info-finder-file "Top"))
+ (if keywords
+ (Info-find-node Info-finder-file (mapconcat 'identity keywords ", "))
+ (Info-find-node Info-finder-file "Top")))
+
\f
(defun Info-undefined ()
"Make command be undefined in Info."
((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")
(tool-bar-local-item-from-menu 'Info-history-forward "right-arrow" map Info-mode-map
- :rtl "left-arrow")
+ :rtl "left-arrow"
+ :label "Forward")
(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
(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-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-index "index" map Info-mode-map
+ :label "Index Search")
(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)
map))
;; Autoload cookie needed by desktop.el
;;;###autoload
-(defun Info-mode ()
+(define-derived-mode Info-mode nil "Info"
"Info mode provides commands for browsing through the Info documentation tree.
Documentation in Info is divided into \"nodes\", each of which discusses
one topic and contains references to other nodes which discuss related
\\[clone-buffer] Select a new cloned Info buffer in another window.
\\[universal-argument] \\[info] Move to new Info file with completion.
\\[universal-argument] N \\[info] Select Info buffer with prefix number in the name *info*<N>."
- (kill-all-local-variables)
- (setq major-mode 'Info-mode)
- (setq mode-name "Info")
+ :syntax-table text-mode-syntax-table
+ :abbrev-table text-mode-abbrev-table
(setq tab-width 8)
- (use-local-map Info-mode-map)
(add-hook 'activate-menubar-hook 'Info-menu-update nil t)
- (set-syntax-table text-mode-syntax-table)
- (setq local-abbrev-table text-mode-abbrev-table)
(setq case-fold-search t)
(setq buffer-read-only t)
(make-local-variable 'Info-current-file)
(make-local-variable 'Info-current-subfile)
(make-local-variable 'Info-current-node)
- (make-local-variable 'Info-tag-table-marker)
- (setq Info-tag-table-marker (make-marker))
- (make-local-variable 'Info-tag-table-buffer)
- (setq Info-tag-table-buffer nil)
+ (set (make-local-variable 'Info-tag-table-marker) (make-marker))
+ (set (make-local-variable 'Info-tag-table-buffer) nil)
(make-local-variable 'Info-history)
(make-local-variable 'Info-history-forward)
(make-local-variable 'Info-index-alternatives)
'(:eval (get-text-property (point-min) 'header-line))))
(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)
- (make-local-variable 'desktop-save-buffer)
- (make-local-variable 'widen-automatically)
- (setq widen-automatically nil)
- (setq desktop-save-buffer 'Info-desktop-buffer-misc-data)
+ (set (make-local-variable 'line-move-ignore-invisible) t)
+ (set (make-local-variable 'desktop-save-buffer)
+ 'Info-desktop-buffer-misc-data)
+ (set (make-local-variable 'widen-automatically) nil)
(add-hook 'kill-buffer-hook 'Info-kill-buffer nil t)
(add-hook 'clone-buffer-hook 'Info-clone-buffer nil t)
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
'Info-revert-buffer-function)
(Info-set-mode-line)
(set (make-local-variable 'bookmark-make-record-function)
- 'Info-bookmark-make-record)
- (run-mode-hooks 'Info-mode-hook))
+ 'Info-bookmark-make-record))
;; When an Info buffer is killed, make sure the associated tags buffer
;; is killed too.
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))
HCoop / bpt / emacs.git / blobdiff