Commit | Line | Data |
---|---|---|
74499542 GM |
1 | ;;; admin.el --- utilities for Emacs administration |
2 | ||
ba318903 | 3 | ;; Copyright (C) 2001-2014 Free Software Foundation, Inc. |
74499542 GM |
4 | |
5 | ;; This file is part of GNU Emacs. | |
6 | ||
9ad5de0c | 7 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
74499542 | 8 | ;; it under the terms of the GNU General Public License as published by |
9ad5de0c GM |
9 | ;; the Free Software Foundation, either version 3 of the License, or |
10 | ;; (at your option) any later version. | |
74499542 GM |
11 | |
12 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;; GNU General Public License for more details. | |
16 | ||
17 | ;; You should have received a copy of the GNU General Public License | |
9ad5de0c | 18 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
74499542 GM |
19 | |
20 | ;;; Commentary: | |
21 | ||
54381691 LK |
22 | ;; add-release-logs Add ``Version X released'' change log entries. |
23 | ;; set-version Change Emacs version number in source tree. | |
dedfb7f8 | 24 | ;; set-copyright Change Emacs short copyright string (eg as |
a3045b7e | 25 | ;; printed by --version) in source tree. |
74499542 GM |
26 | |
27 | ;;; Code: | |
28 | ||
dcddaabb GM |
29 | (defvar add-log-time-format) ; in add-log |
30 | ||
78cd48e7 GM |
31 | ;; Does this information need to be in every ChangeLog, as opposed to |
32 | ;; just the top-level one? Only if you allow changes the same | |
33 | ;; day as the release. | |
34 | ;; http://lists.gnu.org/archive/html/emacs-devel/2013-03/msg00161.html | |
8c39e821 | 35 | (defun add-release-logs (root version &optional date) |
74499542 | 36 | "Add \"Version VERSION released.\" change log entries in ROOT. |
8c39e821 GM |
37 | Root must be the root of an Emacs source tree. |
38 | Optional argument DATE is the release date, default today." | |
39 | (interactive (list (read-directory-name "Emacs root directory: ") | |
40 | (read-string "Version number: " | |
41 | (format "%s.%s" emacs-major-version | |
42 | emacs-minor-version)) | |
43 | (read-string "Release date: " | |
44 | (progn (require 'add-log) | |
1a7bceef GM |
45 | (let ((add-log-time-zone-rule t)) |
46 | (funcall add-log-time-format)))))) | |
3f4a4bdf | 47 | (setq root (expand-file-name root)) |
74499542 | 48 | (unless (file-exists-p (expand-file-name "src/emacs.c" root)) |
dedfb7f8 | 49 | (user-error "%s doesn't seem to be the root of an Emacs source tree" root)) |
54381691 | 50 | (require 'add-log) |
1a7bceef GM |
51 | (or date (setq date (let ((add-log-time-zone-rule t)) |
52 | (funcall add-log-time-format)))) | |
74499542 GM |
53 | (let* ((logs (process-lines "find" root "-name" "ChangeLog")) |
54 | (entry (format "%s %s <%s>\n\n\t* Version %s released.\n\n" | |
8c39e821 | 55 | date |
3f4a4bdf FP |
56 | (or add-log-full-name (user-full-name)) |
57 | (or add-log-mailing-address user-mail-address) | |
58 | version))) | |
74499542 | 59 | (dolist (log logs) |
8c39e821 GM |
60 | (find-file log) |
61 | (goto-char (point-min)) | |
62 | (insert entry)))) | |
74499542 | 63 | |
74499542 | 64 | (defun set-version-in-file (root file version rx) |
0b52b61d | 65 | "Subroutine of `set-version' and `set-copyright'." |
74499542 GM |
66 | (find-file (expand-file-name file root)) |
67 | (goto-char (point-min)) | |
732fbcd9 | 68 | (setq version (format "%s" version)) |
dedfb7f8 XF |
69 | (unless (re-search-forward rx nil :noerror) |
70 | (user-error "Version not found in %s" file)) | |
732fbcd9 GM |
71 | (if (not (equal version (match-string 1))) |
72 | (replace-match version nil nil nil 1) | |
73 | (kill-buffer) | |
74 | (message "No need to update `%s'" file))) | |
74499542 | 75 | |
74499542 GM |
76 | (defun set-version (root version) |
77 | "Set Emacs version to VERSION in relevant files under ROOT. | |
78 | Root must be the root of an Emacs source tree." | |
732fbcd9 GM |
79 | (interactive (list |
80 | (read-directory-name "Emacs root directory: " source-directory) | |
81 | (read-string "Version number: " | |
82 | (replace-regexp-in-string "\\.[0-9]+\\'" "" | |
83 | emacs-version)))) | |
74499542 | 84 | (unless (file-exists-p (expand-file-name "src/emacs.c" root)) |
dedfb7f8 | 85 | (user-error "%s doesn't seem to be the root of an Emacs source tree" root)) |
732fbcd9 | 86 | (message "Setting version numbers...") |
3a79600a XF |
87 | ;; There's also a "version 3" (standing for GPLv3) at the end of |
88 | ;; `README', but since `set-version-in-file' only replaces the first | |
ae93878a | 89 | ;; occurrence, it won't be replaced. |
74499542 GM |
90 | (set-version-in-file root "README" version |
91 | (rx (and "version" (1+ space) | |
92 | (submatch (1+ (in "0-9.")))))) | |
c4444d16 | 93 | (set-version-in-file root "configure.ac" version |
24bbe01e GM |
94 | (rx (and "AC_INIT" (1+ (not (in ?,))) |
95 | ?, (0+ space) | |
96 | (submatch (1+ (in "0-9.")))))) | |
f4f358f1 GM |
97 | (set-version-in-file root "doc/emacs/emacsver.texi" version |
98 | (rx (and "EMACSVER" (1+ space) | |
99 | (submatch (1+ (in "0-9.")))))) | |
adf94aa6 GM |
100 | (set-version-in-file root "doc/man/emacs.1" version |
101 | (rx (and ".TH EMACS" (1+ not-newline) | |
102 | "GNU Emacs" (1+ space) | |
103 | (submatch (1+ (in "0-9.")))))) | |
70b0d280 EZ |
104 | (set-version-in-file root "nt/config.nt" version |
105 | (rx (and bol "#" (0+ blank) "define" (1+ blank) | |
a0c64452 | 106 | "VERSION" (1+ blank) "\"" |
1fe1ef05 | 107 | (submatch (1+ (in "0-9.")))))) |
9d9d12cd EZ |
108 | (set-version-in-file root "msdos/sed2v2.inp" version |
109 | (rx (and bol "/^#undef " (1+ not-newline) | |
a0c64452 | 110 | "define VERSION" (1+ space) "\"" |
9d9d12cd | 111 | (submatch (1+ (in "0-9.")))))) |
e3aef5c6 CS |
112 | (set-version-in-file root "nt/makefile.w32-in" version |
113 | (rx (and "VERSION" (0+ space) "=" (0+ space) | |
114 | (submatch (1+ (in "0-9.")))))) | |
95f76284 JR |
115 | ;; nt/emacs.rc also contains the version number, but in an awkward |
116 | ;; format. It must contain four components, separated by commas, and | |
117 | ;; in two places those commas are followed by space, in two other | |
118 | ;; places they are not. | |
119 | (let* ((version-components (append (split-string version "\\.") | |
fe6462ee | 120 | '("0" "0"))) |
95f76284 JR |
121 | (comma-version |
122 | (concat (car version-components) "," | |
123 | (cadr version-components) "," | |
d0834a5c | 124 | (cadr (cdr version-components)) "," |
95f76284 JR |
125 | (cadr (cdr (cdr version-components))))) |
126 | (comma-space-version | |
127 | (concat (car version-components) ", " | |
128 | (cadr version-components) ", " | |
d0834a5c | 129 | (cadr (cdr version-components)) ", " |
95f76284 JR |
130 | (cadr (cdr (cdr version-components)))))) |
131 | (set-version-in-file root "nt/emacs.rc" comma-version | |
132 | (rx (and "FILEVERSION" (1+ space) | |
133 | (submatch (1+ (in "0-9,")))))) | |
134 | (set-version-in-file root "nt/emacs.rc" comma-version | |
135 | (rx (and "PRODUCTVERSION" (1+ space) | |
136 | (submatch (1+ (in "0-9,")))))) | |
137 | (set-version-in-file root "nt/emacs.rc" comma-space-version | |
138 | (rx (and "\"FileVersion\"" (0+ space) ?, (0+ space) | |
139 | ?\" (submatch (1+ (in "0-9, "))) "\\0\""))) | |
140 | (set-version-in-file root "nt/emacs.rc" comma-space-version | |
141 | (rx (and "\"ProductVersion\"" (0+ space) ?, | |
142 | (0+ space) ?\" (submatch (1+ (in "0-9, "))) | |
b7063e7e JR |
143 | "\\0\""))) |
144 | ;; Likewise for emacsclient.rc | |
145 | (set-version-in-file root "nt/emacsclient.rc" comma-version | |
146 | (rx (and "FILEVERSION" (1+ space) | |
147 | (submatch (1+ (in "0-9,")))))) | |
148 | (set-version-in-file root "nt/emacsclient.rc" comma-version | |
149 | (rx (and "PRODUCTVERSION" (1+ space) | |
150 | (submatch (1+ (in "0-9,")))))) | |
151 | (set-version-in-file root "nt/emacsclient.rc" comma-space-version | |
152 | (rx (and "\"FileVersion\"" (0+ space) ?, (0+ space) | |
153 | ?\" (submatch (1+ (in "0-9, "))) "\\0\""))) | |
154 | (set-version-in-file root "nt/emacsclient.rc" comma-space-version | |
95f76284 JR |
155 | (rx (and "\"ProductVersion\"" (0+ space) ?, |
156 | (0+ space) ?\" (submatch (1+ (in "0-9, "))) | |
dcf8834b | 157 | "\\0\""))) |
eec5fae2 | 158 | ;; Major version only. |
dcf8834b GM |
159 | (when (string-match "\\([0-9]\\{2,\\}\\)" version) |
160 | (setq version (match-string 1 version)) | |
eec5fae2 GM |
161 | (set-version-in-file root "src/msdos.c" version |
162 | (rx (and "Vwindow_system_version" (1+ not-newline) | |
163 | ?\( (submatch (1+ (in "0-9"))) ?\)))) | |
dcf8834b GM |
164 | (set-version-in-file root "etc/refcards/ru-refcard.tex" version |
165 | "\\\\newcommand{\\\\versionemacs}\\[0\\]\ | |
166 | {\\([0-9]\\{2,\\}\\)}.+%.+version of Emacs") | |
167 | (set-version-in-file root "etc/refcards/emacsver.tex" version | |
168 | "\\\\def\\\\versionemacs\ | |
732fbcd9 GM |
169 | {\\([0-9]\\{2,\\}\\)}.+%.+version of Emacs"))) |
170 | (message "Setting version numbers...done")) | |
3f4a4bdf | 171 | |
a3045b7e GM |
172 | ;; Note this makes some assumptions about form of short copyright. |
173 | (defun set-copyright (root copyright) | |
174 | "Set Emacs short copyright to COPYRIGHT in relevant files under ROOT. | |
175 | Root must be the root of an Emacs source tree." | |
176 | (interactive (list | |
177 | (read-directory-name "Emacs root directory: " nil nil t) | |
178 | (read-string | |
179 | "Short copyright string: " | |
180 | (format "Copyright (C) %s Free Software Foundation, Inc." | |
181 | (format-time-string "%Y"))))) | |
182 | (unless (file-exists-p (expand-file-name "src/emacs.c" root)) | |
dedfb7f8 | 183 | (user-error "%s doesn't seem to be the root of an Emacs source tree" root)) |
732fbcd9 | 184 | (message "Setting copyrights...") |
78f83752 GM |
185 | (set-version-in-file root "configure.ac" copyright |
186 | (rx (and bol "copyright" (0+ (not (in ?\"))) | |
287d4c2c | 187 | ?\" (submatch (1+ (not (in ?\")))) ?\"))) |
5ccd466c GM |
188 | (set-version-in-file root "msdos/sed2v2.inp" copyright |
189 | (rx (and bol "/^#undef " (1+ not-newline) | |
190 | "define COPYRIGHT" (1+ space) | |
191 | ?\" (submatch (1+ (not (in ?\")))) ?\"))) | |
78f83752 GM |
192 | (set-version-in-file root "nt/config.nt" copyright |
193 | (rx (and bol "#" (0+ blank) "define" (1+ blank) | |
194 | "COPYRIGHT" (1+ blank) | |
195 | ?\" (submatch (1+ (not (in ?\")))) ?\"))) | |
a3045b7e | 196 | (set-version-in-file root "lib-src/rcs2log" copyright |
287d4c2c GM |
197 | (rx (and "Copyright" (0+ space) ?= (0+ space) |
198 | ?\' (submatch (1+ nonl))))) | |
287d4c2c GM |
199 | (when (string-match "\\([0-9]\\{4\\}\\)" copyright) |
200 | (setq copyright (match-string 1 copyright)) | |
dcf8834b GM |
201 | (set-version-in-file root "etc/refcards/ru-refcard.tex" copyright |
202 | "\\\\newcommand{\\\\cyear}\\[0\\]\ | |
203 | {\\([0-9]\\{4\\}\\)}.+%.+copyright year") | |
204 | (set-version-in-file root "etc/refcards/emacsver.tex" copyright | |
205 | "\\\\def\\\\year\ | |
732fbcd9 GM |
206 | {\\([0-9]\\{4\\}\\)}.+%.+copyright year")) |
207 | (message "Setting copyrights...done")) | |
a3045b7e | 208 | |
8d9101d8 CY |
209 | ;;; Various bits of magic for generating the web manuals |
210 | ||
0773c610 | 211 | (defun manual-misc-manuals (root) |
fe6462ee XF |
212 | "Return doc/misc manuals as list of strings. |
213 | ROOT should be the root of an Emacs source tree." | |
1857cd3f GM |
214 | ;; Similar to `make -C doc/misc echo-info', but works if unconfigured, |
215 | ;; and for INFO_TARGETS rather than INFO_INSTALL. | |
0773c610 GM |
216 | (with-temp-buffer |
217 | (insert-file-contents (expand-file-name "doc/misc/Makefile.in" root)) | |
1857cd3f GM |
218 | ;; Should really use expanded value of INFO_TARGETS. |
219 | (search-forward "INFO_COMMON = ") | |
220 | (let ((start (point))) | |
0773c610 GM |
221 | (end-of-line) |
222 | (while (and (looking-back "\\\\") | |
223 | (zerop (forward-line 1))) | |
224 | (end-of-line)) | |
1857cd3f GM |
225 | (append (split-string (replace-regexp-in-string |
226 | "\\(\\\\\\|\\.info\\)" "" | |
227 | (buffer-substring start (point)))) | |
228 | '("efaq-w32"))))) | |
0773c610 | 229 | |
5cd63720 | 230 | ;; TODO report the progress |
c7197e52 GM |
231 | (defun make-manuals (root &optional type) |
232 | "Generate the web manuals for the Emacs webpage. | |
fe6462ee | 233 | ROOT should be the root of an Emacs source tree. |
c7197e52 GM |
234 | Interactively with a prefix argument, prompt for TYPE. |
235 | Optional argument TYPE is type of output (nil means all)." | |
236 | (interactive (let ((root (read-directory-name "Emacs root directory: " | |
237 | source-directory nil t))) | |
238 | (list root | |
239 | (if current-prefix-arg | |
240 | (completing-read | |
241 | "Type: " | |
242 | (append | |
243 | '("misc" "pdf" "ps") | |
244 | (let (res) | |
245 | (dolist (i '("emacs" "elisp" "eintr") res) | |
246 | (dolist (j '("" "-mono" "-node" "-ps" "-pdf")) | |
247 | (push (concat i j) res)))) | |
248 | (manual-misc-manuals root))))))) | |
8d9101d8 CY |
249 | (let* ((dest (expand-file-name "manual" root)) |
250 | (html-node-dir (expand-file-name "html_node" dest)) | |
251 | (html-mono-dir (expand-file-name "html_mono" dest)) | |
f114e6c3 | 252 | (ps-dir (expand-file-name "ps" dest)) |
c7197e52 GM |
253 | (pdf-dir (expand-file-name "pdf" dest)) |
254 | (emacs (expand-file-name "doc/emacs/emacs.texi" root)) | |
255 | (elisp (expand-file-name "doc/lispref/elisp.texi" root)) | |
256 | (eintr (expand-file-name "doc/lispintro/emacs-lisp-intro.texi" root)) | |
257 | (misc (manual-misc-manuals root))) | |
258 | ;; TODO this makes it non-continuable. | |
259 | ;; Instead, delete the individual dest directory each time. | |
8d9101d8 | 260 | (when (file-directory-p dest) |
c7197e52 | 261 | (if (y-or-n-p (format "Directory %s exists, delete it first? " dest)) |
8d9101d8 | 262 | (delete-directory dest t) |
c7197e52 GM |
263 | (user-error "Aborted"))) |
264 | (if (member type '(nil "emacs" "emacs-node")) | |
265 | (manual-html-node emacs (expand-file-name "emacs" html-node-dir))) | |
266 | (if (member type '(nil "emacs" "emacs-mono")) | |
267 | (manual-html-mono emacs (expand-file-name "emacs.html" html-mono-dir))) | |
268 | (if (member type '(nil "emacs" "emacs-pdf" "pdf")) | |
269 | (manual-pdf emacs (expand-file-name "emacs.pdf" pdf-dir))) | |
270 | (if (member type '(nil "emacs" "emacs-ps" "ps")) | |
271 | (manual-ps emacs (expand-file-name "emacs.ps" ps-dir))) | |
272 | (if (member type '(nil "elisp" "elisp-node")) | |
273 | (manual-html-node elisp (expand-file-name "elisp" html-node-dir))) | |
274 | (if (member type '(nil "elisp" "elisp-mono")) | |
275 | (manual-html-mono elisp (expand-file-name "elisp.html" html-mono-dir))) | |
276 | (if (member type '(nil "elisp" "elisp-pdf" "pdf")) | |
277 | (manual-pdf elisp (expand-file-name "elisp.pdf" pdf-dir))) | |
278 | (if (member type '(nil "elisp" "elisp-ps" "ps")) | |
279 | (manual-ps elisp (expand-file-name "elisp.ps" ps-dir))) | |
280 | (if (member type '(nil "eintr" "eintr-node")) | |
281 | (manual-html-node eintr (expand-file-name "eintr" html-node-dir))) | |
282 | (if (member type '(nil "eintr" "eintr-node")) | |
283 | (manual-html-mono eintr (expand-file-name "eintr.html" html-mono-dir))) | |
284 | (if (member type '(nil "eintr" "eintr-pdf" "pdf")) | |
285 | (manual-pdf eintr (expand-file-name "eintr.pdf" pdf-dir))) | |
286 | (if (member type '(nil "eintr" "eintr-ps" "ps")) | |
287 | (manual-ps eintr (expand-file-name "eintr.ps" ps-dir))) | |
f08b09fc | 288 | ;; Misc manuals |
c7197e52 GM |
289 | (dolist (manual misc) |
290 | (if (member type `(nil ,manual "misc")) | |
291 | (manual-misc-html manual root html-node-dir html-mono-dir))) | |
8d9101d8 CY |
292 | (message "Manuals created in %s" dest))) |
293 | ||
294 | (defconst manual-doctype-string | |
295 | "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" | |
296 | \"http://www.w3.org/TR/html4/loose.dtd\">\n\n") | |
297 | ||
298 | (defconst manual-meta-string | |
299 | "<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\"> | |
300 | <link rev=\"made\" href=\"mailto:webmasters@gnu.org\"> | |
301 | <link rel=\"icon\" type=\"image/png\" href=\"/graphics/gnu-head-mini.png\"> | |
302 | <meta name=\"ICBM\" content=\"42.256233,-71.006581\"> | |
303 | <meta name=\"DC.title\" content=\"gnu.org\">\n\n") | |
304 | ||
305 | (defconst manual-style-string "<style type=\"text/css\"> | |
48dde4df | 306 | @import url('/software/emacs/manual.css');\n</style>\n") |
8d9101d8 | 307 | |
f08b09fc | 308 | (defun manual-misc-html (name root html-node-dir html-mono-dir) |
c7197e52 | 309 | ;; Hack to deal with the cases where .texi creates a different .info. |
278208b8 | 310 | ;; Blech. TODO Why not just rename the .texi (or .info) files? |
c7197e52 | 311 | (let* ((texiname (cond ((equal name "ccmode") "cc-mode") |
c7197e52 GM |
312 | (t name))) |
313 | (texi (expand-file-name (format "doc/misc/%s.texi" texiname) root))) | |
f08b09fc CY |
314 | (manual-html-node texi (expand-file-name name html-node-dir)) |
315 | (manual-html-mono texi (expand-file-name (concat name ".html") | |
316 | html-mono-dir)))) | |
317 | ||
8d9101d8 CY |
318 | (defun manual-html-mono (texi-file dest) |
319 | "Run Makeinfo on TEXI-FILE, emitting mono HTML output to DEST. | |
320 | This function also edits the HTML files so that they validate as | |
321 | HTML 4.01 Transitional, and pulls in the gnu.org stylesheet using | |
322 | the @import directive." | |
c7197e52 | 323 | (make-directory (or (file-name-directory dest) ".") t) |
8d9101d8 | 324 | (call-process "makeinfo" nil nil nil |
c0765905 | 325 | "-D" "WWW_GNU_ORG" |
c69f4673 GM |
326 | "-I" (expand-file-name "../emacs" |
327 | (file-name-directory texi-file)) | |
328 | "-I" (expand-file-name "../misc" | |
329 | (file-name-directory texi-file)) | |
8d9101d8 CY |
330 | "--html" "--no-split" texi-file "-o" dest) |
331 | (with-temp-buffer | |
332 | (insert-file-contents dest) | |
333 | (setq buffer-file-name dest) | |
334 | (manual-html-fix-headers) | |
335 | (manual-html-fix-index-1) | |
336 | (manual-html-fix-index-2 t) | |
337 | (manual-html-fix-node-div) | |
338 | (goto-char (point-max)) | |
339 | (re-search-backward "</body>[\n \t]*</html>") | |
517f20c5 | 340 | ;; Close the div id="content" that fix-index-1 added. |
8d9101d8 CY |
341 | (insert "</div>\n\n") |
342 | (save-buffer))) | |
343 | ||
344 | (defun manual-html-node (texi-file dir) | |
345 | "Run Makeinfo on TEXI-FILE, emitting per-node HTML output to DIR. | |
346 | This function also edits the HTML files so that they validate as | |
347 | HTML 4.01 Transitional, and pulls in the gnu.org stylesheet using | |
348 | the @import directive." | |
349 | (unless (file-exists-p texi-file) | |
fe6462ee | 350 | (user-error "Manual file %s not found" texi-file)) |
c7197e52 | 351 | (make-directory dir t) |
8d9101d8 | 352 | (call-process "makeinfo" nil nil nil |
c0765905 | 353 | "-D" "WWW_GNU_ORG" |
c69f4673 GM |
354 | "-I" (expand-file-name "../emacs" |
355 | (file-name-directory texi-file)) | |
356 | "-I" (expand-file-name "../misc" | |
357 | (file-name-directory texi-file)) | |
8d9101d8 CY |
358 | "--html" texi-file "-o" dir) |
359 | ;; Loop through the node files, fixing them up. | |
360 | (dolist (f (directory-files dir nil "\\.html\\'")) | |
361 | (let (opoint) | |
362 | (with-temp-buffer | |
363 | (insert-file-contents (expand-file-name f dir)) | |
364 | (setq buffer-file-name (expand-file-name f dir)) | |
365 | (if (looking-at "<meta http-equiv") | |
366 | ;; Ignore those HTML files that are just redirects. | |
367 | (set-buffer-modified-p nil) | |
368 | (manual-html-fix-headers) | |
369 | (if (equal f "index.html") | |
370 | (let (copyright-text) | |
371 | (manual-html-fix-index-1) | |
372 | ;; Move copyright notice to the end. | |
f08b09fc CY |
373 | (when (re-search-forward "[ \t]*<p>Copyright ©" nil t) |
374 | (setq opoint (match-beginning 0)) | |
375 | (re-search-forward "</blockquote>") | |
376 | (setq copyright-text (buffer-substring opoint (point))) | |
377 | (delete-region opoint (point))) | |
8d9101d8 | 378 | (manual-html-fix-index-2) |
f08b09fc CY |
379 | (if copyright-text |
380 | (insert copyright-text)) | |
517f20c5 | 381 | ;; Close the div id="content" that fix-index-1 added. |
f08b09fc | 382 | (insert "\n</div>\n")) |
8d9101d8 | 383 | ;; For normal nodes, give the header div a blue bg. |
d16ec91e | 384 | (manual-html-fix-node-div t)) |
8d9101d8 CY |
385 | (save-buffer)))))) |
386 | ||
8d9101d8 | 387 | (defun manual-pdf (texi-file dest) |
fe6462ee | 388 | "Run texi2pdf on TEXI-FILE, emitting PDF output to DEST." |
c7197e52 | 389 | (make-directory (or (file-name-directory dest) ".") t) |
b9a54f5e GM |
390 | (let ((default-directory (file-name-directory texi-file))) |
391 | (call-process "texi2pdf" nil nil nil | |
392 | "-I" "../emacs" "-I" "../misc" | |
393 | texi-file "-o" dest))) | |
8d9101d8 | 394 | |
0cb70db7 GM |
395 | (defun manual-ps (texi-file dest) |
396 | "Generate a PostScript version of TEXI-FILE as DEST." | |
c7197e52 | 397 | (make-directory (or (file-name-directory dest) ".") t) |
b9a54f5e GM |
398 | (let ((dvi-dest (concat (file-name-sans-extension dest) ".dvi")) |
399 | (default-directory (file-name-directory texi-file))) | |
fe6462ee | 400 | ;; FIXME: Use `texi2dvi --ps'? --xfq |
0cb70db7 | 401 | (call-process "texi2dvi" nil nil nil |
b9a54f5e | 402 | "-I" "../emacs" "-I" "../misc" |
0cb70db7 GM |
403 | texi-file "-o" dvi-dest) |
404 | (call-process "dvips" nil nil nil dvi-dest "-o" dest) | |
405 | (delete-file dvi-dest) | |
406 | (call-process "gzip" nil nil nil dest))) | |
8d9101d8 CY |
407 | |
408 | (defun manual-html-fix-headers () | |
409 | "Fix up HTML headers for the Emacs manual in the current buffer." | |
9d1804dc GM |
410 | (let ((texi5 (search-forward "<!DOCTYPE" nil t)) |
411 | opoint) | |
412 | ;; Texinfo 5 supplies a DOCTYPE. | |
413 | (or texi5 | |
414 | (insert manual-doctype-string)) | |
8d9101d8 CY |
415 | (search-forward "<head>\n") |
416 | (insert manual-meta-string) | |
417 | (search-forward "<meta") | |
418 | (setq opoint (match-beginning 0)) | |
9d1804dc GM |
419 | (unless texi5 |
420 | (search-forward "<!--") | |
517f20c5 GM |
421 | (goto-char (match-beginning 0)) |
422 | (delete-region opoint (point)) | |
423 | (search-forward "<meta http-equiv=\"Content-Style") | |
9d1804dc | 424 | (setq opoint (match-beginning 0))) |
8d9101d8 | 425 | (search-forward "</head>") |
9d1804dc GM |
426 | (goto-char (match-beginning 0)) |
427 | (delete-region opoint (point)) | |
517f20c5 GM |
428 | (insert manual-style-string) |
429 | ;; Remove Texinfo 5 hard-coding bgcolor, text, link, vlink, alink. | |
430 | (when (re-search-forward "<body lang=\"[^\"]+\"" nil t) | |
431 | (setq opoint (point)) | |
432 | (search-forward ">") | |
433 | (if (> (point) (1+ opoint)) | |
434 | (delete-region opoint (1- (point)))) | |
435 | (search-backward "</head")))) | |
8d9101d8 | 436 | |
517f20c5 | 437 | ;; Texinfo 5 changed these from class = "node" to "header", yay. |
d16ec91e | 438 | (defun manual-html-fix-node-div (&optional split) |
8d9101d8 | 439 | "Fix up HTML \"node\" divs in the current buffer." |
d16ec91e | 440 | (let (opoint div-end type) |
517f20c5 | 441 | (while (re-search-forward "<div class=\"\\(node\\|header\\)\"\\(>\\)" nil t) |
d16ec91e GM |
442 | (setq type (match-string 1)) |
443 | ;; NB it is this that makes the bg of non-header cells in the | |
444 | ;; index tables be blue. Is that intended? | |
445 | ;; Also, if you don't remove the <hr>, the color of the first | |
446 | ;; row in the table will be wrong. | |
447 | ;; This all seems rather odd to me... | |
517f20c5 | 448 | (replace-match " style=\"background-color:#DDDDFF\">" t t nil 2) |
8d9101d8 | 449 | (setq opoint (point)) |
d16ec91e GM |
450 | (when (or split (equal type "node")) |
451 | ;; In Texinfo 4, the <hr> (and anchor) comes after the <div>. | |
452 | (re-search-forward "</div>") | |
453 | (setq div-end (if (equal type "node") | |
454 | (match-beginning 0) | |
455 | (line-end-position 2))) | |
456 | (goto-char opoint) | |
457 | (if (search-forward "<hr>" div-end 'move) | |
458 | (replace-match "" t t) | |
459 | (if split (forward-line -1)))) | |
460 | ;; In Texinfo 5, the <hr> (and anchor) comes before the <div> (?). | |
461 | ;; Except in split output, where it comes on the line after | |
462 | ;; the <div>. But only sometimes. I have no clue what the | |
463 | ;; logic of where it goes is. | |
464 | (when (equal type "header") | |
465 | (goto-char opoint) | |
466 | (when (re-search-backward "^<hr>$" (line-beginning-position -3) t) | |
467 | (replace-match "") | |
468 | (goto-char opoint)))))) | |
469 | ||
8d9101d8 CY |
470 | |
471 | (defun manual-html-fix-index-1 () | |
517f20c5 GM |
472 | "Remove the h1 header, and the short and long contents lists. |
473 | Also start a \"content\" div." | |
8d9101d8 | 474 | (let (opoint) |
9d1804dc | 475 | (re-search-forward "<body.*>\n") |
f08b09fc | 476 | (setq opoint (match-end 0)) |
517f20c5 GM |
477 | ;; FIXME? Fragile if a Texinfo 5 document does not use @top. |
478 | (or (re-search-forward "<h1 class=\"top\"" nil t) ; Texinfo 5 | |
479 | (search-forward "<h2 class=\"")) | |
8d9101d8 CY |
480 | (goto-char (match-beginning 0)) |
481 | (delete-region opoint (point)) | |
517f20c5 | 482 | ;; NB caller must close this div. |
8d9101d8 CY |
483 | (insert "<div id=\"content\" class=\"inner\">\n\n"))) |
484 | ||
485 | (defun manual-html-fix-index-2 (&optional table-workaround) | |
d16ec91e GM |
486 | "Replace the index list in the current buffer with a HTML table. |
487 | Leave point after the table." | |
517f20c5 | 488 | (if (re-search-forward "<table class=\"menu\"\\(.*\\)>" nil t) |
d16ec91e | 489 | ;; Texinfo 5 already uses a table. Tweak it a bit. |
517f20c5 GM |
490 | (let (opoint done) |
491 | (replace-match " style=\"float:left\" width=\"100%\"" nil t nil 1) | |
d16ec91e GM |
492 | (forward-line 1) |
493 | (while (not done) | |
494 | (cond ((re-search-forward "<tr><td.*• \\(<a.*</a>\\)\ | |
86c6e8fa | 495 | :</td><td> </td><td[^>]*>\\(.*\\)" (line-end-position) t) |
d16ec91e GM |
496 | (replace-match (format "<tr><td%s>\\1</td>\n<td>\\2" |
497 | (if table-workaround | |
498 | " bgcolor=\"white\"" ""))) | |
499 | (search-forward "</td></tr>") | |
500 | (forward-line 1)) | |
501 | ((looking-at "<tr><th.*<pre class=\"menu-comment\">\n") | |
502 | (replace-match "<tr><th colspan=\"2\" align=\"left\" \ | |
503 | style=\"text-align:left\">") | |
504 | (search-forward "</pre></th></tr>") | |
505 | (replace-match "</th></tr>\n")) | |
506 | ;; Not all manuals have the detailed menu. | |
507 | ;; If it is there, split it into a separate table. | |
508 | ((re-search-forward "<tr>.*The Detailed Node Listing *" | |
509 | (line-end-position) t) | |
510 | (setq opoint (match-beginning 0)) | |
511 | (while (and (looking-at " *—") | |
512 | (zerop (forward-line 1)))) | |
513 | (delete-region opoint (point)) | |
514 | (insert "</table>\n\n\ | |
515 | <h2>Detailed Node Listing</h2>\n\n<p>") | |
516 | ;; FIXME Fragile! | |
517 | ;; The Emacs and Elisp manual have some text at the | |
518 | ;; start of the detailed menu that is not part of the menu. | |
519 | ;; Other manuals do not. | |
d16ec91e GM |
520 | (if (re-search-forward "in one step:" (line-end-position 3) t) |
521 | (forward-line 1)) | |
522 | (insert "</p>\n") | |
523 | (search-forward "</pre></th></tr>") | |
524 | (delete-region (match-beginning 0) (match-end 0)) | |
525 | (forward-line -1) | |
526 | (or (looking-at "^$") (error "Parse error 1")) | |
527 | (forward-line -1) | |
528 | (if (looking-at "^$") (error "Parse error 2")) | |
529 | (forward-line -1) | |
530 | (or (looking-at "^$") (error "Parse error 3")) | |
531 | (forward-line 1) | |
532 | (insert "<table class=\"menu\" style=\"float:left\" width=\"100%\">\n\ | |
533 | <tr><th colspan=\"2\" align=\"left\" style=\"text-align:left\">\n") | |
534 | (forward-line 1) | |
535 | (insert "</th></tr>") | |
536 | (forward-line 1)) | |
537 | ((looking-at ".*</table") | |
538 | (forward-line 1) | |
539 | (setq done t))))) | |
517f20c5 GM |
540 | (let (done open-td tag desc) |
541 | ;; Convert the list that Makeinfo made into a table. | |
542 | (or (search-forward "<ul class=\"menu\">" nil t) | |
543 | ;; FIXME? The following search seems dangerously lax. | |
544 | (search-forward "<ul>")) | |
545 | (replace-match "<table style=\"float:left\" width=\"100%\">") | |
546 | (forward-line 1) | |
547 | (while (not done) | |
548 | (cond | |
549 | ((or (looking-at "<li>\\(<a.+</a>\\):[ \t]+\\(.*\\)$") | |
550 | (looking-at "<li>\\(<a.+</a>\\)$")) | |
551 | (setq tag (match-string 1)) | |
552 | (setq desc (match-string 2)) | |
553 | (replace-match "" t t) | |
554 | (when open-td | |
555 | (save-excursion | |
556 | (forward-char -1) | |
557 | (skip-chars-backward " ") | |
558 | (delete-region (point) (line-end-position)) | |
559 | (insert "</td>\n </tr>"))) | |
560 | (insert " <tr>\n ") | |
561 | (if table-workaround | |
562 | ;; This works around a Firefox bug in the mono file. | |
517f20c5 GM |
563 | (insert "<td bgcolor=\"white\">") |
564 | (insert "<td>")) | |
565 | (insert tag "</td>\n <td>" (or desc "")) | |
566 | (setq open-td t)) | |
567 | ((eq (char-after) ?\n) | |
568 | (delete-char 1) | |
569 | ;; Negate the following `forward-line'. | |
570 | (forward-line -1)) | |
571 | ((looking-at "<!-- ") | |
572 | (search-forward "-->")) | |
573 | ((looking-at "<p>[- ]*The Detailed Node Listing[- \n]*") | |
574 | (replace-match " </td></tr></table>\n | |
8d9101d8 | 575 | <h3>Detailed Node Listing</h3>\n\n" t t) |
517f20c5 | 576 | (search-forward "<p>") |
a71324cc GM |
577 | ;; FIXME Fragile! |
578 | ;; The Emacs and Elisp manual have some text at the | |
579 | ;; start of the detailed menu that is not part of the menu. | |
580 | ;; Other manuals do not. | |
581 | (if (looking-at "Here are some other nodes") | |
582 | (search-forward "<p>")) | |
517f20c5 GM |
583 | (goto-char (match-beginning 0)) |
584 | (skip-chars-backward "\n ") | |
585 | (setq open-td nil) | |
586 | (insert "</p>\n\n<table style=\"float:left\" width=\"100%\">")) | |
587 | ((looking-at "</li></ul>") | |
588 | (replace-match "" t t)) | |
589 | ((looking-at "<p>") | |
590 | (replace-match "" t t) | |
591 | (when open-td | |
592 | (insert " </td></tr>") | |
593 | (setq open-td nil)) | |
594 | (insert " <tr> | |
8d9101d8 | 595 | <th colspan=\"2\" align=\"left\" style=\"text-align:left\">") |
517f20c5 GM |
596 | (if (re-search-forward "</p>[ \t\n]*<ul class=\"menu\">" nil t) |
597 | (replace-match " </th></tr>"))) | |
598 | ((looking-at "[ \t]*</ul>[ \t]*$") | |
599 | (replace-match | |
600 | (if open-td | |
601 | " </td></tr>\n</table>" | |
602 | "</table>") t t) | |
603 | (setq done t)) | |
604 | (t | |
605 | (if (eobp) | |
606 | (error "Parse error in %s" | |
607 | (file-name-nondirectory buffer-file-name))) | |
608 | (unless open-td | |
609 | (setq done t)))) | |
610 | (forward-line 1))))) | |
8d9101d8 | 611 | |
58474503 | 612 | \f |
fe6462ee | 613 | ;; Stuff to check new `defcustom's got :version tags. |
58474503 GM |
614 | ;; Adapted from check-declare.el. |
615 | ||
616 | (defun cusver-find-files (root &optional old) | |
fe6462ee XF |
617 | "Find .el files beneath directory ROOT that contain `defcustom's. |
618 | If optional OLD is non-nil, also include `defvar's." | |
58474503 GM |
619 | (process-lines find-program root |
620 | "-name" "*.el" | |
621 | "-exec" grep-program | |
622 | "-l" "-E" (format "^[ \\t]*\\(def%s" | |
623 | (if old "(custom|var)" | |
624 | "custom" | |
625 | )) | |
626 | "{}" "+")) | |
627 | ||
5407f8d2 GM |
628 | (defvar cusver-new-version (format "%s.%s" emacs-major-version |
629 | (1+ emacs-minor-version)) | |
fe6462ee | 630 | "Version number that new `defcustom's should have.") |
1a316a53 | 631 | |
58474503 GM |
632 | (defun cusver-scan (file &optional old) |
633 | "Scan FILE for `defcustom' calls. | |
634 | Return a list with elements of the form (VAR . VER), | |
635 | This means that FILE contains a defcustom for variable VAR, with | |
636 | a :version tag having value VER (may be nil). | |
fe6462ee | 637 | If optional argument OLD is non-nil, also scan for `defvar's." |
58474503 GM |
638 | (let ((m (format "Scanning %s..." file)) |
639 | (re (format "^[ \t]*\\((def%s\\)[ \t\n]" | |
1a316a53 GM |
640 | (if old "\\(custom\\|var\\)" "\\(custom\\|group\\)"))) |
641 | alist var ver form glist grp) | |
58474503 GM |
642 | (message "%s" m) |
643 | (with-temp-buffer | |
644 | (insert-file-contents file) | |
645 | ;; FIXME we could theoretically be inside a string. | |
fe6462ee | 646 | (while (re-search-forward re nil :noerror) |
58474503 GM |
647 | (goto-char (match-beginning 1)) |
648 | (if (and (setq form (ignore-errors (read (current-buffer)))) | |
1a316a53 | 649 | (setq var (car-safe (cdr-safe form))) |
58474503 GM |
650 | ;; Exclude macros, eg (defcustom ,varname ...). |
651 | (symbolp var)) | |
1a316a53 | 652 | (progn |
c62a1961 GM |
653 | ;; FIXME It should be cus-test-apropos that does this. |
654 | (and (not old) | |
655 | (equal "custom" (match-string 2)) | |
656 | (not (memq :type form)) | |
657 | (display-warning 'custom | |
658 | (format "Missing type in: `%s'" form))) | |
1a316a53 GM |
659 | (setq ver (car (cdr-safe (memq :version form)))) |
660 | (if (equal "group" (match-string 2)) | |
661 | ;; Group :version could be old. | |
662 | (if (equal ver cusver-new-version) | |
663 | (setq glist (cons (cons var ver) glist))) | |
664 | ;; If it specifies a group and the whole group has a | |
665 | ;; version. use that. | |
666 | (unless ver | |
667 | (setq grp (car (cdr-safe (memq :group form)))) | |
668 | (and grp | |
669 | (setq grp (car (cdr-safe grp))) ; (quote foo) -> foo | |
670 | (setq ver (assq grp glist)))) | |
671 | (setq alist (cons (cons var ver) alist)))) | |
58474503 GM |
672 | (if form (message "Malformed defcustom: `%s'" form))))) |
673 | (message "%sdone" m) | |
674 | alist)) | |
675 | ||
2c35bdbb GM |
676 | (defun cusver-scan-cus-start (file) |
677 | "Scan cus-start.el and return an alist with elements (VAR . VER)." | |
678 | (if (file-readable-p file) | |
679 | (with-temp-buffer | |
680 | (insert-file-contents file) | |
681 | (when (search-forward "(let ((all '(" nil t) | |
682 | (backward-char 1) | |
683 | (let (var ver alist) | |
684 | (dolist (elem (ignore-errors (read (current-buffer)))) | |
685 | (when (symbolp (setq var (car-safe elem))) | |
686 | (or (stringp (setq ver (nth 3 elem))) | |
687 | (setq ver nil)) | |
688 | (setq alist (cons (cons var ver) alist)))) | |
689 | alist))))) | |
690 | ||
58474503 GM |
691 | (define-button-type 'cusver-xref 'action #'cusver-goto-xref) |
692 | ||
693 | (defun cusver-goto-xref (button) | |
fe6462ee | 694 | "Jump to a Lisp file for the BUTTON at point." |
58474503 GM |
695 | (let ((file (button-get button 'file)) |
696 | (var (button-get button 'var))) | |
697 | (if (not (file-readable-p file)) | |
698 | (message "Cannot read `%s'" file) | |
699 | (with-current-buffer (find-file-noselect file) | |
700 | (goto-char (point-min)) | |
701 | (or (re-search-forward (format "^[ \t]*(defcustom[ \t]*%s" var) nil t) | |
702 | (message "Unable to locate defcustom")) | |
703 | (pop-to-buffer (current-buffer)))))) | |
704 | ||
705 | ;; You should probably at least do a grep over the old directory | |
2c35bdbb GM |
706 | ;; to check the results of this look sensible. |
707 | ;; TODO Check cus-start if something moved from C to Lisp. | |
708 | ;; TODO Handle renamed things with aliases to the old names. | |
1a316a53 | 709 | (defun cusver-check (newdir olddir version) |
fe6462ee XF |
710 | "Check that `defcustom's have :version tags where needed. |
711 | NEWDIR is the current lisp/ directory, OLDDIR is that from the | |
712 | previous release, VERSION is the new version number. A | |
713 | `defcustom' that is only in NEWDIR should have a :version tag. | |
714 | We exclude cases where a `defvar' exists in OLDDIR, since just | |
715 | converting a `defvar' to a `defcustom' does not require | |
716 | a :version bump. | |
58474503 GM |
717 | |
718 | Note that a :version tag should also be added if the value of a defcustom | |
719 | changes (in a non-trivial way). This function does not check for that." | |
c62a1961 GM |
720 | (interactive (list (read-directory-name "New Lisp directory: " nil nil t) |
721 | (read-directory-name "Old Lisp directory: " nil nil t) | |
5407f8d2 GM |
722 | (number-to-string |
723 | (read-number "New version number: " | |
724 | (string-to-number cusver-new-version))))) | |
58474503 | 725 | (or (file-directory-p (setq newdir (expand-file-name newdir))) |
fe6462ee | 726 | (user-error "Directory `%s' not found" newdir)) |
58474503 | 727 | (or (file-directory-p (setq olddir (expand-file-name olddir))) |
fe6462ee | 728 | (user-error "Directory `%s' not found" olddir)) |
1a316a53 | 729 | (setq cusver-new-version version) |
fe6462ee | 730 | (let* ((newfiles (progn (message "Finding new files with `defcustom's...") |
58474503 | 731 | (cusver-find-files newdir))) |
fe6462ee | 732 | (oldfiles (progn (message "Finding old files with `defcustom's...") |
58474503 | 733 | (cusver-find-files olddir t))) |
fe6462ee | 734 | (newcus (progn (message "Reading new `defcustom's...") |
58474503 GM |
735 | (mapcar |
736 | (lambda (file) | |
737 | (cons file (cusver-scan file))) newfiles))) | |
dcf8834b | 738 | oldcus result thisfile file) |
fe6462ee | 739 | (message "Reading old `defcustom's...") |
58474503 GM |
740 | (dolist (file oldfiles) |
741 | (setq oldcus (append oldcus (cusver-scan file t)))) | |
2c35bdbb GM |
742 | (setq oldcus (append oldcus (cusver-scan-cus-start |
743 | (expand-file-name "cus-start.el" olddir)))) | |
58474503 GM |
744 | ;; newcus has elements (FILE (VAR VER) ... ). |
745 | ;; oldcus just (VAR . VER). | |
746 | (message "Checking for version tags...") | |
747 | (dolist (new newcus) | |
748 | (setq file (car new) | |
749 | thisfile | |
750 | (let (missing var) | |
751 | (dolist (cons (cdr new)) | |
752 | (or (cdr cons) | |
753 | (assq (setq var (car cons)) oldcus) | |
754 | (push var missing))) | |
755 | (if missing | |
756 | (cons file missing)))) | |
757 | (if thisfile | |
758 | (setq result (cons thisfile result)))) | |
759 | (message "Checking for version tags... done") | |
760 | (if (not result) | |
761 | (message "No missing :version tags") | |
762 | (pop-to-buffer "*cusver*") | |
763 | (erase-buffer) | |
fe6462ee | 764 | (insert "These `defcustom's might be missing :version tags:\n\n") |
58474503 GM |
765 | (dolist (elem result) |
766 | (let* ((str (file-relative-name (car elem) newdir)) | |
767 | (strlen (length str))) | |
768 | (dolist (var (cdr elem)) | |
769 | (insert (format "%s: %s\n" str var)) | |
770 | (make-text-button (+ (line-beginning-position 0) strlen 2) | |
771 | (line-end-position 0) | |
772 | 'file (car elem) | |
773 | 'var var | |
774 | 'help-echo "Mouse-2: visit this definition" | |
775 | :type 'cusver-xref))))))) | |
776 | ||
69c52df1 GM |
777 | (provide 'admin) |
778 | ||
d3841127 | 779 | ;;; admin.el ends here |