X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Finfo.el;h=d90df9558a256043644cbf3beaa579462d6bf596;hp=eb62c6f4d1214db33aa379ad576c8042f6dd5134;hb=b5eeb6918c29470b36f8461c402eb0c65cb19bd2;hpb=72a705551741d6f85a40eea486c222bac482d8dc diff --git a/lisp/info.el b/lisp/info.el index eb62c6f..d90df95 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -308,7 +308,13 @@ ;; contain none or when it has become older than info files in the same ;; directory. +;; Modified 1998-09-23 by Didier Verna +;; +;; 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))