Mercurial > hg > xemacs-beta

comparison lisp/info.el @ 278:90d73dddcdc4 r21-0b37

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b37
author cvs
date Mon, 13 Aug 2007 10:31:29 +0200
parents ca9a9ec9c1c1
children 558f606b08ae
comparison
equal deleted inserted replaced
277:cfdf3ff11843 278:90d73dddcdc4
976 (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"))) 977 (null (directory-files (file-name-directory file) nil "\\.info")))
978 (if (not (find-buffer-visiting file)) 978 (if (not (find-buffer-visiting file))
979 (if (not (file-exists-p file)) 979 (if (not (file-exists-p file))
980 (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) 981 (eq Info-rebuild-outdated-dir 'conservative)
982 (not (file-writable-p file)))
983 (and (eq Info-rebuild-outdated-dir 'ask) 982 (and (eq Info-rebuild-outdated-dir 'ask)
984 (y-or-n-p (format "No dir file in %s. Rebuild now ? " (file-name-directory file))))) 983 (y-or-n-p (format "No dir file in %s. Rebuild now ? "
984 (file-name-directory file)))))
985 (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))))
986 (if (Info-dir-outdated-p file) 986 (if (Info-dir-outdated-p file)
987 (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) 988 (and (eq Info-rebuild-outdated-dir 'conservative)
989 (not (file-writable-p file))) 989 (or (not (file-writable-p file))
990 (y-or-n-p (format "%s is outdated. Rebuild it now ? "
991 (file-name-directory file)))))
990 (and (eq Info-rebuild-outdated-dir 'ask) 992 (and (eq Info-rebuild-outdated-dir 'ask)
991 (y-or-n-p (format "%s is outdated. Rebuild now ? " file)))) 993 (y-or-n-p (format "%s is outdated. Rebuild it now ? " file))))
992 (Info-rebuild-dir file (not (file-writable-p file))))))))) 994 (Info-rebuild-dir file (not (file-writable-p file)))))))))
993 995
994 ;; Record which *.info files are newer than the dir file 996 ;; Record which *.info files are newer than the dir file
995 (defvar Info-dir-newer-info-files nil) 997 (defvar Info-dir-newer-info-files nil)
996 998
997 (defun Info-dir-outdated-p (file) 999 (defun Info-dir-outdated-p (file)
998 "Return non-nil if dir or localdir is outdated. 1000 "Return non-nil if dir or localdir is outdated.
999 dir or localdir are outdated when a *.info file in the same 1001 dir or localdir are outdated when an info file in the same
1000 directory has been modified more recently." 1002 directory has been modified more recently."
1001 (let ((dir-mod-time (nth 5 (file-attributes file))) 1003 (let ((dir-mod-time (nth 5 (file-attributes file)))
1002 f-mod-time 1004 f-mod-time
1003 newer) 1005 newer)
1004 (setq Info-dir-newer-info-files nil) 1006 (setq Info-dir-newer-info-files nil)
1043 (let (entry entries) 1045 (let (entry entries)
1044 (save-excursion 1046 (save-excursion
1045 (save-restriction 1047 (save-restriction
1046 (narrow-to-region beg end) 1048 (narrow-to-region beg end)
1047 (goto-char beg) 1049 (goto-char beg)
1048 (while (re-search-forward "^\\* \\([^:]+\\):\\([ \t]*(\\(.*\\))\\w*\\.\\|:\\)" nil t) 1050 (while (re-search-forward "^\\* \\([^:]+\\):\\([ \t]*(\\([^)]*\\))\\w*\\.\\|:\\)" nil t)
1049 (setq entry (list (match-string 2) 1051 (setq entry (list (match-string 2)
1050 (match-string 1) 1052 (match-string 1)
1051 (downcase (or (match-string 3) 1053 (downcase (or (match-string 3)
1052 (match-string 1))))) 1054 (match-string 1)))))
1053 (setq entry (cons (nreverse 1055 (setq entry
1054 (cdr 1056 (cons (nreverse
1055 (nreverse 1057 (cdr
1056 (split-string (buffer-substring (re-search-forward "[ \t]*" nil t) 1058 (nreverse
1057 (or (and (re-search-forward "^[^ \t]" nil t) 1059 (split-string
1058 (goto-char (match-beginning 0))) 1060 (buffer-substring
1059 (point-max))) 1061 (re-search-forward "[ \t]*" nil t)
1060 "[ \t]*\n[ \t]*")))) 1062 (or (and (re-search-forward "^[^ \t]" nil t)
1061 entry)) 1063 (goto-char (match-beginning 0)))
1064 (point-max)))
1065 "[ \t]*\n[ \t]*"))))
1066 entry))
1062 (setq entries (cons (nreverse entry) entries))))) 1067 (setq entries (cons (nreverse entry) entries)))))
1063 (nreverse entries))) 1068 (nreverse entries)))
1064 1069
1065 (defun Info-dump-dir-entries (entries) 1070 (defun Info-dump-dir-entries (entries)
1066 (let ((tab-width 8) 1071 (let ((tab-width 8)
1080 (setq e (car (cdr (cdr e)))) 1085 (setq e (car (cdr (cdr e))))
1081 (while e 1086 (while e
1082 (indent-to-column description-col) 1087 (indent-to-column description-col)
1083 (insert (car e) "\n") 1088 (insert (car e) "\n")
1084 (setq e (cdr e)))) 1089 (setq e (cdr e))))
1085 entries))) 1090 entries)
1091 (insert "\n")))
1086 1092
1087 1093
1088 (defun Info-build-dir-anew (directory to-temp) 1094 (defun Info-build-dir-anew (directory to-temp)
1089 "Build a new info dir file in DIRECTORY" 1095 "Build a new info dir file in DIRECTORY"
1090 (save-excursion 1096 (save-excursion
1094 'fullname 1100 'fullname
1095 ".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$" 1101 ".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$"
1096 nil 1102 nil
1097 t))) 1103 t)))
1098 (if to-temp 1104 (if to-temp
1099 (display-warning 'info (format "Missing info dir file in %s" directory) 'notice) 1105 (if (not (eq Info-rebuild-outdated-dir 'always))
1106 (display-warning 'info
1107 (format "Missing info dir file in %s" directory)
1108 'notice))
1100 (message "Creating %s..." dirfile)) 1109 (message "Creating %s..." dirfile))
1101 (set-buffer (find-file-noselect dirfile t)) 1110 (set-buffer (find-file-noselect dirfile t))
1102 (setq buffer-read-only nil) 1111 (setq buffer-read-only nil)
1103 (erase-buffer) 1112 (erase-buffer)
1104 (insert Info-dir-prologue 1113 (insert Info-dir-prologue
1106 (Info-dump-dir-entries 1115 (Info-dump-dir-entries
1107 (mapcar 1116 (mapcar
1108 '(lambda (f) 1117 '(lambda (f)
1109 (or (Info-extract-dir-entry-from f) 1118 (or (Info-extract-dir-entry-from f)
1110 (list 'dummy 1119 (list 'dummy
1111 (file-name-sans-extension (file-name-nondirectory f)) 1120 (progn
1121 (string-match "\\(.*\\)\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$"
1122 (file-name-nondirectory f))
1123 (capitalize (match-string 1 (file-name-nondirectory f))))
1112 ":" 1124 ":"
1113 (list Info-no-description-string)))) 1125 (list Info-no-description-string))))
1114 info-files)) 1126 info-files))
1115 (if to-temp 1127 (if to-temp
1116 (set-buffer-modified-p nil) 1128 (set-buffer-modified-p nil)
1130 mark next-section 1142 mark next-section
1131 not-first-section) 1143 not-first-section)
1132 (set-buffer (find-file-noselect file t)) 1144 (set-buffer (find-file-noselect file t))
1133 (setq buffer-read-only nil) 1145 (setq buffer-read-only nil)
1134 (if to-temp 1146 (if to-temp
1135 (display-warning 'info (format "Outdated info dir file: %s" file) 'notice) 1147 (if (not (eq Info-rebuild-outdated-dir 'always))
1148 (display-warning 'info
1149 (format "Outdated info dir file: %s" file)
1150 'notice))
1136 (message "Rebuilding %s..." file)) 1151 (message "Rebuilding %s..." file))
1137 (catch 'done 1152 (catch 'done
1138 (setq buffer-read-only nil) 1153 (setq buffer-read-only nil)
1139 (goto-char (point-min)) 1154 (goto-char (point-min))
1140 (unless (and (search-forward "\^_") 1155 (unless (and (search-forward "\^_")
1193 (set-buffer-modified-p nil) 1208 (set-buffer-modified-p nil)
1194 (save-buffer)) 1209 (save-buffer))
1195 (if to-temp 1210 (if to-temp
1196 (message "Rebuilding temporary dir...done") 1211 (message "Rebuilding temporary dir...done")
1197 (message "Rebuilding %s...done" file)))))) 1212 (message "Rebuilding %s...done" file))))))
1198 1213
1214 ;;;###autoload
1215 (defun Info-batch-rebuild-dir ()
1216 "(Re)build info `dir' files in the directories remaining on the command line.
1217 Use this from the command line, with `-batch';
1218 it won't work in an interactive Emacs.
1219 Each file is processed even if an error occurred previously.
1220 For example, invoke \"xemacs -batch -f Info-batch-rebuild-dir /usr/local/info\""
1221 ;; command-line-args-left is what is left of the command line (from
1222 ;; startup.el)
1223 (defvar command-line-args-left) ; Avoid 'free variable' warning
1224 (if (not noninteractive)
1225 (error "`Info-batch-rebuild-dir' is to be used only with -batch"))
1226 (while command-line-args-left
1227 (if (not (file-directory-p (car command-line-args-left)))
1228 (message "Warning: Skipped %s. Not a directory."
1229 (car command-line-args-left))
1230 (setq dir (expand-file-name "dir" (car command-line-args-left)))
1231 (setq localdir (expand-file-name "localdir" (car command-line-args-left)))
1232 (cond
1233 ((file-exists-p dir)
1234 (Info-rebuild-dir dir nil))
1235 ((file-exists-p localdir)
1236 (Info-rebuild-dir localdir nil))
1237 (t
1238 (Info-build-dir-anew (car command-line-args-left) nil))))
1239 (setq command-line-args-left (cdr command-line-args-left)))
1240 (message "Done")
1241 (kill-emacs 0))
1199 1242
1200 (defun Info-history-add (file node point) 1243 (defun Info-history-add (file node point)
1201 (if Info-keeping-history 1244 (if Info-keeping-history
1202 (let* ((name (format "(%s)%s" (Info-file-name-only file) node)) 1245 (let* ((name (format "(%s)%s" (Info-file-name-only file) node))
1203 (found (assoc name Info-history))) 1246 (found (assoc name Info-history)))
1266 file file2) 1309 file file2)
1267 (while (and suff (not found)) 1310 (while (and suff (not found))
1268 (setq file (concat name (caar suff)) 1311 (setq file (concat name (caar suff))
1269 file2 (and name2 (concat name2 (caar suff)))) 1312 file2 (and name2 (concat name2 (caar suff))))
1270 (cond 1313 (cond
1271 ((file-exists-p file) 1314 ((file-regular-p file)
1272 (setq found file)) 1315 (setq found file))
1273 ((and file2 (file-exists-p file2)) 1316 ((and file2 (file-regular-p file2))
1274 (setq found file2)) 1317 (setq found file2))
1275 (t 1318 (t
1276 (setq suff (cdr suff))))) 1319 (setq suff (cdr suff)))))
1277 (or found 1320 (or found
1278 (and name (when (file-exists-p name) 1321 (and name (when (file-regular-p name)
1279 name)) 1322 name))
1280 (and name2 (when (file-exists-p name2) 1323 (and name2 (when (file-regular-p name2)
1281 name2))))) 1324 name2)))))
1282 1325
1283 (defun Info-insert-file-contents (file &optional visit) 1326 (defun Info-insert-file-contents (file &optional visit)
1284 (setq file (expand-file-name file default-directory)) 1327 (setq file (expand-file-name file default-directory))
1285 (let ((suff Info-suffix-list)) 1328 (let ((suff Info-suffix-list))
2369 (interactive) 2412 (interactive)
2370 (if Info-standalone 2413 (if Info-standalone
2371 (save-buffers-kill-emacs) 2414 (save-buffers-kill-emacs)
2372 (bury-buffer (current-buffer)) 2415 (bury-buffer (current-buffer))
2373 (if (and (featurep 'toolbar) 2416 (if (and (featurep 'toolbar)
2417 (boundp 'toolbar-info-frame)
2374 (eq toolbar-info-frame (selected-frame))) 2418 (eq toolbar-info-frame (selected-frame)))
2375 (condition-case () 2419 (condition-case ()
2376 (delete-frame toolbar-info-frame) 2420 (delete-frame toolbar-info-frame)
2377 (error (bury-buffer))) 2421 (error (bury-buffer)))
2378 (switch-to-buffer (other-buffer (current-buffer)))))) 2422 (switch-to-buffer (other-buffer (current-buffer))))))