XEmacs 21.2.27 "Hera".
[chise/xemacs-chise.git.1] / lisp / info.el
index eb62c6f..d90df95 100644 (file)
 ;; contain none or when it has become older than info files in the same
 ;; directory.
 
+;; Modified 1998-09-23 by Didier Verna <verna@inf.enst.fr>
+;;
+;; Use the new macro `with-search-caps-disable-folding'
+
 ;; Code:
+(eval-when-compile
+  (condition-case nil (require 'browse-url) (error nil)))
 
 (defgroup info nil
   "The info package for Emacs."
@@ -431,9 +437,15 @@ nil or `never', the default, auto-generated info directory
   "List of directories to search for Info documentation files.
 
 The first directory in this list, the \"dir\" file there will become
-the (dir)Top node of the Info documentation tree.  If you wish to
-modify the info search path, use `M-x customize-variable,
-Info-directory-list' to do so.")
+the (dir)Top node of the Info documentation tree.
+
+Note: DO NOT use the `customize' interface to change the value of this
+variable.  Its value is created dynamically on each startup, depending
+on XEmacs packages installed on the system.  If you want to change the
+search path, make the needed modifications on the variable's value
+from .emacs.  For instance:
+
+    (setq Info-directory-list (cons \"~/info\" Info-directory-list))")
 
 (defcustom Info-localdir-heading-regexp
     "^Locally installed XEmacs Packages:?"
@@ -453,9 +465,11 @@ heading."
 ;; Is this right for NT?  .zip, with -c for to stdout, right?
 (defvar Info-suffix-list '( ("" . nil) 
                            (".info" . nil)
+                           (".info.bz2" . "bzip2 -dc %s")
                            (".info.gz" . "gzip -dc %s")
                            (".info-z" . "gzip -dc %s")
                            (".info.Z" . "uncompress -c %s")
+                           (".bz2" . "bzip2 -dc %s")
                            (".gz" . "gzip -dc %s")
                            (".Z" . "uncompress -c %s")
                            (".zip" . "unzip -c %s") )
@@ -494,9 +508,12 @@ Marker points nowhere if file has no tag table.")
   "List of possible matches for last Info-index command.")
 (defvar Info-index-first-alternative nil)
 
-(defcustom Info-annotations-path '("~/.xemacs/info.notes"
-                                   "~/.infonotes"
-                                  "/usr/lib/info.notes")
+(defcustom Info-annotations-path
+  (list
+   (paths-construct-path (list user-init-directory "info.notes"))
+   (paths-construct-path '("~" ".infonotes"))
+   (paths-construct-path '("usr" "lib" "info.notes")
+                        (char-to-string directory-sep-char)))
   "*Names of files that contain annotations for different Info nodes.
 By convention, the first one should reside in your personal directory.
 The last should be a world-writable \"public\" annotations file."
@@ -800,12 +817,12 @@ actually get any text from."
           ;; Verify that none of the files we used has changed
           ;; since we used it.
           (eval (cons 'and
-                      (mapcar '(lambda (elt)
-                                 (let ((curr (file-attributes (car elt))))
-                                   ;; Don't compare the access time.
-                                   (if curr (setcar (nthcdr 4 curr) 0))
-                                   (setcar (nthcdr 4 (cdr elt)) 0)
-                                   (equal (cdr elt) curr)))
+                      (mapcar #'(lambda (elt)
+                                  (let ((curr (file-attributes (car elt))))
+                                    ;; Don't compare the access time.
+                                    (if curr (setcar (nthcdr 4 curr) 0))
+                                    (setcar (nthcdr 4 (cdr elt)) 0)
+                                    (equal (cdr elt) curr)))
                               Info-dir-file-attributes))))
       (insert Info-dir-contents)
     (let ((dirs (reverse Info-directory-list))
@@ -1018,19 +1035,19 @@ directory has been modified more recently."
        newer)
     (setq Info-dir-newer-info-files nil)
     (mapcar 
-     '(lambda (f)
-       (prog2
-           (setq f-mod-time (nth 5 (file-attributes f)))
-           (setq newer (or (> (car f-mod-time) (car dir-mod-time))
-                           (and (= (car f-mod-time) (car dir-mod-time))
-                                (> (car (cdr f-mod-time)) (car (cdr dir-mod-time))))))
-         (if (and (file-readable-p f)
-                  newer)
-             (setq Info-dir-newer-info-files 
-                   (cons f Info-dir-newer-info-files)))))
+     #'(lambda (f)
+        (prog2
+            (setq f-mod-time (nth 5 (file-attributes f)))
+            (setq newer (or (> (car f-mod-time) (car dir-mod-time))
+                            (and (= (car f-mod-time) (car dir-mod-time))
+                                 (> (car (cdr f-mod-time)) (car (cdr dir-mod-time))))))
+          (if (and (file-readable-p f)
+                   newer)
+              (setq Info-dir-newer-info-files 
+                    (cons f Info-dir-newer-info-files)))))
      (directory-files (file-name-directory file)
                      'fullname
-                     ".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$"
+                     ".*\\.info\\(\\.gz\\|\\.bz2\\|\\.Z\\|-z\\|\\.zip\\)?$"
                      'nosort
                      t))
     Info-dir-newer-info-files))
