Mercurial > hg > xemacs-beta
diff lisp/info.el @ 272:c5d627a313b1 r21-0b34
Import from CVS: tag r21-0b34
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:28:48 +0200 |
parents | b2472a1930f2 |
children | ca9a9ec9c1c1 |
line wrap: on
line diff
--- a/lisp/info.el Mon Aug 13 10:27:41 2007 +0200 +++ b/lisp/info.el Mon Aug 13 10:28:48 2007 +0200 @@ -302,6 +302,12 @@ ;; (also added to defaults in "lisp/utils/savehist.el") ;; Other changes in main ChangeLog. +;; Modified 1998-03-29 by Oscar Figueiredo +;; +;; Added automatic dir/localdir (re)building capability for directories that +;; contain none or when it has become older than info files in the same +;; directory. + ;; Code: (defgroup info nil @@ -381,6 +387,17 @@ :type '(repeat directory) :group 'info) +(defcustom Info-rebuild-outdated-dir 'ask + "*What to do if the `dir' or `localdir' file needs to be (re)built. +Possible values are: +`never' never (re)build the `dir' or `localdir' file +`always' automatically (re)builds when needed +`ask' asks the user before (re)building" + :type '(choice (const :tag "never" never) + (const :tag "always" always) + (const :tag "ask" ask)) + :group 'info) + (defvar Info-emacs-info-file-name "xemacs.info" "The filename of the XEmacs info for `Info-goto-emacs-command-node' (`\\<help-mode-map>\\[Info-goto-emacs-command-node]')") @@ -473,6 +490,18 @@ (defvar Info-in-cross-reference nil) (defvar Info-window-configuration nil) +(defvar Info-dir-prologue "-*- Text -*- +This is the file .../info/dir, which contains the topmost node of the +Info hierarchy. The first time you invoke Info you start off +looking at that node, which is (dir)Top. + +File: dir Node: Top This is the top of the INFO tree + This (the Directory node) gives a menu of major topics. + +* Menu: The list of major topics begins on the next line. + +") + ;;;###autoload (defun info (&optional file) "Enter Info, the documentation browser. @@ -764,7 +793,8 @@ (member (directory-file-name truename) dirs-done) ;; Try several variants of specified name. ;; Try upcasing, appending `.info', or both. - (let* (file + (let* (buf + file (attrs (or (progn (setq file (expand-file-name "dir" truename)) @@ -777,20 +807,29 @@ (file-attributes file)) (progn (setq file (expand-file-name "localdir" truename)) (file-attributes file)) + (progn (setq file (expand-file-name "dir" truename)) + nil) ))) (setq dirs-done (cons truename (cons (directory-file-name truename) dirs-done))) - (if attrs + (if (not (string= truename + (file-truename (car Info-directory-list)))) + (Info-maybe-update-dir file)) + (setq attrs (file-attributes file)) + (if (or (setq buf (find-buffer-visiting file)) + attrs) (save-excursion (or buffers (message "Composing main Info directory...")) - (set-buffer (generate-new-buffer - (if (string-match "localdir" file) - "localdir" - "info dir"))) - (insert-file-contents file) + (set-buffer (or buf + (generate-new-buffer + (if (string-match "localdir" file) + "localdir" + "info dir")))) + (if (not buf) + (insert-file-contents file)) (if (string-match "localdir" (buffer-name)) (setq lbuffers (cons (current-buffer) lbuffers)) (setq buffers (cons (current-buffer) buffers))) @@ -927,6 +966,168 @@ (setq default-directory Info-dir-contents-directory) (setq buffer-file-name (caar Info-dir-file-attributes))) +(defun Info-maybe-update-dir (file) + "Rebuild dir or localdir if it does not exist or is outdated." + (unless (or (eq Info-rebuild-outdated-dir 'never) + (not (file-exists-p (file-name-directory file))) + (null (directory-files (file-name-directory file) nil "\\.info"))) + (if (not (find-buffer-visiting file)) + (if (not (file-exists-p file)) + (if (or (eq Info-rebuild-outdated-dir 'always) + (and (eq Info-rebuild-outdated-dir 'ask) + (y-or-n-p (format "No dir file in %s. Rebuild now ? " (file-name-directory file))))) + (Info-build-dir-anew (file-name-directory file) (not (file-writable-p file)))) + (if (Info-dir-outdated-p file) + (if (or (eq Info-rebuild-outdated-dir 'always) + (and (eq Info-rebuild-outdated-dir 'ask) + (y-or-n-p (format "%s is outdated. Rebuild now ? " file)))) + (Info-rebuild-dir file (not (file-writable-p file))))))))) + +;; Record which *.info files are newer than the dir file +(defvar Info-dir-newer-info-files nil) + +(defun Info-dir-outdated-p (file) + "Return non-nil if dir or localdir is outdated. +dir or localdir are outdated when an *.info file in the same +directory has been modified more recently." + (let ((dir-mod-time (nth 5 (file-attributes file))) + f-mod-time + 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))))) + (directory-files (file-name-directory file) + 'fullname + ".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$" + 'nosort + t)) + Info-dir-newer-info-files)) + +(defun Info-extract-dir-entries-from (file) + "Extract dir entries from the info FILE. +dir entries are delimited by the markers `START-INFO-DIR-ENTRY' +and `END-INFO-DIR-ENTRY'" + (save-excursion + (set-buffer (get-buffer-create " *Info-tmp*")) + (when (file-readable-p file) + (insert-file-contents file nil nil nil t) + (goto-char (point-min)) + (let (beg) + (unless (null (re-search-forward "^START-INFO-DIR-ENTRY" nil t)) + (forward-line 1) + (setq beg (point)) + (unless (null (re-search-forward "^END-INFO-DIR-ENTRY" nil t)) + (goto-char (match-beginning 0)) + (buffer-substring beg (point)))))))) + +(defun Info-build-dir-anew (directory to-temp) + "Build a new info dir file in DIRECTORY" + (save-excursion + (let ((dirfile (expand-file-name "dir" directory))) + (if to-temp + (message "Creating temporary dir...") + (message "Creating %s..." dirfile)) + (set-buffer (find-file-noselect dirfile)) + (erase-buffer) + (insert Info-dir-prologue + "Info files in " directory "\n\n") + (mapcar + '(lambda (f) + (insert (or (Info-extract-dir-entries-from f) + (format "* %s::\t[No description available]\n" + (file-name-sans-extension (file-name-nondirectory f)))))) + (directory-files directory + 'fullname + ".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$" + nil + t)) + (if to-temp + (set-buffer-modified-p nil) + (save-buffer)) + (if to-temp + (message "Creating temporary dir...done") + (message "Creating %s...done" dirfile))))) + +(defvar Info-dir-entry-matcher "^\\* \\([^:]+\\):\\([ \t]*(\\(.*\\))\\w*\\.\\|:\\)[ \t]+\\(.*\\)$") + +(defun Info-parse-dir-entry (entry) + (string-match Info-dir-entry-matcher entry) + (list (match-string 1 entry) (match-string 2 entry) (match-string 4 entry))) + +(defun Info-rebuild-dir (file to-temp) + "Update an existing info dir file after info files have been modified" + (save-excursion + (let (dir-contents + dir-entry + file-dir-entry) + (set-buffer (find-file-noselect file)) + (if to-temp + (message "Rebuilding temporary dir...") + (message "Rebuilding %s..." file)) + (setq buffer-read-only nil) + (goto-char (point-min)) + (search-forward "\^_") + (re-search-forward "^\\* Menu:.*$" nil t) + (narrow-to-region (or (and (re-search-forward Info-dir-entry-matcher nil t) + (match-beginning 0)) + (point)) + (point-max)) + (goto-char (point-min)) + (while (re-search-forward Info-dir-entry-matcher nil t) + (setq dir-contents (cons (list (downcase (or (match-string 3) + (match-string 1))) + (match-string 1) + (match-string 2) + (match-string 4)) + dir-contents))) + (mapcar '(lambda (file) + (setq dir-entry (assoc (downcase + (file-name-sans-extension + (file-name-nondirectory file))) + dir-contents) + file-dir-entry (Info-extract-dir-entries-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 (Info-parse-dir-entry file-dir-entry))) + (if file-dir-entry + (setq dir-contents (cons (cons 'dummy (Info-parse-dir-entry file-dir-entry)) + dir-contents)) + (setq dir-contents (cons (list 'dummy + (capitalize (file-name-sans-extension + (file-name-nondirectory file))) + ":" + "[No description available]") + dir-contents))))) + Info-dir-newer-info-files) + (delete-region (point-min) (point-max)) + (mapcar '(lambda (entry) + (setq entry (cdr entry)) + (insert (format "* %s:" + (car entry))) + (setq entry (cdr entry)) + (insert (car entry)) + (insert "\t" (car (cdr entry)) "\n")) + (nreverse dir-contents)) + (widen) + (if to-temp + (set-buffer-modified-p nil) + (save-buffer)) + (if to-temp + (message "Rebuilding temporary dir...done") + (message "Rebuilding %s...done" file))))) + + (defun Info-history-add (file node point) (if Info-keeping-history (let* ((name (format "(%s)%s" (Info-file-name-only file) node))