Mercurial > hg > xemacs-beta

comparison lisp/info.el @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents b2472a1930f2
children ca9a9ec9c1c1
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
299 ;; Modified 1997-07-10 by Karl M. Hegbloom 299 ;; Modified 1997-07-10 by Karl M. Hegbloom
300 ;; 300 ;;
301 ;; Added `Info-minibuffer-history' 301 ;; Added `Info-minibuffer-history'
302 ;; (also added to defaults in "lisp/utils/savehist.el") 302 ;; (also added to defaults in "lisp/utils/savehist.el")
303 ;; Other changes in main ChangeLog. 303 ;; Other changes in main ChangeLog.
304
305 ;; Modified 1998-03-29 by Oscar Figueiredo
306 ;;
307 ;; Added automatic dir/localdir (re)building capability for directories that
308 ;; contain none or when it has become older than info files in the same
309 ;; directory.
304 310
305 ;; Code: 311 ;; Code:
306 312
307 (defgroup info nil 313 (defgroup info nil
308 "The info package for Emacs." 314 "The info package for Emacs."
377 "*List of additional directories to search for Info documentation 383 "*List of additional directories to search for Info documentation
378 files. These directories are not searched for merging the `dir' 384 files. These directories are not searched for merging the `dir'
379 file. An example might be something like: 385 file. An example might be something like:
380 \"/usr/local/lib/xemacs/packages/lisp/calc/\"" 386 \"/usr/local/lib/xemacs/packages/lisp/calc/\""
381 :type '(repeat directory) 387 :type '(repeat directory)
388 :group 'info)
389
390 (defcustom Info-rebuild-outdated-dir 'ask
391 "*What to do if the `dir' or `localdir' file needs to be (re)built.
392 Possible values are:
393 `never' never (re)build the `dir' or `localdir' file
394 `always' automatically (re)builds when needed
395 `ask' asks the user before (re)building"
396 :type '(choice (const :tag "never" never)
397 (const :tag "always" always)
398 (const :tag "ask" ask))
382 :group 'info) 399 :group 'info)
383 400
384 (defvar Info-emacs-info-file-name "xemacs.info" 401 (defvar Info-emacs-info-file-name "xemacs.info"
385 "The filename of the XEmacs info for 402 "The filename of the XEmacs info for
386 `Info-goto-emacs-command-node' (`\\<help-mode-map>\\[Info-goto-emacs-command-node]')") 403 `Info-goto-emacs-command-node' (`\\<help-mode-map>\\[Info-goto-emacs-command-node]')")
470 (defvar Info-standalone nil 487 (defvar Info-standalone nil
471 "Non-nil if Emacs was started solely as an Info browser.") 488 "Non-nil if Emacs was started solely as an Info browser.")
472 489
473 (defvar Info-in-cross-reference nil) 490 (defvar Info-in-cross-reference nil)
474 (defvar Info-window-configuration nil) 491 (defvar Info-window-configuration nil)
492
493 (defvar Info-dir-prologue "-*- Text -*-
494 This is the file .../info/dir, which contains the topmost node of the
495 Info hierarchy. The first time you invoke Info you start off
496 looking at that node, which is (dir)Top.
497 
498 File: dir Node: Top This is the top of the INFO tree
499 This (the Directory node) gives a menu of major topics.
500
501 * Menu: The list of major topics begins on the next line.
502
503 ")
475 504
476 ;;;###autoload 505 ;;;###autoload
477 (defun info (&optional file) 506 (defun info (&optional file)
478 "Enter Info, the documentation browser. 507 "Enter Info, the documentation browser.
479 Optional argument FILE specifies the file to examine; 508 Optional argument FILE specifies the file to examine;
762 (let ((truename (file-truename (expand-file-name (car dirs))))) 791 (let ((truename (file-truename (expand-file-name (car dirs)))))
763 (or (member truename dirs-done) 792 (or (member truename dirs-done)
764 (member (directory-file-name truename) dirs-done) 793 (member (directory-file-name truename) dirs-done)
765 ;; Try several variants of specified name. 794 ;; Try several variants of specified name.
766 ;; Try upcasing, appending `.info', or both. 795 ;; Try upcasing, appending `.info', or both.
767 (let* (file 796 (let* (buf
797 file
768 (attrs 798 (attrs
769 (or 799 (or
770 (progn (setq file (expand-file-name "dir" truename)) 800 (progn (setq file (expand-file-name "dir" truename))
771 (file-attributes file)) 801 (file-attributes file))
772 (progn (setq file (expand-file-name "DIR" truename)) 802 (progn (setq file (expand-file-name "DIR" truename))
775 (file-attributes file)) 805 (file-attributes file))
776 (progn (setq file (expand-file-name "DIR.INFO" truename)) 806 (progn (setq file (expand-file-name "DIR.INFO" truename))
777 (file-attributes file)) 807 (file-attributes file))
778 (progn (setq file (expand-file-name "localdir" truename)) 808 (progn (setq file (expand-file-name "localdir" truename))
779 (file-attributes file)) 809 (file-attributes file))
810 (progn (setq file (expand-file-name "dir" truename))
811 nil)
780 ))) 812 )))
781 (setq dirs-done 813 (setq dirs-done
782 (cons truename 814 (cons truename
783 (cons (directory-file-name truename) 815 (cons (directory-file-name truename)
784 dirs-done))) 816 dirs-done)))
785 (if attrs 817 (if (not (string= truename
818 (file-truename (car Info-directory-list))))
819 (Info-maybe-update-dir file))
820 (setq attrs (file-attributes file))
821 (if (or (setq buf (find-buffer-visiting file))
822 attrs)
786 (save-excursion 823 (save-excursion
787 (or buffers 824 (or buffers
788 (message "Composing main Info directory...")) 825 (message "Composing main Info directory..."))
789 (set-buffer (generate-new-buffer 826 (set-buffer (or buf
790 (if (string-match "localdir" file) 827 (generate-new-buffer
791 "localdir" 828 (if (string-match "localdir" file)
792 "info dir"))) 829 "localdir"
793 (insert-file-contents file) 830 "info dir"))))
831 (if (not buf)
832 (insert-file-contents file))
794 (if (string-match "localdir" (buffer-name)) 833 (if (string-match "localdir" (buffer-name))
795 (setq lbuffers (cons (current-buffer) lbuffers)) 834 (setq lbuffers (cons (current-buffer) lbuffers))
796 (setq buffers (cons (current-buffer) buffers))) 835 (setq buffers (cons (current-buffer) buffers)))
797 (setq Info-dir-file-attributes 836 (setq Info-dir-file-attributes
798 (cons (cons file attrs) 837 (cons (cons file attrs)
924 (setq lbuffers (cdr lbuffers))) 963 (setq lbuffers (cdr lbuffers)))
925 (message "Composing main Info directory...done")) 964 (message "Composing main Info directory...done"))
926 (setq Info-dir-contents (buffer-string))) 965 (setq Info-dir-contents (buffer-string)))
927 (setq default-directory Info-dir-contents-directory) 966 (setq default-directory Info-dir-contents-directory)
928 (setq buffer-file-name (caar Info-dir-file-attributes))) 967 (setq buffer-file-name (caar Info-dir-file-attributes)))
968
969 (defun Info-maybe-update-dir (file)
970 "Rebuild dir or localdir if it does not exist or is outdated."
971 (unless (or (eq Info-rebuild-outdated-dir 'never)
972 (not (file-exists-p (file-name-directory file)))
973 (null (directory-files (file-name-directory file) nil "\\.info")))
974 (if (not (find-buffer-visiting file))
975 (if (not (file-exists-p file))
976 (if (or (eq Info-rebuild-outdated-dir 'always)
977 (and (eq Info-rebuild-outdated-dir 'ask)
978 (y-or-n-p (format "No dir file in %s. Rebuild now ? " (file-name-directory file)))))
979 (Info-build-dir-anew (file-name-directory file) (not (file-writable-p file))))
980 (if (Info-dir-outdated-p file)
981 (if (or (eq Info-rebuild-outdated-dir 'always)
982 (and (eq Info-rebuild-outdated-dir 'ask)
983 (y-or-n-p (format "%s is outdated. Rebuild now ? " file))))
984 (Info-rebuild-dir file (not (file-writable-p file)))))))))
985
986 ;; Record which *.info files are newer than the dir file
987 (defvar Info-dir-newer-info-files nil)
988
989 (defun Info-dir-outdated-p (file)
990 "Return non-nil if dir or localdir is outdated.
991 dir or localdir are outdated when an *.info file in the same
992 directory has been modified more recently."
993 (let ((dir-mod-time (nth 5 (file-attributes file)))
994 f-mod-time
995 newer)
996 (setq Info-dir-newer-info-files nil)
997 (mapcar
998 '(lambda (f)
999 (prog2
1000 (setq f-mod-time (nth 5 (file-attributes f)))
1001 (setq newer (or (> (car f-mod-time) (car dir-mod-time))
1002 (and (= (car f-mod-time) (car dir-mod-time))
1003 (> (car (cdr f-mod-time)) (car (cdr dir-mod-time))))))
1004 (if (and (file-readable-p f)
1005 newer)
1006 (setq Info-dir-newer-info-files
1007 (cons f Info-dir-newer-info-files)))))
1008 (directory-files (file-name-directory file)
1009 'fullname
1010 ".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$"
1011 'nosort
1012 t))
1013 Info-dir-newer-info-files))
1014
1015 (defun Info-extract-dir-entries-from (file)
1016 "Extract dir entries from the info FILE.
1017 dir entries are delimited by the markers `START-INFO-DIR-ENTRY'
1018 and `END-INFO-DIR-ENTRY'"
1019 (save-excursion
1020 (set-buffer (get-buffer-create " *Info-tmp*"))
1021 (when (file-readable-p file)
1022 (insert-file-contents file nil nil nil t)
1023 (goto-char (point-min))
1024 (let (beg)
1025 (unless (null (re-search-forward "^START-INFO-DIR-ENTRY" nil t))
1026 (forward-line 1)
1027 (setq beg (point))
1028 (unless (null (re-search-forward "^END-INFO-DIR-ENTRY" nil t))
1029 (goto-char (match-beginning 0))
1030 (buffer-substring beg (point))))))))
1031
1032 (defun Info-build-dir-anew (directory to-temp)
1033 "Build a new info dir file in DIRECTORY"
1034 (save-excursion
1035 (let ((dirfile (expand-file-name "dir" directory)))
1036 (if to-temp
1037 (message "Creating temporary dir...")
1038 (message "Creating %s..." dirfile))
1039 (set-buffer (find-file-noselect dirfile))
1040 (erase-buffer)
1041 (insert Info-dir-prologue
1042 "Info files in " directory "\n\n")
1043 (mapcar
1044 '(lambda (f)
1045 (insert (or (Info-extract-dir-entries-from f)
1046 (format "* %s::\t[No description available]\n"
1047 (file-name-sans-extension (file-name-nondirectory f))))))
1048 (directory-files directory
1049 'fullname
1050 ".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$"
1051 nil
1052 t))
1053 (if to-temp
1054 (set-buffer-modified-p nil)
1055 (save-buffer))
1056 (if to-temp
1057 (message "Creating temporary dir...done")
1058 (message "Creating %s...done" dirfile)))))
1059
1060 (defvar Info-dir-entry-matcher "^\\* \\([^:]+\\):\\([ \t]*(\\(.*\\))\\w*\\.\\|:\\)[ \t]+\\(.*\\)$")
1061
1062 (defun Info-parse-dir-entry (entry)
1063 (string-match Info-dir-entry-matcher entry)
1064 (list (match-string 1 entry) (match-string 2 entry) (match-string 4 entry)))
1065
1066 (defun Info-rebuild-dir (file to-temp)
1067 "Update an existing info dir file after info files have been modified"
1068 (save-excursion
1069 (let (dir-contents
1070 dir-entry
1071 file-dir-entry)
1072 (set-buffer (find-file-noselect file))
1073 (if to-temp
1074 (message "Rebuilding temporary dir...")
1075 (message "Rebuilding %s..." file))
1076 (setq buffer-read-only nil)
1077 (goto-char (point-min))
1078 (search-forward "\^_")
1079 (re-search-forward "^\\* Menu:.*$" nil t)
1080 (narrow-to-region (or (and (re-search-forward Info-dir-entry-matcher nil t)
1081 (match-beginning 0))
1082 (point))
1083 (point-max))
1084 (goto-char (point-min))
1085 (while (re-search-forward Info-dir-entry-matcher nil t)
1086 (setq dir-contents (cons (list (downcase (or (match-string 3)
1087 (match-string 1)))
1088 (match-string 1)
1089 (match-string 2)
1090 (match-string 4))
1091 dir-contents)))
1092 (mapcar '(lambda (file)
1093 (setq dir-entry (assoc (downcase
1094 (file-name-sans-extension
1095 (file-name-nondirectory file)))
1096 dir-contents)
1097 file-dir-entry (Info-extract-dir-entries-from file))
1098 (if dir-entry
1099 (if file-dir-entry
1100 ;; A dir entry in the info file takes precedence over an
1101 ;; existing entry in the dir file
1102 (setcdr dir-entry (Info-parse-dir-entry file-dir-entry)))
1103 (if file-dir-entry
1104 (setq dir-contents (cons (cons 'dummy (Info-parse-dir-entry file-dir-entry))
1105 dir-contents))
1106 (setq dir-contents (cons (list 'dummy
1107 (capitalize (file-name-sans-extension
1108 (file-name-nondirectory file)))
1109 ":"
1110 "[No description available]")
1111 dir-contents)))))
1112 Info-dir-newer-info-files)
1113 (delete-region (point-min) (point-max))
1114 (mapcar '(lambda (entry)
1115 (setq entry (cdr entry))
1116 (insert (format "* %s:"
1117 (car entry)))
1118 (setq entry (cdr entry))
1119 (insert (car entry))
1120 (insert "\t" (car (cdr entry)) "\n"))
1121 (nreverse dir-contents))
1122 (widen)
1123 (if to-temp
1124 (set-buffer-modified-p nil)
1125 (save-buffer))
1126 (if to-temp
1127 (message "Rebuilding temporary dir...done")
1128 (message "Rebuilding %s...done" file)))))
1129
929 1130
930 (defun Info-history-add (file node point) 1131 (defun Info-history-add (file node point)
931 (if Info-keeping-history 1132 (if Info-keeping-history
932 (let* ((name (format "(%s)%s" (Info-file-name-only file) node)) 1133 (let* ((name (format "(%s)%s" (Info-file-name-only file) node))
933 (found (assoc name Info-history))) 1134 (found (assoc name Info-history)))