@@ -1084,22 +1101,22 @@ and `END-INFO-DIR-ENTRY'"
   (let ((tab-width 8)
        (description-col 0)
        len)
-    (mapcar '(lambda (e)
-              (setq e (cdr e))         ; Drop filename
-              (setq len (length (concat (car e)
-                                        (car (cdr e)))))
-              (if (> len description-col)
-                  (setq description-col len)))
+    (mapcar #'(lambda (e)
+               (setq e (cdr e))        ; Drop filename
+               (setq len (length (concat (car e)
+                                         (car (cdr e)))))
+               (if (> len description-col)
+                   (setq description-col len)))
            entries)
     (setq description-col (+ 5 description-col)) 
-    (mapcar '(lambda (e)
-              (setq e (cdr e))         ; Drop filename
-              (insert "* " (car e) ":" (car (cdr e)))
-              (setq e (car (cdr (cdr e))))
-              (while e
-                (indent-to-column description-col)
-                (insert (car e) "\n")
-                (setq e (cdr e))))
+    (mapcar #'(lambda (e)
+               (setq e (cdr e))        ; Drop filename
+               (insert "* " (car e) ":" (car (cdr e)))
+               (setq e (car (cdr (cdr e))))
+               (while e
+                 (indent-to-column description-col)
+                 (insert (car e) "\n")
+                 (setq e (cdr e))))
            entries)
     (insert "\n")))
 
@@ -1130,15 +1147,15 @@ to the value of `Info-save-auto-generated-dir'"
              "Info files in " directory ":\n\n")
       (Info-dump-dir-entries 
        (mapcar 
-       '(lambda (f)
-          (or (Info-extract-dir-entry-from f)
-              (list 'dummy
-                    (progn 
-                      (string-match "\\(.*\\)\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$" 
-                                    (file-name-nondirectory f))
-                      (capitalize (match-string 1 (file-name-nondirectory f))))
-                    ":"
-                    (list Info-no-description-string))))
+       #'(lambda (f)
+           (or (Info-extract-dir-entry-from f)
+               (list 'dummy
+                     (progn 
+                       (string-match "\\(.*\\)\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$" 
+                                     (file-name-nondirectory f))
+                       (capitalize (match-string 1 (file-name-nondirectory f))))
+                     ":"
+                     (list Info-no-description-string))))
        info-files))
       (if to-temp
          (set-buffer-modified-p nil)
@@ -1195,33 +1212,34 @@ the value of `Info-save-auto-generated-dir' "
            (narrow-to-region mark next-section)
            (setq dir-section-contents (nreverse (Info-parse-dir-entries (point-min)
                                                                         (point-max))))
-           (mapcar '(lambda (file)
-                      (setq dir-entry (assoc (downcase
-                                              (file-name-sans-extension
-                                               (file-name-nondirectory file)))
-                                             dir-section-contents)
-                            file-dir-entry (Info-extract-dir-entry-from file))
-                      (if dir-entry
-                          (if file-dir-entry
-                              ;; A dir entry in the info file takes precedence over an
-                              ;; existing entry in the dir file
-                              (setcdr dir-entry (cdr file-dir-entry)))
-                        (unless (or not-first-section
-                                    (assoc (downcase
+           (mapcar
+            #'(lambda (file)
+                (setq dir-entry (assoc (downcase
                                         (file-name-sans-extension
                                          (file-name-nondirectory file)))
-                                       dir-full-contents))
-                          (if file-dir-entry
-                              (setq dir-section-contents (cons file-dir-entry
-                                                               dir-section-contents))
-                            (setq dir-section-contents 
-                                  (cons (list 'dummy
-                                              (capitalize (file-name-sans-extension
-                                                           (file-name-nondirectory file)))
-                                              ":"
-                                              (list Info-no-description-string)) 
-                                        dir-section-contents))))))
-                   Info-dir-newer-info-files)
+                                       dir-section-contents)
+                      file-dir-entry (Info-extract-dir-entry-from file))
+                (if dir-entry
+                    (if file-dir-entry
+                        ;; A dir entry in the info file takes precedence over an
+                        ;; existing entry in the dir file
+                        (setcdr dir-entry (cdr file-dir-entry)))
+                  (unless (or not-first-section
+                              (assoc (downcase
+                                      (file-name-sans-extension
+                                       (file-name-nondirectory file)))
+                                     dir-full-contents))
+                    (if file-dir-entry
+                        (setq dir-section-contents (cons file-dir-entry
+                                                         dir-section-contents))
+                      (setq dir-section-contents 
+                            (cons (list 'dummy
+                                        (capitalize (file-name-sans-extension
+                                                     (file-name-nondirectory file)))
+                                        ":"
+                                        (list Info-no-description-string)) 
+                                  dir-section-contents))))))
+            Info-dir-newer-info-files)
            (delete-region (point-min) (point-max))
            (Info-dump-dir-entries (nreverse dir-section-contents))
            (widen)
@@ -1368,15 +1386,12 @@ for; usually a downcased version of NAME."
                           (format (cdr (car suff)) file)
                         (concat (cdr (car suff)) " < " file))))
          (message "%s..." command)
-         (if (eq system-type 'vax-vms)
-             (call-process command nil t nil)
-           (call-process shell-file-name nil t nil "-c" command))
+         (call-process shell-file-name nil t nil "-c" command)
          (message "")
-         (if visit
-             (progn
-               (setq buffer-file-name file)
-               (set-buffer-modified-p nil)
-               (clear-visited-file-modtime))))
+         (when visit
+           (setq buffer-file-name file)
+           (set-buffer-modified-p nil)
+           (clear-visited-file-modtime)))
       (insert-file-contents file visit))))
 
 (defun Info-select-node ()
@@ -1480,12 +1495,10 @@ annotation for any node of any file.  (See `a' and `x' commands.)"
     (or (equal tag "") (Info-find-node nil (format "<<%s>>" tag)))))
 
 ;;;###autoload
