aboutsummaryrefslogtreecommitdiffstats
path: root/admin/admin.el
diff options
context:
space:
mode:
authorJoakim Verona2014-06-04 23:50:06 +0200
committerJoakim Verona2014-06-04 23:50:06 +0200
commitce8171797dafbde765170b79e5f154afc4872e86 (patch)
tree264b357b484de24929a3f2d20a34e0e43c006a15 /admin/admin.el
parentc1c9aa247cab9148916b367e719219ea0f055adb (diff)
parentb5d6fe3bf6e728c82a3ff63723d75519f7853716 (diff)
downloademacs-ce8171797dafbde765170b79e5f154afc4872e86.tar.gz
emacs-ce8171797dafbde765170b79e5f154afc4872e86.zip
upstream
Diffstat (limited to 'admin/admin.el')
-rw-r--r--admin/admin.el369
1 files changed, 247 insertions, 122 deletions
diff --git a/admin/admin.el b/admin/admin.el
index f8ca8aec261..7af9ffa4177 100644
--- a/admin/admin.el
+++ b/admin/admin.el
@@ -1,6 +1,6 @@
1;;; admin.el --- utilities for Emacs administration 1;;; admin.el --- utilities for Emacs administration
2 2
3;; Copyright (C) 2001-2013 Free Software Foundation, Inc. 3;; Copyright (C) 2001-2014 Free Software Foundation, Inc.
4 4
5;; This file is part of GNU Emacs. 5;; This file is part of GNU Emacs.
6 6
@@ -21,7 +21,7 @@
21 21
22;; add-release-logs Add ``Version X released'' change log entries. 22;; add-release-logs Add ``Version X released'' change log entries.
23;; set-version Change Emacs version number in source tree. 23;; set-version Change Emacs version number in source tree.
24;; set-copyright Change emacs short copyright string (eg as 24;; set-copyright Change Emacs short copyright string (eg as
25;; printed by --version) in source tree. 25;; printed by --version) in source tree.
26 26
27;;; Code: 27;;; Code:
@@ -46,7 +46,7 @@ Optional argument DATE is the release date, default today."
46 (funcall add-log-time-format)))))) 46 (funcall add-log-time-format))))))
47 (setq root (expand-file-name root)) 47 (setq root (expand-file-name root))
48 (unless (file-exists-p (expand-file-name "src/emacs.c" root)) 48 (unless (file-exists-p (expand-file-name "src/emacs.c" root))
49 (error "%s doesn't seem to be the root of an Emacs source tree" root)) 49 (user-error "%s doesn't seem to be the root of an Emacs source tree" root))
50 (require 'add-log) 50 (require 'add-log)
51 (or date (setq date (let ((add-log-time-zone-rule t)) 51 (or date (setq date (let ((add-log-time-zone-rule t))
52 (funcall add-log-time-format)))) 52 (funcall add-log-time-format))))
@@ -62,18 +62,31 @@ Optional argument DATE is the release date, default today."
62 (insert entry)))) 62 (insert entry))))
63 63
64(defun set-version-in-file (root file version rx) 64(defun set-version-in-file (root file version rx)
65 "Subroutine of `set-version' and `set-copyright'."
65 (find-file (expand-file-name file root)) 66 (find-file (expand-file-name file root))
66 (goto-char (point-min)) 67 (goto-char (point-min))
67 (unless (re-search-forward rx nil t) 68 (setq version (format "%s" version))
68 (error "Version not found in %s" file)) 69 (unless (re-search-forward rx nil :noerror)
69 (replace-match (format "%s" version) nil nil nil 1)) 70 (user-error "Version not found in %s" file))
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)))
70 75
71(defun set-version (root version) 76(defun set-version (root version)
72 "Set Emacs version to VERSION in relevant files under ROOT. 77 "Set Emacs version to VERSION in relevant files under ROOT.
73Root must be the root of an Emacs source tree." 78Root must be the root of an Emacs source tree."
74 (interactive "DEmacs root directory: \nsVersion number: ") 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))))
75 (unless (file-exists-p (expand-file-name "src/emacs.c" root)) 84 (unless (file-exists-p (expand-file-name "src/emacs.c" root))
76 (error "%s doesn't seem to be the root of an Emacs source tree" root)) 85 (user-error "%s doesn't seem to be the root of an Emacs source tree" root))
86 (message "Setting version numbers...")
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
89 ;; occurrence, it won't be replaced.
77 (set-version-in-file root "README" version 90 (set-version-in-file root "README" version
78 (rx (and "version" (1+ space) 91 (rx (and "version" (1+ space)
79 (submatch (1+ (in "0-9.")))))) 92 (submatch (1+ (in "0-9."))))))
@@ -104,7 +117,7 @@ Root must be the root of an Emacs source tree."
104 ;; in two places those commas are followed by space, in two other 117 ;; in two places those commas are followed by space, in two other
105 ;; places they are not. 118 ;; places they are not.
106 (let* ((version-components (append (split-string version "\\.") 119 (let* ((version-components (append (split-string version "\\.")
107 '("0" "0"))) 120 '("0" "0")))
108 (comma-version 121 (comma-version
109 (concat (car version-components) "," 122 (concat (car version-components) ","
110 (cadr version-components) "," 123 (cadr version-components) ","
@@ -153,8 +166,8 @@ Root must be the root of an Emacs source tree."
153{\\([0-9]\\{2,\\}\\)}.+%.+version of Emacs") 166{\\([0-9]\\{2,\\}\\)}.+%.+version of Emacs")
154 (set-version-in-file root "etc/refcards/emacsver.tex" version 167 (set-version-in-file root "etc/refcards/emacsver.tex" version
155 "\\\\def\\\\versionemacs\ 168 "\\\\def\\\\versionemacs\
156{\\([0-9]\\{2,\\}\\)}.+%.+version of Emacs")))) 169{\\([0-9]\\{2,\\}\\)}.+%.+version of Emacs")))
157 170 (message "Setting version numbers...done"))
158 171
159;; Note this makes some assumptions about form of short copyright. 172;; Note this makes some assumptions about form of short copyright.
160(defun set-copyright (root copyright) 173(defun set-copyright (root copyright)
@@ -167,7 +180,8 @@ Root must be the root of an Emacs source tree."
167 (format "Copyright (C) %s Free Software Foundation, Inc." 180 (format "Copyright (C) %s Free Software Foundation, Inc."
168 (format-time-string "%Y"))))) 181 (format-time-string "%Y")))))
169 (unless (file-exists-p (expand-file-name "src/emacs.c" root)) 182 (unless (file-exists-p (expand-file-name "src/emacs.c" root))
170 (error "%s doesn't seem to be the root of an Emacs source tree" root)) 183 (user-error "%s doesn't seem to be the root of an Emacs source tree" root))
184 (message "Setting copyrights...")
171 (set-version-in-file root "configure.ac" copyright 185 (set-version-in-file root "configure.ac" copyright
172 (rx (and bol "copyright" (0+ (not (in ?\"))) 186 (rx (and bol "copyright" (0+ (not (in ?\")))
173 ?\" (submatch (1+ (not (in ?\")))) ?\"))) 187 ?\" (submatch (1+ (not (in ?\")))) ?\")))
@@ -189,12 +203,14 @@ Root must be the root of an Emacs source tree."
189{\\([0-9]\\{4\\}\\)}.+%.+copyright year") 203{\\([0-9]\\{4\\}\\)}.+%.+copyright year")
190 (set-version-in-file root "etc/refcards/emacsver.tex" copyright 204 (set-version-in-file root "etc/refcards/emacsver.tex" copyright
191 "\\\\def\\\\year\ 205 "\\\\def\\\\year\
192{\\([0-9]\\{4\\}\\)}.+%.+copyright year"))) 206{\\([0-9]\\{4\\}\\)}.+%.+copyright year"))
207 (message "Setting copyrights...done"))
193 208
194;;; Various bits of magic for generating the web manuals 209;;; Various bits of magic for generating the web manuals
195 210
196(defun manual-misc-manuals (root) 211(defun manual-misc-manuals (root)
197 "Return doc/misc manuals as list of strings." 212 "Return doc/misc manuals as list of strings.
213ROOT should be the root of an Emacs source tree."
198 ;; Similar to `make -C doc/misc echo-info', but works if unconfigured, 214 ;; Similar to `make -C doc/misc echo-info', but works if unconfigured,
199 ;; and for INFO_TARGETS rather than INFO_INSTALL. 215 ;; and for INFO_TARGETS rather than INFO_INSTALL.
200 (with-temp-buffer 216 (with-temp-buffer
@@ -211,8 +227,10 @@ Root must be the root of an Emacs source tree."
211 (buffer-substring start (point)))) 227 (buffer-substring start (point))))
212 '("efaq-w32"))))) 228 '("efaq-w32")))))
213 229
230;; TODO report the progress
214(defun make-manuals (root &optional type) 231(defun make-manuals (root &optional type)
215 "Generate the web manuals for the Emacs webpage. 232 "Generate the web manuals for the Emacs webpage.
233ROOT should be the root of an Emacs source tree.
216Interactively with a prefix argument, prompt for TYPE. 234Interactively with a prefix argument, prompt for TYPE.
217Optional argument TYPE is type of output (nil means all)." 235Optional argument TYPE is type of output (nil means all)."
218 (interactive (let ((root (read-directory-name "Emacs root directory: " 236 (interactive (let ((root (read-directory-name "Emacs root directory: "
@@ -319,6 +337,7 @@ the @import directive."
319 (manual-html-fix-node-div) 337 (manual-html-fix-node-div)
320 (goto-char (point-max)) 338 (goto-char (point-max))
321 (re-search-backward "</body>[\n \t]*</html>") 339 (re-search-backward "</body>[\n \t]*</html>")
340 ;; Close the div id="content" that fix-index-1 added.
322 (insert "</div>\n\n") 341 (insert "</div>\n\n")
323 (save-buffer))) 342 (save-buffer)))
324 343
@@ -328,7 +347,7 @@ This function also edits the HTML files so that they validate as
328HTML 4.01 Transitional, and pulls in the gnu.org stylesheet using 347HTML 4.01 Transitional, and pulls in the gnu.org stylesheet using
329the @import directive." 348the @import directive."
330 (unless (file-exists-p texi-file) 349 (unless (file-exists-p texi-file)
331 (error "Manual file %s not found" texi-file)) 350 (user-error "Manual file %s not found" texi-file))
332 (make-directory dir t) 351 (make-directory dir t)
333 (call-process "makeinfo" nil nil nil 352 (call-process "makeinfo" nil nil nil
334 "-D" "WWW_GNU_ORG" 353 "-D" "WWW_GNU_ORG"
@@ -359,13 +378,14 @@ the @import directive."
359 (manual-html-fix-index-2) 378 (manual-html-fix-index-2)
360 (if copyright-text 379 (if copyright-text
361 (insert copyright-text)) 380 (insert copyright-text))
381 ;; Close the div id="content" that fix-index-1 added.
362 (insert "\n</div>\n")) 382 (insert "\n</div>\n"))
363 ;; For normal nodes, give the header div a blue bg. 383 ;; For normal nodes, give the header div a blue bg.
364 (manual-html-fix-node-div)) 384 (manual-html-fix-node-div t))
365 (save-buffer)))))) 385 (save-buffer))))))
366 386
367(defun manual-pdf (texi-file dest) 387(defun manual-pdf (texi-file dest)
368 "Run texi2pdf on TEXI-FILE, emitting pdf output to DEST." 388 "Run texi2pdf on TEXI-FILE, emitting PDF output to DEST."
369 (make-directory (or (file-name-directory dest) ".") t) 389 (make-directory (or (file-name-directory dest) ".") t)
370 (let ((default-directory (file-name-directory texi-file))) 390 (let ((default-directory (file-name-directory texi-file)))
371 (call-process "texi2pdf" nil nil nil 391 (call-process "texi2pdf" nil nil nil
@@ -377,6 +397,7 @@ the @import directive."
377 (make-directory (or (file-name-directory dest) ".") t) 397 (make-directory (or (file-name-directory dest) ".") t)
378 (let ((dvi-dest (concat (file-name-sans-extension dest) ".dvi")) 398 (let ((dvi-dest (concat (file-name-sans-extension dest) ".dvi"))
379 (default-directory (file-name-directory texi-file))) 399 (default-directory (file-name-directory texi-file)))
400 ;; FIXME: Use `texi2dvi --ps'? --xfq
380 (call-process "texi2dvi" nil nil nil 401 (call-process "texi2dvi" nil nil nil
381 "-I" "../emacs" "-I" "../misc" 402 "-I" "../emacs" "-I" "../misc"
382 texi-file "-o" dvi-dest) 403 texi-file "-o" dvi-dest)
@@ -386,119 +407,215 @@ the @import directive."
386 407
387(defun manual-html-fix-headers () 408(defun manual-html-fix-headers ()
388 "Fix up HTML headers for the Emacs manual in the current buffer." 409 "Fix up HTML headers for the Emacs manual in the current buffer."
389 (let (opoint) 410 (let ((texi5 (search-forward "<!DOCTYPE" nil t))
390 (insert manual-doctype-string) 411 opoint)
412 ;; Texinfo 5 supplies a DOCTYPE.
413 (or texi5
414 (insert manual-doctype-string))
391 (search-forward "<head>\n") 415 (search-forward "<head>\n")
392 (insert manual-meta-string) 416 (insert manual-meta-string)
393 (search-forward "<meta") 417 (search-forward "<meta")
394 (setq opoint (match-beginning 0)) 418 (setq opoint (match-beginning 0))
395 (re-search-forward "<!--") 419 (unless texi5
420 (search-forward "<!--")
421 (goto-char (match-beginning 0))
422 (delete-region opoint (point))
423 (search-forward "<meta http-equiv=\"Content-Style")
424 (setq opoint (match-beginning 0)))
425 (search-forward "</head>")
396 (goto-char (match-beginning 0)) 426 (goto-char (match-beginning 0))
397 (delete-region opoint (point)) 427 (delete-region opoint (point))
398 (insert manual-style-string) 428 (insert manual-style-string)
399 (search-forward "<meta http-equiv=\"Content-Style") 429 ;; Remove Texinfo 5 hard-coding bgcolor, text, link, vlink, alink.
400 (setq opoint (match-beginning 0)) 430 (when (re-search-forward "<body lang=\"[^\"]+\"" nil t)
401 (search-forward "</head>") 431 (setq opoint (point))
402 (delete-region opoint (match-beginning 0)))) 432 (search-forward ">")
433 (if (> (point) (1+ opoint))
434 (delete-region opoint (1- (point))))
435 (search-backward "</head"))))
403 436
404(defun manual-html-fix-node-div () 437;; Texinfo 5 changed these from class = "node" to "header", yay.
438(defun manual-html-fix-node-div (&optional split)
405 "Fix up HTML \"node\" divs in the current buffer." 439 "Fix up HTML \"node\" divs in the current buffer."
406 (let (opoint div-end) 440 (let (opoint div-end type)
407 (while (search-forward "<div class=\"node\">" nil t) 441 (while (re-search-forward "<div class=\"\\(node\\|header\\)\"\\(>\\)" nil t)
408 (replace-match 442 (setq type (match-string 1))
409 "<div class=\"node\" style=\"background-color:#DDDDFF\">" 443 ;; NB it is this that makes the bg of non-header cells in the
410 t t) 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...
448 (replace-match " style=\"background-color:#DDDDFF\">" t t nil 2)
411 (setq opoint (point)) 449 (setq opoint (point))
412 (re-search-forward "</div>") 450 (when (or split (equal type "node"))
413 (setq div-end (match-beginning 0)) 451 ;; In Texinfo 4, the <hr> (and anchor) comes after the <div>.
414 (goto-char opoint) 452 (re-search-forward "</div>")
415 (if (search-forward "<hr>" div-end 'move) 453 (setq div-end (if (equal type "node")
416 (replace-match "" t t))))) 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
417 470
418(defun manual-html-fix-index-1 () 471(defun manual-html-fix-index-1 ()
472 "Remove the h1 header, and the short and long contents lists.
473Also start a \"content\" div."
419 (let (opoint) 474 (let (opoint)
420 (re-search-forward "<body>\n") 475 (re-search-forward "<body.*>\n")
421 (setq opoint (match-end 0)) 476 (setq opoint (match-end 0))
422 (search-forward "<h2 class=\"") 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=\""))
423 (goto-char (match-beginning 0)) 480 (goto-char (match-beginning 0))
424 (delete-region opoint (point)) 481 (delete-region opoint (point))
482 ;; NB caller must close this div.
425 (insert "<div id=\"content\" class=\"inner\">\n\n"))) 483 (insert "<div id=\"content\" class=\"inner\">\n\n")))
426 484
427(defun manual-html-fix-index-2 (&optional table-workaround) 485(defun manual-html-fix-index-2 (&optional table-workaround)
428 "Replace the index list in the current buffer with a HTML table." 486 "Replace the index list in the current buffer with a HTML table.
429 (let (done open-td tag desc) 487Leave point after the table."
430 ;; Convert the list that Makeinfo made into a table. 488 (if (re-search-forward "<table class=\"menu\"\\(.*\\)>" nil t)
431 (or (search-forward "<ul class=\"menu\">" nil t) 489 ;; Texinfo 5 already uses a table. Tweak it a bit.
432 (search-forward "<ul>")) 490 (let (opoint done)
433 (replace-match "<table style=\"float:left\" width=\"100%\">") 491 (replace-match " style=\"float:left\" width=\"100%\"" nil t nil 1)
434 (forward-line 1) 492 (forward-line 1)
435 (while (not done) 493 (while (not done)
436 (cond 494 (cond ((re-search-forward "<tr><td.*&bull; \\(<a.*</a>\\)\
437 ((or (looking-at "<li>\\(<a.+</a>\\):[ \t]+\\(.*\\)$") 495:</td><td>&nbsp;&nbsp;</td><td[^>]*>\\(.*\\)" (line-end-position) t)
438 (looking-at "<li>\\(<a.+</a>\\)$")) 496 (replace-match (format "<tr><td%s>\\1</td>\n<td>\\2"
439 (setq tag (match-string 1)) 497 (if table-workaround
440 (setq desc (match-string 2)) 498 " bgcolor=\"white\"" "")))
441 (replace-match "" t t) 499 (search-forward "</td></tr>")
442 (when open-td 500 (forward-line 1))
443 (save-excursion 501 ((looking-at "<tr><th.*<pre class=\"menu-comment\">\n")
444 (forward-char -1) 502 (replace-match "<tr><th colspan=\"2\" align=\"left\" \
445 (skip-chars-backward " ") 503style=\"text-align:left\">")
446 (delete-region (point) (line-end-position)) 504 (search-forward "</pre></th></tr>")
447 (insert "</td>\n </tr>"))) 505 (replace-match "</th></tr>\n"))
448 (insert " <tr>\n ") 506 ;; Not all manuals have the detailed menu.
449 (if table-workaround 507 ;; If it is there, split it into a separate table.
450 ;; This works around a Firefox bug in the mono file. 508 ((re-search-forward "<tr>.*The Detailed Node Listing *"
451 (insert "<td bgcolor=\"white\">") 509 (line-end-position) t)
452 (insert "<td>")) 510 (setq opoint (match-beginning 0))
453 (insert tag "</td>\n <td>" (or desc "")) 511 (while (and (looking-at " *&mdash;")
454 (setq open-td t)) 512 (zerop (forward-line 1))))
455 ((eq (char-after) ?\n) 513 (delete-region opoint (point))
456 (delete-char 1) 514 (insert "</table>\n\n\
457 ;; Negate the following `forward-line'. 515<h2>Detailed Node Listing</h2>\n\n<p>")
458 (forward-line -1)) 516 ;; FIXME Fragile!
459 ((looking-at "<!-- ") 517 ;; The Emacs and Elisp manual have some text at the
460 (search-forward "-->")) 518 ;; start of the detailed menu that is not part of the menu.
461 ((looking-at "<p>[- ]*The Detailed Node Listing[- \n]*") 519 ;; Other manuals do not.
462 (replace-match " </td></tr></table>\n 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)))))
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.
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
463<h3>Detailed Node Listing</h3>\n\n" t t) 575<h3>Detailed Node Listing</h3>\n\n" t t)
464 (search-forward "<p>") 576 (search-forward "<p>")
465 (search-forward "<p>" nil t) 577 ;; FIXME Fragile!
466 (goto-char (match-beginning 0)) 578 ;; The Emacs and Elisp manual have some text at the
467 (skip-chars-backward "\n ") 579 ;; start of the detailed menu that is not part of the menu.
468 (setq open-td nil) 580 ;; Other manuals do not.
469 (insert "</p>\n\n<table style=\"float:left\" width=\"100%\">")) 581 (if (looking-at "Here are some other nodes")
470 ((looking-at "</li></ul>") 582 (search-forward "<p>"))
471 (replace-match "" t t)) 583 (goto-char (match-beginning 0))
472 ((looking-at "<p>") 584 (skip-chars-backward "\n ")
473 (replace-match "" t t) 585 (setq open-td nil)
474 (when open-td 586 (insert "</p>\n\n<table style=\"float:left\" width=\"100%\">"))
475 (insert " </td></tr>") 587 ((looking-at "</li></ul>")
476 (setq open-td nil)) 588 (replace-match "" t t))
477 (insert " <tr> 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>
478 <th colspan=\"2\" align=\"left\" style=\"text-align:left\">") 595 <th colspan=\"2\" align=\"left\" style=\"text-align:left\">")
479 (if (re-search-forward "</p>[ \t\n]*<ul class=\"menu\">" nil t) 596 (if (re-search-forward "</p>[ \t\n]*<ul class=\"menu\">" nil t)
480 (replace-match " </th></tr>"))) 597 (replace-match " </th></tr>")))
481 ((looking-at "[ \t]*</ul>[ \t]*$") 598 ((looking-at "[ \t]*</ul>[ \t]*$")
482 (replace-match 599 (replace-match
483 (if open-td 600 (if open-td
484 " </td></tr>\n</table>" 601 " </td></tr>\n</table>"
485 "</table>") t t) 602 "</table>") t t)
486 (setq done t)) 603 (setq done t))
487 (t 604 (t
488 (if (eobp) 605 (if (eobp)
489 (error "Parse error in %s" 606 (error "Parse error in %s"
490 (file-name-nondirectory buffer-file-name))) 607 (file-name-nondirectory buffer-file-name)))
491 (unless open-td 608 (unless open-td
492 (setq done t)))) 609 (setq done t))))
493 (forward-line 1)))) 610 (forward-line 1)))))
494 611
495 612
496;; Stuff to check new defcustoms got :version tags. 613;; Stuff to check new `defcustom's got :version tags.
497;; Adapted from check-declare.el. 614;; Adapted from check-declare.el.
498 615
499(defun cusver-find-files (root &optional old) 616(defun cusver-find-files (root &optional old)
500 "Find .el files beneath directory ROOT that contain defcustoms. 617 "Find .el files beneath directory ROOT that contain `defcustom's.
501If optional OLD is non-nil, also include defvars." 618If optional OLD is non-nil, also include `defvar's."
502 (process-lines find-program root 619 (process-lines find-program root
503 "-name" "*.el" 620 "-name" "*.el"
504 "-exec" grep-program 621 "-exec" grep-program
@@ -510,14 +627,14 @@ If optional OLD is non-nil, also include defvars."
510 627
511(defvar cusver-new-version (format "%s.%s" emacs-major-version 628(defvar cusver-new-version (format "%s.%s" emacs-major-version
512 (1+ emacs-minor-version)) 629 (1+ emacs-minor-version))
513 "Version number that new defcustoms should have.") 630 "Version number that new `defcustom's should have.")
514 631
515(defun cusver-scan (file &optional old) 632(defun cusver-scan (file &optional old)
516 "Scan FILE for `defcustom' calls. 633 "Scan FILE for `defcustom' calls.
517Return a list with elements of the form (VAR . VER), 634Return a list with elements of the form (VAR . VER),
518This means that FILE contains a defcustom for variable VAR, with 635This means that FILE contains a defcustom for variable VAR, with
519a :version tag having value VER (may be nil). 636a :version tag having value VER (may be nil).
520If optional argument OLD is non-nil, also scan for defvars." 637If optional argument OLD is non-nil, also scan for `defvar's."
521 (let ((m (format "Scanning %s..." file)) 638 (let ((m (format "Scanning %s..." file))
522 (re (format "^[ \t]*\\((def%s\\)[ \t\n]" 639 (re (format "^[ \t]*\\((def%s\\)[ \t\n]"
523 (if old "\\(custom\\|var\\)" "\\(custom\\|group\\)"))) 640 (if old "\\(custom\\|var\\)" "\\(custom\\|group\\)")))
@@ -526,13 +643,19 @@ If optional argument OLD is non-nil, also scan for defvars."
526 (with-temp-buffer 643 (with-temp-buffer
527 (insert-file-contents file) 644 (insert-file-contents file)
528 ;; FIXME we could theoretically be inside a string. 645 ;; FIXME we could theoretically be inside a string.
529 (while (re-search-forward re nil t) 646 (while (re-search-forward re nil :noerror)
530 (goto-char (match-beginning 1)) 647 (goto-char (match-beginning 1))
531 (if (and (setq form (ignore-errors (read (current-buffer)))) 648 (if (and (setq form (ignore-errors (read (current-buffer))))
532 (setq var (car-safe (cdr-safe form))) 649 (setq var (car-safe (cdr-safe form)))
533 ;; Exclude macros, eg (defcustom ,varname ...). 650 ;; Exclude macros, eg (defcustom ,varname ...).
534 (symbolp var)) 651 (symbolp var))
535 (progn 652 (progn
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)))
536 (setq ver (car (cdr-safe (memq :version form)))) 659 (setq ver (car (cdr-safe (memq :version form))))
537 (if (equal "group" (match-string 2)) 660 (if (equal "group" (match-string 2))
538 ;; Group :version could be old. 661 ;; Group :version could be old.
@@ -568,7 +691,7 @@ If optional argument OLD is non-nil, also scan for defvars."
568(define-button-type 'cusver-xref 'action #'cusver-goto-xref) 691(define-button-type 'cusver-xref 'action #'cusver-goto-xref)
569 692
570(defun cusver-goto-xref (button) 693(defun cusver-goto-xref (button)
571 "Jump to a lisp file for the BUTTON at point." 694 "Jump to a Lisp file for the BUTTON at point."
572 (let ((file (button-get button 'file)) 695 (let ((file (button-get button 'file))
573 (var (button-get button 'var))) 696 (var (button-get button 'var)))
574 (if (not (file-readable-p file)) 697 (if (not (file-readable-p file))
@@ -584,34 +707,36 @@ If optional argument OLD is non-nil, also scan for defvars."
584;; TODO Check cus-start if something moved from C to Lisp. 707;; TODO Check cus-start if something moved from C to Lisp.
585;; TODO Handle renamed things with aliases to the old names. 708;; TODO Handle renamed things with aliases to the old names.
586(defun cusver-check (newdir olddir version) 709(defun cusver-check (newdir olddir version)
587 "Check that defcustoms have :version tags where needed. 710 "Check that `defcustom's have :version tags where needed.
588NEWDIR is the current lisp/ directory, OLDDIR is that from the previous 711NEWDIR is the current lisp/ directory, OLDDIR is that from the
589release. A defcustom that is only in NEWDIR should have a :version 712previous release, VERSION is the new version number. A
590tag. We exclude cases where a defvar exists in OLDDIR, since 713`defcustom' that is only in NEWDIR should have a :version tag.
591just converting a defvar to a defcustom does not require a :version bump. 714We exclude cases where a `defvar' exists in OLDDIR, since just
715converting a `defvar' to a `defcustom' does not require
716a :version bump.
592 717
593Note that a :version tag should also be added if the value of a defcustom 718Note that a :version tag should also be added if the value of a defcustom
594changes (in a non-trivial way). This function does not check for that." 719changes (in a non-trivial way). This function does not check for that."
595 (interactive (list (read-directory-name "New Lisp directory: ") 720 (interactive (list (read-directory-name "New Lisp directory: " nil nil t)
596 (read-directory-name "Old Lisp directory: ") 721 (read-directory-name "Old Lisp directory: " nil nil t)
597 (number-to-string 722 (number-to-string
598 (read-number "New version number: " 723 (read-number "New version number: "
599 (string-to-number cusver-new-version))))) 724 (string-to-number cusver-new-version)))))
600 (or (file-directory-p (setq newdir (expand-file-name newdir))) 725 (or (file-directory-p (setq newdir (expand-file-name newdir)))
601 (error "Directory `%s' not found" newdir)) 726 (user-error "Directory `%s' not found" newdir))
602 (or (file-directory-p (setq olddir (expand-file-name olddir))) 727 (or (file-directory-p (setq olddir (expand-file-name olddir)))
603 (error "Directory `%s' not found" olddir)) 728 (user-error "Directory `%s' not found" olddir))
604 (setq cusver-new-version version) 729 (setq cusver-new-version version)
605 (let* ((newfiles (progn (message "Finding new files with defcustoms...") 730 (let* ((newfiles (progn (message "Finding new files with `defcustom's...")
606 (cusver-find-files newdir))) 731 (cusver-find-files newdir)))
607 (oldfiles (progn (message "Finding old files with defcustoms...") 732 (oldfiles (progn (message "Finding old files with `defcustom's...")
608 (cusver-find-files olddir t))) 733 (cusver-find-files olddir t)))
609 (newcus (progn (message "Reading new defcustoms...") 734 (newcus (progn (message "Reading new `defcustom's...")
610 (mapcar 735 (mapcar
611 (lambda (file) 736 (lambda (file)
612 (cons file (cusver-scan file))) newfiles))) 737 (cons file (cusver-scan file))) newfiles)))
613 oldcus result thisfile file) 738 oldcus result thisfile file)
614 (message "Reading old defcustoms...") 739 (message "Reading old `defcustom's...")
615 (dolist (file oldfiles) 740 (dolist (file oldfiles)
616 (setq oldcus (append oldcus (cusver-scan file t)))) 741 (setq oldcus (append oldcus (cusver-scan file t))))
617 (setq oldcus (append oldcus (cusver-scan-cus-start 742 (setq oldcus (append oldcus (cusver-scan-cus-start
@@ -636,7 +761,7 @@ changes (in a non-trivial way). This function does not check for that."
636 (message "No missing :version tags") 761 (message "No missing :version tags")
637 (pop-to-buffer "*cusver*") 762 (pop-to-buffer "*cusver*")
638 (erase-buffer) 763 (erase-buffer)
639 (insert "These defcustoms might be missing :version tags:\n\n") 764 (insert "These `defcustom's might be missing :version tags:\n\n")
640 (dolist (elem result) 765 (dolist (elem result)
641 (let* ((str (file-relative-name (car elem) newdir)) 766 (let* ((str (file-relative-name (car elem) newdir))
642 (strlen (length str))) 767 (strlen (length str)))