X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ef85512e51f043d73788f00a2aed13cccde0682c..99a33b77e15b9a075024701d060d912b2fd87caf:/admin/admin.el diff --git a/admin/admin.el b/admin/admin.el index 07a2bcb757..70958ce1a7 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -1,13 +1,13 @@ ;;; admin.el --- utilities for Emacs administration -;; Copyright (C) 2001, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2001-2011 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -15,34 +15,17 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; add-release-logs Add ``Version X released'' change log entries. ;; set-version Change Emacs version number in source tree. +;; set-copyright Change emacs short copyright string (eg as +;; printed by --version) in source tree. ;;; Code: -(defun process-lines (program &rest args) - "Execute PROGRAM with ARGS, returning its output as a list of lines. -Signal an error if the program returns with a non-zero exit status." - (with-temp-buffer - (let ((status (apply 'call-process program nil (current-buffer) nil args))) - (unless (eq status 0) - (error "%s exited with status %s" program status)) - (goto-char (point-min)) - (let (lines) - (while (not (eobp)) - (setq lines (cons (buffer-substring-no-properties - (line-beginning-position) - (line-end-position)) - lines)) - (forward-line 1)) - (nreverse lines))))) - (defun add-release-logs (root version) "Add \"Version VERSION released.\" change log entries in ROOT. Root must be the root of an Emacs source tree." @@ -76,18 +59,389 @@ Root must be the root of an Emacs source tree." (interactive "DEmacs root directory: \nsVersion number: ") (unless (file-exists-p (expand-file-name "src/emacs.c" root)) (error "%s doesn't seem to be the root of an Emacs source tree" root)) - (set-version-in-file root "lisp/version.el" version - (rx (and "emacs-version" (0+ space) - ?\" (submatch (1+ (not (in ?\")))) ?\"))) (set-version-in-file root "README" version (rx (and "version" (1+ space) (submatch (1+ (in "0-9.")))))) - (set-version-in-file root "man/emacs.texi" version + (set-version-in-file root "configure.in" version + (rx (and "AC_INIT" (1+ (not (in ?,))) + ?, (0+ space) + (submatch (1+ (in "0-9.")))))) + (set-version-in-file root "doc/emacs/emacsver.texi" version (rx (and "EMACSVER" (1+ space) (submatch (1+ (in "0-9.")))))) - (set-version-in-file root "lispref/elisp.texi" version - (rx (and "EMACSVER" (1+ space) - (submatch (1+ (in "0-9."))))))) + (set-version-in-file root "doc/man/emacs.1" version + (rx (and ".TH EMACS" (1+ not-newline) + "GNU Emacs" (1+ space) + (submatch (1+ (in "0-9.")))))) + (set-version-in-file root "nt/config.nt" version + (rx (and bol "#" (0+ blank) "define" (1+ blank) + "VERSION" (1+ blank) + (submatch (1+ (in "0-9.")))))) + (set-version-in-file root "msdos/sed2v2.inp" version + (rx (and bol "/^#undef " (1+ not-newline) + "define VERSION" (1+ space) + (submatch (1+ (in "0-9.")))))) + (set-version-in-file root "nt/makefile.w32-in" version + (rx (and "VERSION" (0+ space) "=" (0+ space) + (submatch (1+ (in "0-9.")))))) + ;; nt/emacs.rc also contains the version number, but in an awkward + ;; format. It must contain four components, separated by commas, and + ;; in two places those commas are followed by space, in two other + ;; places they are not. + (let* ((version-components (append (split-string version "\\.") + '("0" "0"))) + (comma-version + (concat (car version-components) "," + (cadr version-components) "," + (cadr (cdr version-components)) "," + (cadr (cdr (cdr version-components))))) + (comma-space-version + (concat (car version-components) ", " + (cadr version-components) ", " + (cadr (cdr version-components)) ", " + (cadr (cdr (cdr version-components)))))) + (set-version-in-file root "nt/emacs.rc" comma-version + (rx (and "FILEVERSION" (1+ space) + (submatch (1+ (in "0-9,")))))) + (set-version-in-file root "nt/emacs.rc" comma-version + (rx (and "PRODUCTVERSION" (1+ space) + (submatch (1+ (in "0-9,")))))) + (set-version-in-file root "nt/emacs.rc" comma-space-version + (rx (and "\"FileVersion\"" (0+ space) ?, (0+ space) + ?\" (submatch (1+ (in "0-9, "))) "\\0\""))) + (set-version-in-file root "nt/emacs.rc" comma-space-version + (rx (and "\"ProductVersion\"" (0+ space) ?, + (0+ space) ?\" (submatch (1+ (in "0-9, "))) + "\\0\""))) + ;; Likewise for emacsclient.rc + (set-version-in-file root "nt/emacsclient.rc" comma-version + (rx (and "FILEVERSION" (1+ space) + (submatch (1+ (in "0-9,")))))) + (set-version-in-file root "nt/emacsclient.rc" comma-version + (rx (and "PRODUCTVERSION" (1+ space) + (submatch (1+ (in "0-9,")))))) + (set-version-in-file root "nt/emacsclient.rc" comma-space-version + (rx (and "\"FileVersion\"" (0+ space) ?, (0+ space) + ?\" (submatch (1+ (in "0-9, "))) "\\0\""))) + (set-version-in-file root "nt/emacsclient.rc" comma-space-version + (rx (and "\"ProductVersion\"" (0+ space) ?, + (0+ space) ?\" (submatch (1+ (in "0-9, "))) + "\\0\"")))) + ;; nextstep. + (set-version-in-file + root "nextstep/Cocoa/Emacs.base/Contents/Info.plist" + version (rx (and "CFBundleGetInfoString" (1+ anything) "Emacs" (1+ space) + (submatch (1+ (in "0-9.")))))) + (set-version-in-file + root "nextstep/Cocoa/Emacs.base/Contents/Info.plist" + version (rx (and "CFBundleShortVersionString" (1+ not-newline) ?\n + (0+ not-newline) "" (0+ space) + (submatch (1+ (in "0-9.")))))) + (set-version-in-file + root "nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings" + version (rx (and "CFBundleShortVersionString" (0+ space) ?= (0+ space) + ?\" (0+ space) "Version" (1+ space) + (submatch (1+ (in "0-9.")))))) + (set-version-in-file + root "nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings" + version (rx (and "CFBundleGetInfoString" (0+ space) ?= (0+ space) + ?\" (0+ space) "Emacs version" (1+ space) + (submatch (1+ (in "0-9.")))))) + (set-version-in-file + root "nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist" + version (rx (and "ApplicationRelease" (0+ space) ?= (0+ space) + ?\" (0+ space) (submatch (1+ (in "0-9.")))))) + (set-version-in-file + root "nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist" + version (rx (and "FullVersionID" (0+ space) ?= (0+ space) + ?\" (0+ space) "Emacs" (1+ space) + (submatch (1+ (in "0-9.")))))) + (set-version-in-file + root "nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop" + version (rx (and "Version=" (submatch (1+ (in "0-9."))))))) + +;; Note this makes some assumptions about form of short copyright. +(defun set-copyright (root copyright) + "Set Emacs short copyright to COPYRIGHT in relevant files under ROOT. +Root must be the root of an Emacs source tree." + (interactive (list + (read-directory-name "Emacs root directory: " nil nil t) + (read-string + "Short copyright string: " + (format "Copyright (C) %s Free Software Foundation, Inc." + (format-time-string "%Y"))))) + (unless (file-exists-p (expand-file-name "src/emacs.c" root)) + (error "%s doesn't seem to be the root of an Emacs source tree" root)) + (set-version-in-file root "src/emacs.c" copyright + (rx (and "emacs_copyright" (0+ (not (in ?\"))) + ?\" (submatch (1+ (not (in ?\")))) ?\"))) + (set-version-in-file root "lib-src/ebrowse.c" copyright + (rx (and "emacs_copyright" (0+ (not (in ?\"))) + ?\" (submatch (1+ (not (in ?\")))) ?\"))) + (set-version-in-file root "lib-src/etags.c" copyright + (rx (and "emacs_copyright" (0+ (not (in ?\"))) + ?\" (submatch (1+ (not (in ?\")))) ?\"))) + (set-version-in-file root "lib-src/rcs2log" copyright + (rx (and "Copyright" (0+ space) ?= (0+ space) + ?\' (submatch (1+ nonl))))) + ;; This one is a nuisance, as it needs to be split over two lines. + (string-match "\\(.*[0-9]\\{4\\} *\\)\\(.*\\)" copyright) + ;; nextstep. + (set-version-in-file + root "nextstep/Cocoa/Emacs.base/Contents/Info.plist" + copyright (rx (and "CFBundleGetInfoString" (1+ anything) "Emacs" (1+ space) + (1+ (in "0-9.")) (1+ space) + (submatch (1+ (not (in ?\<))))))) + (set-version-in-file + root "nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings" + copyright (rx (and "NSHumanReadableCopyright" (0+ space) ?\= (0+ space) + ?\" (submatch (1+ (not (in ?\"))))))) + (set-version-in-file + root "nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist" + copyright (rx (and "Copyright" (0+ space) ?\= (0+ space) + ?\" (submatch (1+ (not (in ?\"))))))) + (when (string-match "\\([0-9]\\{4\\}\\)" copyright) + (setq copyright (match-string 1 copyright)) + (dolist (file (directory-files (expand-file-name "etc/refcards" root) + t "\\.tex\\'")) + (unless (string-match "gnus-refcard\\.tex" file) + (set-version-in-file + root file copyright + (concat (if (string-match "ru-refcard\\.tex" file) + "\\\\newcommand{\\\\cyear}\\[0\\]{" + "\\\\def\\\\year{") + "\\([0-9]\\{4\\}\\)}.+%.+copyright year")))))) + +;;; Various bits of magic for generating the web manuals + +(defun make-manuals (root) + "Generate the web manuals for the Emacs webpage." + (interactive "DEmacs root directory: ") + (let* ((dest (expand-file-name "manual" root)) + (html-node-dir (expand-file-name "html_node" dest)) + (html-mono-dir (expand-file-name "html_mono" dest)) + (txt-dir (expand-file-name "text" dest)) + (dvi-dir (expand-file-name "dvi" dest)) + (ps-dir (expand-file-name "ps" dest))) + (when (file-directory-p dest) + (if (y-or-n-p (format "Directory %s exists, delete it first?" dest)) + (delete-directory dest t) + (error "Aborted"))) + (make-directory dest) + (make-directory html-node-dir) + (make-directory html-mono-dir) + (make-directory txt-dir) + (make-directory dvi-dir) + (make-directory ps-dir) + ;; Emacs manual + (let ((texi (expand-file-name "doc/emacs/emacs.texi" root))) + (manual-html-node texi (expand-file-name "emacs" html-node-dir)) + (manual-html-mono texi (expand-file-name "emacs.html" html-mono-dir)) + (manual-txt texi (expand-file-name "emacs.txt" txt-dir)) + (manual-pdf texi (expand-file-name "emacs.pdf" dest)) + (manual-dvi texi (expand-file-name "emacs.dvi" dvi-dir) + (expand-file-name "emacs.ps" ps-dir))) + ;; Lisp manual + (let ((texi (expand-file-name "doc/lispref/elisp.texi" root))) + (manual-html-node texi (expand-file-name "elisp" html-node-dir)) + (manual-html-mono texi (expand-file-name "elisp.html" html-mono-dir)) + (manual-txt texi (expand-file-name "elisp.txt" txt-dir)) + (manual-pdf texi (expand-file-name "elisp.pdf" dest)) + (manual-dvi texi (expand-file-name "elisp.dvi" dvi-dir) + (expand-file-name "elisp.ps" ps-dir))) + (message "Manuals created in %s" dest))) + +(defconst manual-doctype-string + "\n\n") + +(defconst manual-meta-string + " + + + +\n\n") + +(defconst manual-style-string "\n") + +(defun manual-html-mono (texi-file dest) + "Run Makeinfo on TEXI-FILE, emitting mono HTML output to DEST. +This function also edits the HTML files so that they validate as +HTML 4.01 Transitional, and pulls in the gnu.org stylesheet using +the @import directive." + (call-process "makeinfo" nil nil nil + "--html" "--no-split" texi-file "-o" dest) + (with-temp-buffer + (insert-file-contents dest) + (setq buffer-file-name dest) + (manual-html-fix-headers) + (manual-html-fix-index-1) + (manual-html-fix-index-2 t) + (manual-html-fix-node-div) + (goto-char (point-max)) + (re-search-backward "[\n \t]*") + (insert "\n\n") + (save-buffer))) + +(defun manual-html-node (texi-file dir) + "Run Makeinfo on TEXI-FILE, emitting per-node HTML output to DIR. +This function also edits the HTML files so that they validate as +HTML 4.01 Transitional, and pulls in the gnu.org stylesheet using +the @import directive." + (unless (file-exists-p texi-file) + (error "Manual file %s not found" texi-file)) + (call-process "makeinfo" nil nil nil + "--html" texi-file "-o" dir) + ;; Loop through the node files, fixing them up. + (dolist (f (directory-files dir nil "\\.html\\'")) + (let (opoint) + (with-temp-buffer + (insert-file-contents (expand-file-name f dir)) + (setq buffer-file-name (expand-file-name f dir)) + (if (looking-at "Copyright ©") + (setq opoint (match-beginning 0)) + (re-search-forward "") + (setq copyright-text (buffer-substring opoint (point))) + (delete-region opoint (point)) + (manual-html-fix-index-2) + (insert copyright-text "\n\n")) + ;; For normal nodes, give the header div a blue bg. + (manual-html-fix-node-div)) + (save-buffer)))))) + +(defun manual-txt (texi-file dest) + "Run Makeinfo on TEXI-FILE, emitting plaintext output to DEST." + (call-process "makeinfo" nil nil nil + "--plaintext" "--no-split" texi-file "-o" dest) + (shell-command (concat "gzip -c " dest " > " (concat dest ".gz")))) + +(defun manual-pdf (texi-file dest) + "Run texi2pdf on TEXI-FILE, emitting plaintext output to DEST." + (call-process "texi2pdf" nil nil nil texi-file "-o" dest)) + +(defun manual-dvi (texi-file dest ps-dest) + "Run texi2dvi on TEXI-FILE, emitting dvi output to DEST. +Also generate postscript output in PS-DEST." + (call-process "texi2dvi" nil nil nil texi-file "-o" dest) + (call-process "dvips" nil nil nil dest "-o" ps-dest) + (call-process "gzip" nil nil nil dest) + (call-process "gzip" nil nil nil ps-dest)) + +(defun manual-html-fix-headers () + "Fix up HTML headers for the Emacs manual in the current buffer." + (let (opoint) + (insert manual-doctype-string) + (search-forward "\n") + (insert manual-meta-string) + (search-forward "") + (delete-region opoint (match-beginning 0)))) + +(defun manual-html-fix-node-div () + "Fix up HTML \"node\" divs in the current buffer." + (let (opoint div-end) + (while (search-forward "
" nil t) + (replace-match + "
" + t t) + (setq opoint (point)) + (re-search-forward "
") + (setq div-end (match-beginning 0)) + (goto-char opoint) + (if (search-forward "
" div-end 'move) + (replace-match "" t t))))) + +(defun manual-html-fix-index-1 () + (let (opoint) + (re-search-forward "\n\\(

\n\n"))) + +(defun manual-html-fix-index-2 (&optional table-workaround) + "Replace the index list in the current buffer with a HTML table." + (let (done open-td tag desc) + ;; Convert the list that Makeinfo made into a table. + (search-forward "
    ") + (replace-match "") + (forward-line 1) + (while (not done) + (cond + ((or (looking-at "
  • \\(\\):[ \t]+\\(.*\\)$") + (looking-at "
  • \\(\\)$")) + (setq tag (match-string 1)) + (setq desc (match-string 2)) + (replace-match "" t t) + (when open-td + (save-excursion + (forward-char -1) + (skip-chars-backward " ") + (delete-region (point) (line-end-position)) + (insert "\n "))) + (insert "
    • \n ") + (if table-workaround + ;; This works around a Firefox bug in the mono file. + (insert "\n
    ") + (insert "")) + (insert tag "" (or desc "")) + (setq open-td t)) + ((eq (char-after) ?\n) + (delete-char 1) + ;; Negate the following `forward-line'. + (forward-line -1)) + ((looking-at "")) + ((looking-at "

    [- ]*The Detailed Node Listing[- \n]*") + (replace-match "

    \n +

    Detailed Node Listing

    \n\n" t t) + (search-forward "

    ") + (search-forward "

    ") + (goto-char (match-beginning 0)) + (skip-chars-backward "\n ") + (setq open-td nil) + (insert "

    \n\n")) + ((looking-at "") + (replace-match "" t t)) + ((looking-at "

    ") + (replace-match "" t t) + (when open-td + (insert " ") + (setq open-td nil)) + (insert "

    + ")) + ((looking-at "[ \t]*[ \t]*$") + (replace-match + (if open-td + " \n
    ") + (re-search-forward "

    [ \t\n]*
      ") + (replace-match "
    " + "") t t) + (setq done t)) + (t + (if (eobp) + (error "Parse error in %s" f)) + (unless open-td + (setq done t)))) + (forward-line 1)))) + +(provide 'admin) -;;; arch-tag: 4ea83636-2293-408b-884e-ad64f22a3bf5 -;; admin.el ends here. +;;; admin.el ends here