-(defun Info-visit-file ()
+(defun Info-visit-file (file)
   "Directly visit an info file."
-  (interactive)
-  (let* ((insert-default-directory nil)
-        (file (read-file-name "Goto Info file: " "" "")))
-    (or (equal file "") (Info-find-node (expand-file-name file) "Top"))))
+  (interactive "fVisit Info file: ")
+  (Info-find-node (expand-file-name file) "Top"))
 
 (defun Info-restore-point (&optional always)
   "Restore point to same location it had last time we were in this node."
@@ -1504,13 +1517,33 @@ annotation for any node of any file.  (See `a' and `x' commands.)"
        (set-window-start (get-buffer-window (current-buffer))
                         (+ (nth 2 entry) (point-min)))))
 
+(defvar Info-read-node-completion-table)
+
+;; This function is used as the "completion table" while reading a node name.
+;; It does completion using the alist in Info-read-node-completion-table
+;; unless STRING starts with an open-paren.
+(defun Info-read-node-name-1 (string predicate code)
+  (let ((no-completion (and (> (length string) 0) (eq (aref string 0) ?\())))
+    (cond ((eq code nil)
+          (if no-completion
+              string
+            (try-completion string Info-read-node-completion-table predicate)))
+         ((eq code t)
+          (if no-completion
+              nil
+            (all-completions string Info-read-node-completion-table predicate)))
+         ((eq code 'lambda)
+          (if no-completion
+              t
+            (assoc string Info-read-node-completion-table))))))
+
 (defun Info-read-node-name (prompt &optional default)
   (Info-setup-initial)
   (let* ((completion-ignore-case t)
-        (nodename (completing-read prompt
-                                   (Info-build-node-completions)
-                                   nil nil nil
-                                   'Info-minibuffer-history)))
+        (Info-read-node-completion-table (Info-build-node-completions))
+        (nodename (completing-read prompt 'Info-read-node-name-1
+                                   nil t nil 'Info-minibuffer-history
+                                   default)))
     (if (equal nodename "")
        (or default
            (Info-read-node-name prompt))
@@ -1537,6 +1570,7 @@ annotation for any node of any file.  (See `a' and `x' commands.)"
       (let ((compl (Info-build-annotation-completions)))
        (save-excursion
          (save-restriction
+           (widen)
            (if (marker-buffer Info-tag-table-marker)
                (progn
                  (set-buffer (marker-buffer Info-tag-table-marker))
@@ -1546,7 +1580,6 @@ annotation for any node of any file.  (See `a' and `x' commands.)"
                          (cons (list (buffer-substring (match-beginning 1)
                                                        (match-end 1)))
                                compl))))
-             (widen)
              (goto-char (point-min))
              (while (search-forward "\n\^_" nil t)
                (forward-line 1)
@@ -1567,11 +1600,15 @@ annotation for any node of any file.  (See `a' and `x' commands.)"
 ;;;###autoload
 (defun Info-search (regexp)
   "Search for REGEXP, starting from point, and select node it's found in."
-  (interactive "sSearch (regexp): ")
-  (if (equal regexp "")
-      (setq regexp Info-last-search)
-    (setq Info-last-search regexp))
-  (with-caps-disable-folding regexp
+  (interactive (list
+               (read-from-minibuffer
+                (if Info-last-search
+                    (format "Search (regexp, default %s): "
+                            Info-last-search)
+                  "Search (regexp): ")
+                nil nil nil nil nil Info-last-search)))
+  (setq Info-last-search regexp)
+  (with-search-caps-disable-folding regexp t
     (let ((found ())
           (onode Info-current-node)
           (ofile Info-current-file)
@@ -1657,7 +1694,7 @@ annotation for any node of any file.  (See `a' and `x' commands.)"
        (skip-chars-forward (concat (or allowedchars "^,\t\n") "("))
        (if (looking-at "(")
           (skip-chars-forward "^)")))
-     (skip-chars-backward " ")
+     (skip-chars-backward " .")
      (point))))
 
 (defun Info-next (&optional n)
@@ -1752,7 +1789,8 @@ NAME may be an abbreviation of the reference name."
                                                  default ") ")
                                        "Follow reference named: ")
                                      completions nil t nil
-                                     'Info-minibuffer-history)))
+                                     'Info-minibuffer-history
+                                     default)))
           (if (and (string= item "") default)
               (list default)
             (list item)))
@@ -1836,7 +1874,19 @@ NAME may be an abbreviation of the reference name."
          (if (looking-at ":")
              (buffer-substring beg (1- (point)))
            (skip-chars-forward " \t\n")
-           (Info-following-node-name (if multi-line "^.,\t" "^.,\t\n"))))
+           ;; Kludge.
+           ;; Allow dots in node name not followed by whitespace.
+           (re-search-forward
+            (concat "\\(([^)]+)[^."
+                    (if multi-line "" "\n")
+                    "]*\\|\\([^.,\t"
+                    (if multi-line "" "\n")
+                    ;; We consider dots followed by newline as
+                    ;; end of nodename even if multil-line.
+                    ;; Also stops at .).  It is generated by @pxref.
+                    ;; Skips sequential dots.
+                    "]\\|\\.+[^ \t\n)]\\)+\\)"))
+           (match-string 1)))
     (while (setq i (string-match "\n" str i))
       (aset str i ?\ ))
     str))
@@ -1879,7 +1929,8 @@ Completion is allowed, and the menu item point is on is the default."
                                                   default)
                                           "Menu item: ")
                                       completions nil t nil
-                                      'Info-minibuffer-history)))
+                                      'Info-minibuffer-history
+                                      default)))
         ;; we rely on the fact that completing-read accepts an input
         ;; of "" even when the require-match argument is true and ""
         ;; is not a valid possibility
