comparison lisp/info.el @ 292:6cb5e14cd98e r21-0b44

Import from CVS: tag r21-0b44
author cvs
date Mon, 13 Aug 2007 10:37:15 +0200
parents 558f606b08ae
children 4b85ae5eabfb
comparison
equal deleted inserted replaced
291:7aa74ac42bd2 292:6cb5e14cd98e
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 'conservative 390 (defcustom Info-auto-generate-directory 'if-missing
391 "*What to do if the `dir' or `localdir' file needs to be (re)built. 391 "*When to auto generate an info directory listing.
392 Possible values are: 392 Possible values are:
393 `never' never (re)build the `dir' or `localdir' file 393 nil or `never' never auto-generate a directory listing,
394 `always' automatically (re)builds when needed 394 use any existing `dir' or `localdir' file and ignore info
395 `ask' asks the user before (re)building 395 directories containing none
396 `conservative' asks the user before overwriting existing files" 396 `always' auto-generate a directory listing ignoring existing
397 `dir' and `localdir' files
398 `if-missing', the default, auto-generates a directory listing
399 if no `dir' or `localdir' file is present. Otherwise the
400 contents of any of these files is used instead.
401 `if-outdated' auto-generates a directory listing if the `dir'
402 and `localdir' are either inexistent or outdated (touched
403 less recently than an info file in the same directory)."
397 :type '(choice (const :tag "never" never) 404 :type '(choice (const :tag "never" never)
398 (const :tag "always" always) 405 (const :tag "always" always)
399 (const :tag "ask" ask) 406 (const :tag "if-missing" if-missing)
407 (const :tag "if-outdated" if-outdated))
408 :group 'info)
409
410 (defcustom Info-save-auto-generated-dir nil
411 "*Whether an auto-generated info directory listing should be saved.
412 Possible values are:
413 nil or `never', the default, auto-generated info directory
414 information will never be saved.
415 `always', auto-generated info directory information will be saved to
416 a `dir' file in the same directory overwriting it if it exists
417 `conservative', auto-generated info directory information will be saved
418 to a `dir' file in the same directory but the user is asked before
419 overwriting any existing file."
420 :type '(choice (const :tag "never" never)
421 (const :tag "always" always)
400 (const :tag "conservative" conservative)) 422 (const :tag "conservative" conservative))
401 :group 'info) 423 :group 'info)
402 424
403 (defvar Info-emacs-info-file-name "xemacs.info" 425 (defvar Info-emacs-info-file-name "xemacs.info"
404 "The filename of the XEmacs info for 426 "The filename of the XEmacs info for
969 (setq Info-dir-contents (buffer-string))) 991 (setq Info-dir-contents (buffer-string)))
970 (setq default-directory Info-dir-contents-directory) 992 (setq default-directory Info-dir-contents-directory)
971 (setq buffer-file-name (caar Info-dir-file-attributes))) 993 (setq buffer-file-name (caar Info-dir-file-attributes)))
972 994
973 (defun Info-maybe-update-dir (file) 995 (defun Info-maybe-update-dir (file)
974 "Rebuild dir or localdir if it does not exist or is outdated." 996 "Rebuild dir or localdir according to `Info-auto-generate-directory'."
975 (unless (or (eq Info-rebuild-outdated-dir 'never) 997 (unless (or (not (file-exists-p (file-name-directory file)))
976 (not (file-exists-p (file-name-directory file)))
977 (null (directory-files (file-name-directory file) nil "\\.info"))) 998 (null (directory-files (file-name-directory file) nil "\\.info")))
978 (if (not (find-buffer-visiting file)) 999 (if (not (find-buffer-visiting file))
979 (if (not (file-exists-p file)) 1000 (if (not (file-exists-p file))
980 (if (or (eq Info-rebuild-outdated-dir 'always) 1001 (if (or (eq Info-auto-generate-directory 'always)
981 (eq Info-rebuild-outdated-dir 'conservative) 1002 (eq Info-auto-generate-directory 'if-missing))
982 (and (eq Info-rebuild-outdated-dir 'ask) 1003 (Info-build-dir-anew (file-name-directory file)))
983 (y-or-n-p (format "No dir file in %s. Rebuild now ? " 1004 (if (or (eq Info-auto-generate-directory 'always)
984 (file-name-directory file))))) 1005 (and (eq Info-auto-generate-directory 'if-outdated)
985 (Info-build-dir-anew (file-name-directory file) (not (file-writable-p file)))) 1006 (Info-dir-outdated-p file)))
986 (if (Info-dir-outdated-p file) 1007 (Info-rebuild-dir file))))))
987 (if (or (eq Info-rebuild-outdated-dir 'always)
988 (and (eq Info-rebuild-outdated-dir 'conservative)
989 (or (not (file-writable-p file))
990 (y-or-n-p (format "%s is outdated. Rebuild it now ? "
991 (file-name-directory file)))))
992 (and (eq Info-rebuild-outdated-dir 'ask)
993 (y-or-n-p (format "%s is outdated. Rebuild it now ? " file))))
994 (Info-rebuild-dir file (not (file-writable-p file)))))))))
995 1008
996 ;; Record which *.info files are newer than the dir file 1009 ;; Record which *.info files are newer than the dir file
997 (defvar Info-dir-newer-info-files nil) 1010 (defvar Info-dir-newer-info-files nil)
998 1011
999 (defun Info-dir-outdated-p (file) 1012 (defun Info-dir-outdated-p (file)
1089 (setq e (cdr e)))) 1102 (setq e (cdr e))))
1090 entries) 1103 entries)
1091 (insert "\n"))) 1104 (insert "\n")))
1092 1105
1093 1106
1094 (defun Info-build-dir-anew (directory to-temp) 1107 (defun Info-build-dir-anew (directory)
1095 "Build a new info dir file in DIRECTORY" 1108 "Build info directory information for DIRECTORY.
1109 The generated directory listing may be saved to a `dir' according
1110 to the value of `Info-save-auto-generated-dir'"
1096 (save-excursion 1111 (save-excursion
1097 (let ((dirfile (expand-file-name "dir" directory)) 1112 (let* ((dirfile (expand-file-name "dir" directory))
1098 (info-files 1113 (to-temp (or (null Info-save-auto-generated-dir)
1099 (directory-files directory 1114 (eq Info-save-auto-generated-dir 'never)
1100 'fullname 1115 (and (not (file-writable-p dirfile))
1101 ".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$" 1116 (message "File not writable %s. Using temporary." dirfile))))
1102 nil 1117 (info-files
1103 t))) 1118 (directory-files directory
1119 'fullname
1120 ".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$"
1121 nil
1122 t)))
1104 (if to-temp 1123 (if to-temp
1105 (if (not (eq Info-rebuild-outdated-dir 'always)) 1124 (message "Creating temporary dir in %s..." directory)
1106 (display-warning 'info
1107 (format "Missing info dir file in %s" directory)
1108 'notice))
1109 (message "Creating %s..." dirfile)) 1125 (message "Creating %s..." dirfile))
1110 (set-buffer (find-file-noselect dirfile t)) 1126 (set-buffer (find-file-noselect dirfile t))
1111 (setq buffer-read-only nil) 1127 (setq buffer-read-only nil)
1112 (erase-buffer) 1128 (erase-buffer)
1113 (insert Info-dir-prologue 1129 (insert Info-dir-prologue
1126 info-files)) 1142 info-files))
1127 (if to-temp 1143 (if to-temp
1128 (set-buffer-modified-p nil) 1144 (set-buffer-modified-p nil)
1129 (save-buffer)) 1145 (save-buffer))
1130 (if to-temp 1146 (if to-temp
1131 (message "Creating temporary dir...done") 1147 (message "Creating temporary dir in %s...done" directory)
1132 (message "Creating %s...done" dirfile))))) 1148 (message "Creating %s...done" dirfile)))))
1133 1149
1134 1150
1135 (defun Info-rebuild-dir (file to-temp) 1151 (defun Info-rebuild-dir (file)
1136 "Update an existing info dir file after info files have been modified" 1152 "Build info directory information in the directory of dir FILE.
1153 Description of info files are merged from the info files in the
1154 directory and the contents of FILE with the description in info files
1155 taking precedence over descriptions in FILE.
1156 The generated directory listing may be saved to a `dir' according to
1157 the value of `Info-save-auto-generated-dir' "
1137 (save-excursion 1158 (save-excursion
1138 (save-restriction 1159 (save-restriction
1139 (let (dir-section-contents dir-full-contents 1160 (let (dir-section-contents dir-full-contents
1140 dir-entry 1161 dir-entry
1141 file-dir-entry 1162 file-dir-entry
1142 mark next-section 1163 mark next-section
1143 not-first-section) 1164 not-first-section
1165 (to-temp
1166 (or (null Info-save-auto-generated-dir)
1167 (eq Info-save-auto-generated-dir 'never)
1168 (and (eq Info-save-auto-generated-dir 'always)
1169 (not (file-writable-p file))
1170 (message "File not writable %s. Using temporary." file))
1171 (and (eq Info-save-auto-generated-dir 'conservative)
1172 (or (and (not (file-writable-p file))
1173 (message "File not writable %s. Using temporary." file))
1174 (not (y-or-n-p
1175 (message "%s is outdated. Overwrite ? "
1176 file))))))))
1144 (set-buffer (find-file-noselect file t)) 1177 (set-buffer (find-file-noselect file t))
1145 (setq buffer-read-only nil) 1178 (setq buffer-read-only nil)
1146 (if to-temp 1179 (if to-temp
1147 (if (not (eq Info-rebuild-outdated-dir 'always)) 1180 (message "Rebuilding temporary %s..." file)
1148 (display-warning 'info
1149 (format "Outdated info dir file: %s" file)
1150 'notice))
1151 (message "Rebuilding %s..." file)) 1181 (message "Rebuilding %s..." file))
1152 (catch 'done 1182 (catch 'done
1153 (setq buffer-read-only nil) 1183 (setq buffer-read-only nil)
1154 (goto-char (point-min)) 1184 (goto-char (point-min))
1155 (unless (and (search-forward "\^_") 1185 (unless (and (search-forward "\^_")
1203 (setq next-section (or (and (re-search-forward "^[^* \t].*:[ \t]*$" nil t) 1233 (setq next-section (or (and (re-search-forward "^[^* \t].*:[ \t]*$" nil t)
1204 (match-beginning 0)) 1234 (match-beginning 0))
1205 (point-max)))) 1235 (point-max))))
1206 (setq not-first-section t))) 1236 (setq not-first-section t)))
1207 (if to-temp 1237 (if to-temp
1208 (set-buffer-modified-p nil) 1238 (progn
1209 (save-buffer)) 1239 (set-buffer-modified-p nil)
1210 (if to-temp 1240 (message "Rebuilding temporary %s...done" file))
1211 (message "Rebuilding temporary dir...done") 1241 (save-buffer)
1212 (message "Rebuilding %s...done" file)))))) 1242 (message "Rebuilding %s...done" file))))))
1213 1243
1214 ;;;###autoload 1244 ;;;###autoload
1215 (defun Info-batch-rebuild-dir () 1245 (defun Info-batch-rebuild-dir ()
1216 "(Re)build info `dir' files in the directories remaining on the command line. 1246 "(Re)build info `dir' files in the directories remaining on the command line.
1221 ;; command-line-args-left is what is left of the command line (from 1251 ;; command-line-args-left is what is left of the command line (from
1222 ;; startup.el) 1252 ;; startup.el)
1223 (defvar command-line-args-left) ; Avoid 'free variable' warning 1253 (defvar command-line-args-left) ; Avoid 'free variable' warning
1224 (if (not noninteractive) 1254 (if (not noninteractive)
1225 (error "`Info-batch-rebuild-dir' is to be used only with -batch")) 1255 (error "`Info-batch-rebuild-dir' is to be used only with -batch"))
1226 (while command-line-args-left 1256 (let ((Info-save-auto-generated-dir 'always)
1227 (if (not (file-directory-p (car command-line-args-left))) 1257 dir localdir)
1228 (message "Warning: Skipped %s. Not a directory." 1258 (while command-line-args-left
1229 (car command-line-args-left)) 1259 (if (not (file-directory-p (car command-line-args-left)))
1230 (setq dir (expand-file-name "dir" (car command-line-args-left))) 1260 (message "Warning: Skipped %s. Not a directory."
1231 (setq localdir (expand-file-name "localdir" (car command-line-args-left))) 1261 (car command-line-args-left))
1232 (cond 1262 (setq dir (expand-file-name "dir" (car command-line-args-left)))
1233 ((file-exists-p dir) 1263 (setq localdir (expand-file-name "localdir" (car command-line-args-left)))
1234 (Info-rebuild-dir dir nil)) 1264 (cond
1235 ((file-exists-p localdir) 1265 ((file-exists-p dir)
1236 (Info-rebuild-dir localdir nil)) 1266 (Info-rebuild-dir dir))
1237 (t 1267 ((file-exists-p localdir)
1238 (Info-build-dir-anew (car command-line-args-left) nil)))) 1268 (Info-rebuild-dir localdir))
1239 (setq command-line-args-left (cdr command-line-args-left))) 1269 (t
1240 (message "Done") 1270 (Info-build-dir-anew (car command-line-args-left)))))
1241 (kill-emacs 0)) 1271 (setq command-line-args-left (cdr command-line-args-left)))
1272 (message "Done")
1273 (kill-emacs 0)))
1242 1274
1243 (defun Info-history-add (file node point) 1275 (defun Info-history-add (file node point)
1244 (if Info-keeping-history 1276 (if Info-keeping-history
1245 (let* ((name (format "(%s)%s" (Info-file-name-only file) node)) 1277 (let* ((name (format "(%s)%s" (Info-file-name-only file) node))
1246 (found (assoc name Info-history))) 1278 (found (assoc name Info-history)))