diff options
Diffstat (limited to 'admin/admin.el')
| -rw-r--r-- | admin/admin.el | 369 |
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. |
| 73 | Root must be the root of an Emacs source tree." | 78 | Root 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. |
| 213 | ROOT 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. |
| 233 | ROOT should be the root of an Emacs source tree. | ||
| 216 | Interactively with a prefix argument, prompt for TYPE. | 234 | Interactively with a prefix argument, prompt for TYPE. |
| 217 | Optional argument TYPE is type of output (nil means all)." | 235 | Optional 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 | |||
| 328 | HTML 4.01 Transitional, and pulls in the gnu.org stylesheet using | 347 | HTML 4.01 Transitional, and pulls in the gnu.org stylesheet using |
| 329 | the @import directive." | 348 | the @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. | ||
| 473 | Also 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) | 487 | Leave 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.*• \\(<a.*</a>\\)\ |
| 437 | ((or (looking-at "<li>\\(<a.+</a>\\):[ \t]+\\(.*\\)$") | 495 | :</td><td> </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 " ") | 503 | style=\"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 " *—") |
| 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. |
| 501 | If optional OLD is non-nil, also include defvars." | 618 | If 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. |
| 517 | Return a list with elements of the form (VAR . VER), | 634 | Return a list with elements of the form (VAR . VER), |
| 518 | This means that FILE contains a defcustom for variable VAR, with | 635 | This means that FILE contains a defcustom for variable VAR, with |
| 519 | a :version tag having value VER (may be nil). | 636 | a :version tag having value VER (may be nil). |
| 520 | If optional argument OLD is non-nil, also scan for defvars." | 637 | If 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. |
| 588 | NEWDIR is the current lisp/ directory, OLDDIR is that from the previous | 711 | NEWDIR is the current lisp/ directory, OLDDIR is that from the |
| 589 | release. A defcustom that is only in NEWDIR should have a :version | 712 | previous release, VERSION is the new version number. A |
| 590 | tag. We exclude cases where a defvar exists in OLDDIR, since | 713 | `defcustom' that is only in NEWDIR should have a :version tag. |
| 591 | just converting a defvar to a defcustom does not require a :version bump. | 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. | ||
| 592 | 717 | ||
| 593 | Note that a :version tag should also be added if the value of a defcustom | 718 | Note that a :version tag should also be added if the value of a defcustom |
| 594 | changes (in a non-trivial way). This function does not check for that." | 719 | changes (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))) |