@@ -2055,11 +2106,9 @@ A positive or negative prefix argument moves by multiple screenfuls."
          (progn
            (Info-global-prev)
            (message "Node: %s" Info-current-node)
-           (sit-for 0)
-           ;;(scroll-up 1)   ; work around bug in pos-visible-in-window-p
-           ;;(scroll-down 1)
-           (while (not (pos-visible-in-window-p (point-max)))
-             (scroll-up)))
+           (goto-char (point-max))
+           (recenter -1)
+           (move-to-window-line 0))
        (scroll-down)))))
 
 (defun Info-scroll-prev (arg)
@@ -2069,9 +2118,9 @@ A positive or negative prefix argument moves by multiple screenfuls."
               (not (eq Info-auto-advance t))
               (not (eq last-command this-command)))
          (message "Hit %s again to go to previous node"
-                  (if (= last-command-char 0)
+                  (if (mouse-event-p last-command-event)
                       "mouse button"
-                    (key-description (char-to-string last-command-char))))
+                    (key-description (event-key last-command-event))))
        (Info-page-prev)
        (setq this-command 'Info))
     (scroll-down arg)))
@@ -2088,7 +2137,7 @@ Give a blank topic name to go to the Index node itself."
   (interactive "sIndex topic: ")
   (let ((pattern (format "\n\\* \\([^\n:]*%s[^\n:]*\\):[ \t]*%s"
                         (regexp-quote topic)
-                        "\\([^.\n]*\\)\\.[ t]*\\([0-9]*\\)"))
+                        "\\(.*\\)\\.[ t]*\\([0-9]*\\)$"))
        node)
     (message "Searching index for `%s'..." topic)
     (Info-goto-node "Top")
@@ -2775,6 +2824,7 @@ e Edit the contents of the current node."
   ;; #### The console-on-window-system-p check is to allow this to
   ;; work on tty's.  The real problem here is that featurep really
   ;; needs to have some device/console domain knowledge added to it.
+  (defvar info::toolbar)
   (if (and (featurep 'toolbar)
           (console-on-window-system-p)
           (not Info-inhibit-toolbar))