Refill some copyright headers.
[bpt/emacs.git] / lisp / info.el
index c6e20f8..185d504 100644 (file)
@@ -1,8 +1,8 @@
 ;; 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, 2011
-;;   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
@@ -238,7 +238,9 @@ This only has an effect if `Info-hide-note-references' is non-nil."
 (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.
@@ -266,6 +268,8 @@ with wrapping around the current Info node."
   :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.
@@ -398,24 +402,28 @@ or `Info-virtual-nodes'."
        (".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
@@ -798,17 +806,22 @@ otherwise, that defaults to `Top'."
   "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))
@@ -875,17 +888,16 @@ Value is the position at which a match was found, or nil if not found."
   (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.
@@ -1914,7 +1926,27 @@ If DIRECTION is `backward', search in the reverse direction."
   (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.
@@ -2290,11 +2322,8 @@ new buffer."
         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))
@@ -2810,12 +2839,9 @@ parent node."
         (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)
@@ -3104,6 +3130,7 @@ Give an empty topic name to go to the Index node itself."
 (add-to-list 'Info-virtual-nodes
             '("\\`\\*Index.*\\*\\'"
               (find-node . Info-virtual-index-find-node)
+              (slow . t)
               ))
 
 (defvar Info-virtual-index-nodes nil
@@ -3193,6 +3220,7 @@ search results."
               (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*"
@@ -3341,12 +3369,15 @@ Build a menu of the possible matches."
   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
@@ -3355,14 +3386,63 @@ Build a menu of the possible matches."
     (insert "Finder Keywords\n")
     (insert "***************\n\n")
     (insert "* Menu:\n\n")
+    (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 Unknown 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)))))
-     finder-known-keywords))
-   ((string-match-p "\\.el\\'" nodename)
+       (insert (format "* %-14s %s.\n"
+                      (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")
+    (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))
@@ -3383,31 +3463,28 @@ Build a menu of the possible matches."
           (goto-char (point-min))
           (while (re-search-forward "^;+ ?" nil t)
             (replace-match "" nil nil))
-          (buffer-string))))))
-   (t
-    ;; Display packages that match the keyword
-    (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 ((id (intern nodename)))
-      (mapc
-       (lambda (x)
-        (when (memq id (cadr (cdr x)))
-          (insert (format "* %-16s %s.\n"
-                          (concat (car x) "::")
-                          (cadr x)))))
-       finder-package-info)))))
+          (buffer-string))))))))
 
 ;;;###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."
@@ -3685,19 +3762,31 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
 (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)
@@ -3795,7 +3884,7 @@ With a zero prefix arg, put the name inside a function call to `info'."
 
 ;; 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
@@ -3857,23 +3946,17 @@ Advanced commands:
 \\[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)
@@ -3882,12 +3965,10 @@ Advanced commands:
            '(: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)
@@ -3906,8 +3987,7 @@ Advanced commands:
        '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.
@@ -4790,27 +4870,42 @@ BUFFER is the buffer speedbar is requesting buttons for."
 
 (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))
@@ -4819,7 +4914,7 @@ BUFFER is the buffer speedbar is requesting buttons for."
   "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)))
@@ -4839,5 +4934,4 @@ type returned by `Info-bookmark-make-record', which see."
 
 (provide 'info)
 
-;; arch-tag: f2480fe2-2139-40c1-a49b-6314991164ac
 ;;; info.el ends here