Mercurial > hg > xemacs-beta

comparison lisp/info.el @ 274:ca9a9ec9c1c1 r21-0b35

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b35
author cvs
date Mon, 13 Aug 2007 10:29:42 +0200
parents c5d627a313b1
children 90d73dddcdc4
comparison
equal deleted inserted replaced
273:411aac7253ef 274:ca9a9ec9c1c1
385 file. An example might be something like: 385 file. An example might be something like:
386 \"/usr/local/lib/xemacs/packages/lisp/calc/\"" 386 \"/usr/local/lib/xemacs/packages/lisp/calc/\""
387 :type '(repeat directory) 387 :type '(repeat directory)
388 :group 'info) 388 :group 'info)
389 389
390 (defcustom Info-rebuild-outdated-dir 'ask 390 (defcustom Info-rebuild-outdated-dir 'conservative
391 "*What to do if the `dir' or `localdir' file needs to be (re)built. 391 "*What to do if the `dir' or `localdir' file needs to be (re)built.
392 Possible values are: 392 Possible values are:
393 `never' never (re)build the `dir' or `localdir' file 393 `never' never (re)build the `dir' or `localdir' file
394 `always' automatically (re)builds when needed 394 `always' automatically (re)builds when needed
395 `ask' asks the user before (re)building" 395 `ask' asks the user before (re)building
396 `conservative' asks the user before overwriting existing files"
396 :type '(choice (const :tag "never" never) 397 :type '(choice (const :tag "never" never)
397 (const :tag "always" always) 398 (const :tag "always" always)
398 (const :tag "ask" ask)) 399 (const :tag "ask" ask)
400 (const :tag "conservative" conservative))
399 :group 'info) 401 :group 'info)
400 402
401 (defvar Info-emacs-info-file-name "xemacs.info" 403 (defvar Info-emacs-info-file-name "xemacs.info"
402 "The filename of the XEmacs info for 404 "The filename of the XEmacs info for
403 `Info-goto-emacs-command-node' (`\\<help-mode-map>\\[Info-goto-emacs-command-node]')") 405 `Info-goto-emacs-command-node' (`\\<help-mode-map>\\[Info-goto-emacs-command-node]')")
499 This (the Directory node) gives a menu of major topics. 501 This (the Directory node) gives a menu of major topics.
500 502
501 * Menu: The list of major topics begins on the next line. 503 * Menu: The list of major topics begins on the next line.
502 504
503 ") 505 ")
506
507 (defvar Info-no-description-string "[No description available]"
508 "Description string for info files that have none")
504 509
505 ;;;###autoload 510 ;;;###autoload
506 (defun info (&optional file) 511 (defun info (&optional file)
507 "Enter Info, the documentation browser. 512 "Enter Info, the documentation browser.
508 Optional argument FILE specifies the file to examine; 513 Optional argument FILE specifies the file to examine;
812 ))) 817 )))
813 (setq dirs-done 818 (setq dirs-done
814 (cons truename 819 (cons truename
815 (cons (directory-file-name truename) 820 (cons (directory-file-name truename)
816 dirs-done))) 821 dirs-done)))
817 (if (not (string= truename 822 (Info-maybe-update-dir file)
818 (file-truename (car Info-directory-list))))
819 (Info-maybe-update-dir file))
820 (setq attrs (file-attributes file)) 823 (setq attrs (file-attributes file))
821 (if (or (setq buf (find-buffer-visiting file)) 824 (if (or (setq buf (find-buffer-visiting file))
822 attrs) 825 attrs)
823 (save-excursion 826 (save-excursion
824 (or buffers 827 (or buffers
831 (if (not buf) 834 (if (not buf)
832 (insert-file-contents file)) 835 (insert-file-contents file))
833 (if (string-match "localdir" (buffer-name)) 836 (if (string-match "localdir" (buffer-name))
834 (setq lbuffers (cons (current-buffer) lbuffers)) 837 (setq lbuffers (cons (current-buffer) lbuffers))
835 (setq buffers (cons (current-buffer) buffers))) 838 (setq buffers (cons (current-buffer) buffers)))
836 (setq Info-dir-file-attributes 839 (if attrs
837 (cons (cons file attrs) 840 (setq Info-dir-file-attributes
838 Info-dir-file-attributes)))))) 841 (cons (cons file attrs)
842 Info-dir-file-attributes)))))))
839 (or (cdr dirs) (setq Info-dir-contents-directory (car dirs))) 843 (or (cdr dirs) (setq Info-dir-contents-directory (car dirs)))
840 (setq dirs (cdr dirs)))) 844 (setq dirs (cdr dirs))))
841 845
842 ;; ensure that the localdir files are inserted last, and reverse 846 ;; ensure that the localdir files are inserted last, and reverse
843 ;; the list of them so that when they get pushed in, they appear 847 ;; the list of them so that when they get pushed in, they appear
972 (not (file-exists-p (file-name-directory file))) 976 (not (file-exists-p (file-name-directory file)))
973 (null (directory-files (file-name-directory file) nil "\\.info"))) 977 (null (directory-files (file-name-directory file) nil "\\.info")))
974 (if (not (find-buffer-visiting file)) 978 (if (not (find-buffer-visiting file))
975 (if (not (file-exists-p file)) 979 (if (not (file-exists-p file))
976 (if (or (eq Info-rebuild-outdated-dir 'always) 980 (if (or (eq Info-rebuild-outdated-dir 'always)
981 (and (eq Info-rebuild-outdated-dir 'conservative)
982 (not (file-writable-p file)))
977 (and (eq Info-rebuild-outdated-dir 'ask) 983 (and (eq Info-rebuild-outdated-dir 'ask)
978 (y-or-n-p (format "No dir file in %s. Rebuild now ? " (file-name-directory file))))) 984 (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)))) 985 (Info-build-dir-anew (file-name-directory file) (not (file-writable-p file))))
980 (if (Info-dir-outdated-p file) 986 (if (Info-dir-outdated-p file)
981 (if (or (eq Info-rebuild-outdated-dir 'always) 987 (if (or (eq Info-rebuild-outdated-dir 'always)
988 (and (eq Info-rebuild-outdated-dir 'conservative)
989 (not (file-writable-p file)))
982 (and (eq Info-rebuild-outdated-dir 'ask) 990 (and (eq Info-rebuild-outdated-dir 'ask)
983 (y-or-n-p (format "%s is outdated. Rebuild now ? " file)))) 991 (y-or-n-p (format "%s is outdated. Rebuild now ? " file))))
984 (Info-rebuild-dir file (not (file-writable-p file))))))))) 992 (Info-rebuild-dir file (not (file-writable-p file)))))))))
985 993
986 ;; Record which *.info files are newer than the dir file 994 ;; Record which *.info files are newer than the dir file
987 (defvar Info-dir-newer-info-files nil) 995 (defvar Info-dir-newer-info-files nil)
988 996
989 (defun Info-dir-outdated-p (file) 997 (defun Info-dir-outdated-p (file)
990 "Return non-nil if dir or localdir is outdated. 998 "Return non-nil if dir or localdir is outdated.
991 dir or localdir are outdated when an *.info file in the same 999 dir or localdir are outdated when a *.info file in the same
992 directory has been modified more recently." 1000 directory has been modified more recently."
993 (let ((dir-mod-time (nth 5 (file-attributes file))) 1001 (let ((dir-mod-time (nth 5 (file-attributes file)))
994 f-mod-time 1002 f-mod-time
995 newer) 1003 newer)
996 (setq Info-dir-newer-info-files nil) 1004 (setq Info-dir-newer-info-files nil)
1010 ".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$" 1018 ".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$"
1011 'nosort 1019 'nosort
1012 t)) 1020 t))
1013 Info-dir-newer-info-files)) 1021 Info-dir-newer-info-files))
1014 1022
1015 (defun Info-extract-dir-entries-from (file) 1023 (defun Info-extract-dir-entry-from (file)
1016 "Extract dir entries from the info FILE. 1024 "Extract the dir entry from the info FILE.
1017 dir entries are delimited by the markers `START-INFO-DIR-ENTRY' 1025 The dir entry is delimited by the markers `START-INFO-DIR-ENTRY'
1018 and `END-INFO-DIR-ENTRY'" 1026 and `END-INFO-DIR-ENTRY'"
1019 (save-excursion 1027 (save-excursion
1020 (set-buffer (get-buffer-create " *Info-tmp*")) 1028 (set-buffer (get-buffer-create " *Info-tmp*"))
1021 (when (file-readable-p file) 1029 (when (file-readable-p file)
1022 (insert-file-contents file nil nil nil t) 1030 (insert-file-contents file nil nil nil t)
1025 (unless (null (re-search-forward "^START-INFO-DIR-ENTRY" nil t)) 1033 (unless (null (re-search-forward "^START-INFO-DIR-ENTRY" nil t))
1026 (forward-line 1) 1034 (forward-line 1)
1027 (setq beg (point)) 1035 (setq beg (point))
1028 (unless (null (re-search-forward "^END-INFO-DIR-ENTRY" nil t)) 1036 (unless (null (re-search-forward "^END-INFO-DIR-ENTRY" nil t))
1029 (goto-char (match-beginning 0)) 1037 (goto-char (match-beginning 0))
1030 (buffer-substring beg (point)))))))) 1038 (car (Info-parse-dir-entries beg (point)))))))))
1039
1040 ;; Parse dir entries contained between BEG and END into a list of the form
1041 ;; (filename topic node (description-line-1 description-line-2 ...))
1042 (defun Info-parse-dir-entries (beg end)
1043 (let (entry entries)
1044 (save-excursion
1045 (save-restriction
1046 (narrow-to-region beg end)
1047 (goto-char beg)
1048 (while (re-search-forward "^\\* \\([^:]+\\):\\([ \t]*(\\(.*\\))\\w*\\.\\|:\\)" nil t)
1049 (setq entry (list (match-string 2)
1050 (match-string 1)
1051 (downcase (or (match-string 3)
1052 (match-string 1)))))
1053 (setq entry (cons (nreverse
1054 (cdr
1055 (nreverse
1056 (split-string (buffer-substring (re-search-forward "[ \t]*" nil t)
1057 (or (and (re-search-forward "^[^ \t]" nil t)
1058 (goto-char (match-beginning 0)))
1059 (point-max)))
1060 "[ \t]*\n[ \t]*"))))
1061 entry))
1062 (setq entries (cons (nreverse entry) entries)))))
1063 (nreverse entries)))
1064
1065 (defun Info-dump-dir-entries (entries)
1066 (let ((tab-width 8)
1067 (description-col 0)
1068 len)
1069 (mapcar '(lambda (e)
1070 (setq e (cdr e)) ; Drop filename
1071 (setq len (length (concat (car e)
1072 (car (cdr e)))))
1073 (if (> len description-col)
1074 (setq description-col len)))
1075 entries)
1076 (setq description-col (+ 5 description-col))
1077 (mapcar '(lambda (e)
1078 (setq e (cdr e)) ; Drop filename
1079 (insert "* " (car e) ":" (car (cdr e)))
1080 (setq e (car (cdr (cdr e))))
1081 (while e
1082 (indent-to-column description-col)
1083 (insert (car e) "\n")
1084 (setq e (cdr e))))
1085 entries)))
1086
1031 1087
1032 (defun Info-build-dir-anew (directory to-temp) 1088 (defun Info-build-dir-anew (directory to-temp)
1033 "Build a new info dir file in DIRECTORY" 1089 "Build a new info dir file in DIRECTORY"
1034 (save-excursion 1090 (save-excursion
1035 (let ((dirfile (expand-file-name "dir" directory))) 1091 (let ((dirfile (expand-file-name "dir" directory))
1092 (info-files
1093 (directory-files directory
1094 'fullname
1095 ".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$"
1096 nil
1097 t)))
1036 (if to-temp 1098 (if to-temp
1037 (message "Creating temporary dir...") 1099 (display-warning 'info (format "Missing info dir file in %s" directory) 'notice)
1038 (message "Creating %s..." dirfile)) 1100 (message "Creating %s..." dirfile))
1039 (set-buffer (find-file-noselect dirfile)) 1101 (set-buffer (find-file-noselect dirfile t))
1102 (setq buffer-read-only nil)
1040 (erase-buffer) 1103 (erase-buffer)
1041 (insert Info-dir-prologue 1104 (insert Info-dir-prologue
1042 "Info files in " directory "\n\n") 1105 "Info files in " directory ":\n\n")
1043 (mapcar 1106 (Info-dump-dir-entries
1044 '(lambda (f) 1107 (mapcar
1045 (insert (or (Info-extract-dir-entries-from f) 1108 '(lambda (f)
1046 (format "* %s::\t[No description available]\n" 1109 (or (Info-extract-dir-entry-from f)
1047 (file-name-sans-extension (file-name-nondirectory f)))))) 1110 (list 'dummy
1048 (directory-files directory 1111 (file-name-sans-extension (file-name-nondirectory f))
1049 'fullname 1112 ":"
1050 ".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$" 1113 (list Info-no-description-string))))
1051 nil 1114 info-files))
1052 t))
1053 (if to-temp 1115 (if to-temp
1054 (set-buffer-modified-p nil) 1116 (set-buffer-modified-p nil)
1055 (save-buffer)) 1117 (save-buffer))
1056 (if to-temp 1118 (if to-temp
1057 (message "Creating temporary dir...done") 1119 (message "Creating temporary dir...done")
1058 (message "Creating %s...done" dirfile))))) 1120 (message "Creating %s...done" dirfile)))))
1059 1121
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 1122
1066 (defun Info-rebuild-dir (file to-temp) 1123 (defun Info-rebuild-dir (file to-temp)
1067 "Update an existing info dir file after info files have been modified" 1124 "Update an existing info dir file after info files have been modified"
1068 (save-excursion 1125 (save-excursion
1069 (let (dir-contents 1126 (save-restriction
1070 dir-entry 1127 (let (dir-section-contents dir-full-contents
1071 file-dir-entry) 1128 dir-entry
1072 (set-buffer (find-file-noselect file)) 1129 file-dir-entry
1073 (if to-temp 1130 mark next-section
1074 (message "Rebuilding temporary dir...") 1131 not-first-section)
1075 (message "Rebuilding %s..." file)) 1132 (set-buffer (find-file-noselect file t))
1076 (setq buffer-read-only nil) 1133 (setq buffer-read-only nil)
1077 (goto-char (point-min)) 1134 (if to-temp
1078 (search-forward "\^_") 1135 (display-warning 'info (format "Outdated info dir file: %s" file) 'notice)
1079 (re-search-forward "^\\* Menu:.*$" nil t) 1136 (message "Rebuilding %s..." file))
1080 (narrow-to-region (or (and (re-search-forward Info-dir-entry-matcher nil t) 1137 (catch 'done
1081 (match-beginning 0)) 1138 (setq buffer-read-only nil)
1082 (point)) 1139 (goto-char (point-min))
1083 (point-max)) 1140 (unless (and (search-forward "\^_")
1084 (goto-char (point-min)) 1141 (re-search-forward "^\\* Menu:.*$" nil t)
1085 (while (re-search-forward Info-dir-entry-matcher nil t) 1142 (setq mark (and (re-search-forward "^\\* " nil t)
1086 (setq dir-contents (cons (list (downcase (or (match-string 3) 1143 (match-beginning 0))))
1087 (match-string 1))) 1144 (throw 'done nil))
1088 (match-string 1) 1145 (setq dir-full-contents (Info-parse-dir-entries mark (point-max)))
1089 (match-string 2) 1146 (setq next-section (or (and (re-search-forward "^[^* \t].*:[ \t]*$" nil t)
1090 (match-string 4)) 1147 (match-beginning 0))
1091 dir-contents))) 1148 (point-max)))
1092 (mapcar '(lambda (file) 1149 (while next-section
1093 (setq dir-entry (assoc (downcase 1150 (narrow-to-region mark next-section)
1151 (setq dir-section-contents (nreverse (Info-parse-dir-entries (point-min)
1152 (point-max))))
1153 (mapcar '(lambda (file)
1154 (setq dir-entry (assoc (downcase
1155 (file-name-sans-extension
1156 (file-name-nondirectory file)))
1157 dir-section-contents)
1158 file-dir-entry (Info-extract-dir-entry-from file))
1159 (if dir-entry
1160 (if file-dir-entry
1161 ;; A dir entry in the info file takes precedence over an
1162 ;; existing entry in the dir file
1163 (setcdr dir-entry (cdr file-dir-entry)))
1164 (unless (or not-first-section
1165 (assoc (downcase
1094 (file-name-sans-extension 1166 (file-name-sans-extension
1095 (file-name-nondirectory file))) 1167 (file-name-nondirectory file)))
1096 dir-contents) 1168 dir-full-contents))
1097 file-dir-entry (Info-extract-dir-entries-from file)) 1169 (if file-dir-entry
1098 (if dir-entry 1170 (setq dir-section-contents (cons file-dir-entry
1099 (if file-dir-entry 1171 dir-section-contents))
1100 ;; A dir entry in the info file takes precedence over an 1172 (setq dir-section-contents
1101 ;; existing entry in the dir file 1173 (cons (list 'dummy
1102 (setcdr dir-entry (Info-parse-dir-entry file-dir-entry))) 1174 (capitalize (file-name-sans-extension
1103 (if file-dir-entry 1175 (file-name-nondirectory file)))
1104 (setq dir-contents (cons (cons 'dummy (Info-parse-dir-entry file-dir-entry)) 1176 ":"
1105 dir-contents)) 1177 (list Info-no-description-string))
1106 (setq dir-contents (cons (list 'dummy 1178 dir-section-contents))))))
1107 (capitalize (file-name-sans-extension 1179 Info-dir-newer-info-files)
1108 (file-name-nondirectory file))) 1180 (delete-region (point-min) (point-max))
1109 ":" 1181 (Info-dump-dir-entries (nreverse dir-section-contents))
1110 "[No description available]") 1182 (widen)
1111 dir-contents))))) 1183 (if (= next-section (point-max))
1112 Info-dir-newer-info-files) 1184 (setq next-section nil)
1113 (delete-region (point-min) (point-max)) 1185 (or (setq mark (and (re-search-forward "^\\* " nil t)
1114 (mapcar '(lambda (entry) 1186 (match-beginning 0)))
1115 (setq entry (cdr entry)) 1187 (throw 'done nil))
1116 (insert (format "* %s:" 1188 (setq next-section (or (and (re-search-forward "^[^* \t].*:[ \t]*$" nil t)
1117 (car entry))) 1189 (match-beginning 0))
1118 (setq entry (cdr entry)) 1190 (point-max))))
1119 (insert (car entry)) 1191 (setq not-first-section t)))
1120 (insert "\t" (car (cdr entry)) "\n")) 1192 (if to-temp
1121 (nreverse dir-contents)) 1193 (set-buffer-modified-p nil)
1122 (widen) 1194 (save-buffer))
1123 (if to-temp 1195 (if to-temp
1124 (set-buffer-modified-p nil) 1196 (message "Rebuilding temporary dir...done")
1125 (save-buffer)) 1197 (message "Rebuilding %s...done" file))))))
1126 (if to-temp
1127 (message "Rebuilding temporary dir...done")
1128 (message "Rebuilding %s...done" file)))))
1129 1198
1130 1199
1131 (defun Info-history-add (file node point) 1200 (defun Info-history-add (file node point)
1132 (if Info-keeping-history 1201 (if Info-keeping-history
1133 (let* ((name (format "(%s)%s" (Info-file-name-only file) node)) 1202 (let* ((name (format "(%s)%s" (Info-file-name-only file) node))