mail/mailabbrev.el (mail-abbrev-expand-hook): Work for a mail aliasee that holds...
[bpt/emacs.git] / admin / admin.el
CommitLineData
74499542
GM
1;;; admin.el --- utilities for Emacs administration
2
acaf905b 3;; Copyright (C) 2001-2012 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.
a3045b7e
GM
24;; set-copyright Change emacs short copyright string (eg as
25;; printed by --version) in source tree.
74499542
GM
26
27;;; Code:
28
74499542
GM
29(defun add-release-logs (root version)
30 "Add \"Version VERSION released.\" change log entries in ROOT.
31Root must be the root of an Emacs source tree."
32 (interactive "DEmacs root directory: \nNVersion number: ")
3f4a4bdf 33 (setq root (expand-file-name root))
74499542
GM
34 (unless (file-exists-p (expand-file-name "src/emacs.c" root))
35 (error "%s doesn't seem to be the root of an Emacs source tree" root))
54381691 36 (require 'add-log)
74499542
GM
37 (let* ((logs (process-lines "find" root "-name" "ChangeLog"))
38 (entry (format "%s %s <%s>\n\n\t* Version %s released.\n\n"
3f4a4bdf
FP
39 (funcall add-log-time-format)
40 (or add-log-full-name (user-full-name))
41 (or add-log-mailing-address user-mail-address)
42 version)))
74499542 43 (dolist (log logs)
e568708b 44 (unless (string-match "/gnus/" log)
74499542
GM
45 (find-file log)
46 (goto-char (point-min))
47 (insert entry)))))
48
74499542
GM
49(defun set-version-in-file (root file version rx)
50 (find-file (expand-file-name file root))
51 (goto-char (point-min))
52 (unless (re-search-forward rx nil t)
53 (error "Version not found in %s" file))
54 (replace-match (format "%s" version) nil nil nil 1))
55
74499542
GM
56(defun set-version (root version)
57 "Set Emacs version to VERSION in relevant files under ROOT.
58Root must be the root of an Emacs source tree."
91ebb8c9 59 (interactive "DEmacs root directory: \nsVersion number: ")
74499542
GM
60 (unless (file-exists-p (expand-file-name "src/emacs.c" root))
61 (error "%s doesn't seem to be the root of an Emacs source tree" root))
74499542
GM
62 (set-version-in-file root "README" version
63 (rx (and "version" (1+ space)
64 (submatch (1+ (in "0-9."))))))
c4444d16 65 (set-version-in-file root "configure.ac" version
24bbe01e
GM
66 (rx (and "AC_INIT" (1+ (not (in ?,)))
67 ?, (0+ space)
68 (submatch (1+ (in "0-9."))))))
f4f358f1
GM
69 (set-version-in-file root "doc/emacs/emacsver.texi" version
70 (rx (and "EMACSVER" (1+ space)
71 (submatch (1+ (in "0-9."))))))
adf94aa6
GM
72 (set-version-in-file root "doc/man/emacs.1" version
73 (rx (and ".TH EMACS" (1+ not-newline)
74 "GNU Emacs" (1+ space)
75 (submatch (1+ (in "0-9."))))))
70b0d280
EZ
76 (set-version-in-file root "nt/config.nt" version
77 (rx (and bol "#" (0+ blank) "define" (1+ blank)
a0c64452 78 "VERSION" (1+ blank) "\""
1fe1ef05 79 (submatch (1+ (in "0-9."))))))
9d9d12cd
EZ
80 (set-version-in-file root "msdos/sed2v2.inp" version
81 (rx (and bol "/^#undef " (1+ not-newline)
a0c64452 82 "define VERSION" (1+ space) "\""
9d9d12cd 83 (submatch (1+ (in "0-9."))))))
e3aef5c6
CS
84 (set-version-in-file root "nt/makefile.w32-in" version
85 (rx (and "VERSION" (0+ space) "=" (0+ space)
86 (submatch (1+ (in "0-9."))))))
95f76284
JR
87 ;; nt/emacs.rc also contains the version number, but in an awkward
88 ;; format. It must contain four components, separated by commas, and
89 ;; in two places those commas are followed by space, in two other
90 ;; places they are not.
91 (let* ((version-components (append (split-string version "\\.")
92 '("0" "0")))
93 (comma-version
94 (concat (car version-components) ","
95 (cadr version-components) ","
d0834a5c 96 (cadr (cdr version-components)) ","
95f76284
JR
97 (cadr (cdr (cdr version-components)))))
98 (comma-space-version
99 (concat (car version-components) ", "
100 (cadr version-components) ", "
d0834a5c 101 (cadr (cdr version-components)) ", "
95f76284
JR
102 (cadr (cdr (cdr version-components))))))
103 (set-version-in-file root "nt/emacs.rc" comma-version
104 (rx (and "FILEVERSION" (1+ space)
105 (submatch (1+ (in "0-9,"))))))
106 (set-version-in-file root "nt/emacs.rc" comma-version
107 (rx (and "PRODUCTVERSION" (1+ space)
108 (submatch (1+ (in "0-9,"))))))
109 (set-version-in-file root "nt/emacs.rc" comma-space-version
110 (rx (and "\"FileVersion\"" (0+ space) ?, (0+ space)
111 ?\" (submatch (1+ (in "0-9, "))) "\\0\"")))
112 (set-version-in-file root "nt/emacs.rc" comma-space-version
113 (rx (and "\"ProductVersion\"" (0+ space) ?,
114 (0+ space) ?\" (submatch (1+ (in "0-9, ")))
b7063e7e
JR
115 "\\0\"")))
116 ;; Likewise for emacsclient.rc
117 (set-version-in-file root "nt/emacsclient.rc" comma-version
118 (rx (and "FILEVERSION" (1+ space)
119 (submatch (1+ (in "0-9,"))))))
120 (set-version-in-file root "nt/emacsclient.rc" comma-version
121 (rx (and "PRODUCTVERSION" (1+ space)
122 (submatch (1+ (in "0-9,"))))))
123 (set-version-in-file root "nt/emacsclient.rc" comma-space-version
124 (rx (and "\"FileVersion\"" (0+ space) ?, (0+ space)
125 ?\" (submatch (1+ (in "0-9, "))) "\\0\"")))
126 (set-version-in-file root "nt/emacsclient.rc" comma-space-version
95f76284
JR
127 (rx (and "\"ProductVersion\"" (0+ space) ?,
128 (0+ space) ?\" (submatch (1+ (in "0-9, ")))
83da1b55 129 "\\0\"")))))
3f4a4bdf 130
a3045b7e
GM
131;; Note this makes some assumptions about form of short copyright.
132(defun set-copyright (root copyright)
133 "Set Emacs short copyright to COPYRIGHT in relevant files under ROOT.
134Root must be the root of an Emacs source tree."
135 (interactive (list
136 (read-directory-name "Emacs root directory: " nil nil t)
137 (read-string
138 "Short copyright string: "
139 (format "Copyright (C) %s Free Software Foundation, Inc."
140 (format-time-string "%Y")))))
141 (unless (file-exists-p (expand-file-name "src/emacs.c" root))
142 (error "%s doesn't seem to be the root of an Emacs source tree" root))
e45b9e19
KR
143 (set-version-in-file root "src/emacs.c" copyright
144 (rx (and "emacs_copyright" (0+ (not (in ?\")))
287d4c2c 145 ?\" (submatch (1+ (not (in ?\")))) ?\")))
a70c9a7a
GM
146 (set-version-in-file root "lib-src/ebrowse.c" copyright
147 (rx (and "emacs_copyright" (0+ (not (in ?\")))
287d4c2c 148 ?\" (submatch (1+ (not (in ?\")))) ?\")))
a3045b7e
GM
149 (set-version-in-file root "lib-src/etags.c" copyright
150 (rx (and "emacs_copyright" (0+ (not (in ?\")))
287d4c2c 151 ?\" (submatch (1+ (not (in ?\")))) ?\")))
a3045b7e 152 (set-version-in-file root "lib-src/rcs2log" copyright
287d4c2c
GM
153 (rx (and "Copyright" (0+ space) ?= (0+ space)
154 ?\' (submatch (1+ nonl)))))
a3045b7e
GM
155 ;; This one is a nuisance, as it needs to be split over two lines.
156 (string-match "\\(.*[0-9]\\{4\\} *\\)\\(.*\\)" copyright)
d3841127
GM
157 ;; nextstep.
158 (set-version-in-file
83da1b55 159 root "nextstep/templates/Info.plist.in"
d3841127
GM
160 copyright (rx (and "CFBundleGetInfoString" (1+ anything) "Emacs" (1+ space)
161 (1+ (in "0-9.")) (1+ space)
162 (submatch (1+ (not (in ?\<)))))))
163 (set-version-in-file
83da1b55 164 root "nextstep/templates/InfoPlist.strings.in"
d3841127 165 copyright (rx (and "NSHumanReadableCopyright" (0+ space) ?\= (0+ space)
7963f8ab
GM
166 ?\" (submatch (1+ (not (in ?\")))))))
167 (set-version-in-file
83da1b55 168 root "nextstep/templates/Info-gnustep.plist.in"
7963f8ab 169 copyright (rx (and "Copyright" (0+ space) ?\= (0+ space)
287d4c2c
GM
170 ?\" (submatch (1+ (not (in ?\")))))))
171 (when (string-match "\\([0-9]\\{4\\}\\)" copyright)
172 (setq copyright (match-string 1 copyright))
173 (dolist (file (directory-files (expand-file-name "etc/refcards" root)
174 t "\\.tex\\'"))
175 (unless (string-match "gnus-refcard\\.tex" file)
176 (set-version-in-file
177 root file copyright
178 (concat (if (string-match "ru-refcard\\.tex" file)
179 "\\\\newcommand{\\\\cyear}\\[0\\]{"
180 "\\\\def\\\\year{")
181 "\\([0-9]\\{4\\}\\)}.+%.+copyright year"))))))
a3045b7e 182
8d9101d8
CY
183;;; Various bits of magic for generating the web manuals
184
185(defun make-manuals (root)
186 "Generate the web manuals for the Emacs webpage."
187 (interactive "DEmacs root directory: ")
188 (let* ((dest (expand-file-name "manual" root))
189 (html-node-dir (expand-file-name "html_node" dest))
190 (html-mono-dir (expand-file-name "html_mono" dest))
191 (txt-dir (expand-file-name "text" dest))
192 (dvi-dir (expand-file-name "dvi" dest))
193 (ps-dir (expand-file-name "ps" dest)))
194 (when (file-directory-p dest)
195 (if (y-or-n-p (format "Directory %s exists, delete it first?" dest))
196 (delete-directory dest t)
197 (error "Aborted")))
198 (make-directory dest)
199 (make-directory html-node-dir)
200 (make-directory html-mono-dir)
201 (make-directory txt-dir)
202 (make-directory dvi-dir)
203 (make-directory ps-dir)
204 ;; Emacs manual
205 (let ((texi (expand-file-name "doc/emacs/emacs.texi" root)))
206 (manual-html-node texi (expand-file-name "emacs" html-node-dir))
207 (manual-html-mono texi (expand-file-name "emacs.html" html-mono-dir))
208 (manual-txt texi (expand-file-name "emacs.txt" txt-dir))
209 (manual-pdf texi (expand-file-name "emacs.pdf" dest))
210 (manual-dvi texi (expand-file-name "emacs.dvi" dvi-dir)
f08b09fc 211 (expand-file-name "emacs.ps" ps-dir)))
8d9101d8
CY
212 ;; Lisp manual
213 (let ((texi (expand-file-name "doc/lispref/elisp.texi" root)))
214 (manual-html-node texi (expand-file-name "elisp" html-node-dir))
215 (manual-html-mono texi (expand-file-name "elisp.html" html-mono-dir))
216 (manual-txt texi (expand-file-name "elisp.txt" txt-dir))
217 (manual-pdf texi (expand-file-name "elisp.pdf" dest))
218 (manual-dvi texi (expand-file-name "elisp.dvi" dvi-dir)
f08b09fc
CY
219 (expand-file-name "elisp.ps" ps-dir)))
220 ;; Misc manuals
221 (let ((manuals '("ada-mode" "auth" "autotype" "calc" "cc-mode"
222 "cl" "dbus" "dired-x" "ebrowse" "ede" "ediff"
223 "edt" "eieio" "emacs-mime" "epa" "erc" "ert"
224 "eshell" "eudc" "faq" "flymake" "forms"
225 "gnus" "emacs-gnutls" "idlwave" "info"
226 "mairix-el" "message" "mh-e" "newsticker"
227 "nxml-mode" "org" "pcl-cvs" "pgg" "rcirc"
228 "remember" "reftex" "sasl" "sc" "semantic"
229 "ses" "sieve" "smtpmail" "speedbar" "tramp"
230 "url" "vip" "viper" "widget" "woman")))
231 (dolist (manual manuals)
232 (manual-misc-html manual root html-node-dir html-mono-dir)))
8d9101d8
CY
233 (message "Manuals created in %s" dest)))
234
235(defconst manual-doctype-string
236 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
237\"http://www.w3.org/TR/html4/loose.dtd\">\n\n")
238
239(defconst manual-meta-string
240 "<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\">
241<link rev=\"made\" href=\"mailto:webmasters@gnu.org\">
242<link rel=\"icon\" type=\"image/png\" href=\"/graphics/gnu-head-mini.png\">
243<meta name=\"ICBM\" content=\"42.256233,-71.006581\">
244<meta name=\"DC.title\" content=\"gnu.org\">\n\n")
245
246(defconst manual-style-string "<style type=\"text/css\">
247@import url('/style.css');\n</style>\n")
248
f08b09fc
CY
249(defun manual-misc-html (name root html-node-dir html-mono-dir)
250 (let ((texi (expand-file-name (format "doc/misc/%s.texi" name) root)))
251 (manual-html-node texi (expand-file-name name html-node-dir))
252 (manual-html-mono texi (expand-file-name (concat name ".html")
253 html-mono-dir))))
254
8d9101d8
CY
255(defun manual-html-mono (texi-file dest)
256 "Run Makeinfo on TEXI-FILE, emitting mono HTML output to DEST.
257This function also edits the HTML files so that they validate as
258HTML 4.01 Transitional, and pulls in the gnu.org stylesheet using
259the @import directive."
260 (call-process "makeinfo" nil nil nil
261 "--html" "--no-split" texi-file "-o" dest)
262 (with-temp-buffer
263 (insert-file-contents dest)
264 (setq buffer-file-name dest)
265 (manual-html-fix-headers)
266 (manual-html-fix-index-1)
267 (manual-html-fix-index-2 t)
268 (manual-html-fix-node-div)
269 (goto-char (point-max))
270 (re-search-backward "</body>[\n \t]*</html>")
271 (insert "</div>\n\n")
272 (save-buffer)))
273
274(defun manual-html-node (texi-file dir)
275 "Run Makeinfo on TEXI-FILE, emitting per-node HTML output to DIR.
276This function also edits the HTML files so that they validate as
277HTML 4.01 Transitional, and pulls in the gnu.org stylesheet using
278the @import directive."
279 (unless (file-exists-p texi-file)
280 (error "Manual file %s not found" texi-file))
281 (call-process "makeinfo" nil nil nil
282 "--html" texi-file "-o" dir)
283 ;; Loop through the node files, fixing them up.
284 (dolist (f (directory-files dir nil "\\.html\\'"))
285 (let (opoint)
286 (with-temp-buffer
287 (insert-file-contents (expand-file-name f dir))
288 (setq buffer-file-name (expand-file-name f dir))
289 (if (looking-at "<meta http-equiv")
290 ;; Ignore those HTML files that are just redirects.
291 (set-buffer-modified-p nil)
292 (manual-html-fix-headers)
293 (if (equal f "index.html")
294 (let (copyright-text)
295 (manual-html-fix-index-1)
296 ;; Move copyright notice to the end.
f08b09fc
CY
297 (when (re-search-forward "[ \t]*<p>Copyright &copy;" nil t)
298 (setq opoint (match-beginning 0))
299 (re-search-forward "</blockquote>")
300 (setq copyright-text (buffer-substring opoint (point)))
301 (delete-region opoint (point)))
8d9101d8 302 (manual-html-fix-index-2)
f08b09fc
CY
303 (if copyright-text
304 (insert copyright-text))
305 (insert "\n</div>\n"))
8d9101d8
CY
306 ;; For normal nodes, give the header div a blue bg.
307 (manual-html-fix-node-div))
308 (save-buffer))))))
309
310(defun manual-txt (texi-file dest)
311 "Run Makeinfo on TEXI-FILE, emitting plaintext output to DEST."
312 (call-process "makeinfo" nil nil nil
313 "--plaintext" "--no-split" texi-file "-o" dest)
314 (shell-command (concat "gzip -c " dest " > " (concat dest ".gz"))))
315
316(defun manual-pdf (texi-file dest)
317 "Run texi2pdf on TEXI-FILE, emitting plaintext output to DEST."
318 (call-process "texi2pdf" nil nil nil texi-file "-o" dest))
319
320(defun manual-dvi (texi-file dest ps-dest)
321 "Run texi2dvi on TEXI-FILE, emitting dvi output to DEST.
7877f373 322Also generate PostScript output in PS-DEST."
8d9101d8
CY
323 (call-process "texi2dvi" nil nil nil texi-file "-o" dest)
324 (call-process "dvips" nil nil nil dest "-o" ps-dest)
325 (call-process "gzip" nil nil nil dest)
326 (call-process "gzip" nil nil nil ps-dest))
327
328(defun manual-html-fix-headers ()
329 "Fix up HTML headers for the Emacs manual in the current buffer."
330 (let (opoint)
331 (insert manual-doctype-string)
332 (search-forward "<head>\n")
333 (insert manual-meta-string)
334 (search-forward "<meta")
335 (setq opoint (match-beginning 0))
336 (re-search-forward "<!--")
337 (goto-char (match-beginning 0))
338 (delete-region opoint (point))
339 (insert manual-style-string)
340 (search-forward "<meta http-equiv=\"Content-Style")
341 (setq opoint (match-beginning 0))
342 (search-forward "</head>")
343 (delete-region opoint (match-beginning 0))))
344
345(defun manual-html-fix-node-div ()
346 "Fix up HTML \"node\" divs in the current buffer."
347 (let (opoint div-end)
348 (while (search-forward "<div class=\"node\">" nil t)
349 (replace-match
350 "<div class=\"node\" style=\"background-color:#DDDDFF\">"
351 t t)
352 (setq opoint (point))
353 (re-search-forward "</div>")
354 (setq div-end (match-beginning 0))
355 (goto-char opoint)
356 (if (search-forward "<hr>" div-end 'move)
357 (replace-match "" t t)))))
358
359(defun manual-html-fix-index-1 ()
360 (let (opoint)
f08b09fc
CY
361 (re-search-forward "<body>\n")
362 (setq opoint (match-end 0))
363 (search-forward "<h2 class=\"")
8d9101d8
CY
364 (goto-char (match-beginning 0))
365 (delete-region opoint (point))
366 (insert "<div id=\"content\" class=\"inner\">\n\n")))
367
368(defun manual-html-fix-index-2 (&optional table-workaround)
369 "Replace the index list in the current buffer with a HTML table."
370 (let (done open-td tag desc)
371 ;; Convert the list that Makeinfo made into a table.
f08b09fc
CY
372 (or (search-forward "<ul class=\"menu\">" nil t)
373 (search-forward "<ul>"))
8d9101d8
CY
374 (replace-match "<table style=\"float:left\" width=\"100%\">")
375 (forward-line 1)
376 (while (not done)
377 (cond
378 ((or (looking-at "<li>\\(<a.+</a>\\):[ \t]+\\(.*\\)$")
379 (looking-at "<li>\\(<a.+</a>\\)$"))
380 (setq tag (match-string 1))
381 (setq desc (match-string 2))
382 (replace-match "" t t)
383 (when open-td
384 (save-excursion
385 (forward-char -1)
386 (skip-chars-backward " ")
387 (delete-region (point) (line-end-position))
388 (insert "</td>\n </tr>")))
389 (insert " <tr>\n ")
390 (if table-workaround
391 ;; This works around a Firefox bug in the mono file.
392 (insert "<td bgcolor=\"white\">")
393 (insert "<td>"))
394 (insert tag "</td>\n <td>" (or desc ""))
395 (setq open-td t))
396 ((eq (char-after) ?\n)
397 (delete-char 1)
398 ;; Negate the following `forward-line'.
399 (forward-line -1))
400 ((looking-at "<!-- ")
401 (search-forward "-->"))
402 ((looking-at "<p>[- ]*The Detailed Node Listing[- \n]*")
403 (replace-match " </td></tr></table>\n
404<h3>Detailed Node Listing</h3>\n\n" t t)
405 (search-forward "<p>")
f08b09fc 406 (search-forward "<p>" nil t)
8d9101d8
CY
407 (goto-char (match-beginning 0))
408 (skip-chars-backward "\n ")
409 (setq open-td nil)
410 (insert "</p>\n\n<table style=\"float:left\" width=\"100%\">"))
411 ((looking-at "</li></ul>")
412 (replace-match "" t t))
413 ((looking-at "<p>")
414 (replace-match "" t t)
415 (when open-td
416 (insert " </td></tr>")
417 (setq open-td nil))
418 (insert " <tr>
419 <th colspan=\"2\" align=\"left\" style=\"text-align:left\">")
f08b09fc
CY
420 (if (re-search-forward "</p>[ \t\n]*<ul class=\"menu\">" nil t)
421 (replace-match " </th></tr>")))
8d9101d8
CY
422 ((looking-at "[ \t]*</ul>[ \t]*$")
423 (replace-match
424 (if open-td
425 " </td></tr>\n</table>"
426 "</table>") t t)
427 (setq done t))
428 (t
429 (if (eobp)
430 (error "Parse error in %s" f))
431 (unless open-td
432 (setq done t))))
433 (forward-line 1))))
434
58474503
GM
435\f
436;; Stuff to check new defcustoms got :version tags.
437;; Adapted from check-declare.el.
438
439(defun cusver-find-files (root &optional old)
440 "Find .el files beneath directory ROOT that contain defcustoms.
441If optional OLD is non-nil, also include defvars."
442 (process-lines find-program root
443 "-name" "*.el"
444 "-exec" grep-program
445 "-l" "-E" (format "^[ \\t]*\\(def%s"
446 (if old "(custom|var)"
447 "custom"
448 ))
449 "{}" "+"))
450
451;; TODO if a defgroup with a version tag, apply to all customs in that
452;; group (eg for new files).
453(defun cusver-scan (file &optional old)
454 "Scan FILE for `defcustom' calls.
455Return a list with elements of the form (VAR . VER),
456This means that FILE contains a defcustom for variable VAR, with
457a :version tag having value VER (may be nil).
458If optional argument OLD is non-nil, also scan for defvars."
459 (let ((m (format "Scanning %s..." file))
460 (re (format "^[ \t]*\\((def%s\\)[ \t\n]"
461 (if old "\\(?:custom\\|var\\)" "custom")))
462 alist var ver)
463 (message "%s" m)
464 (with-temp-buffer
465 (insert-file-contents file)
466 ;; FIXME we could theoretically be inside a string.
467 (while (re-search-forward re nil t)
468 (goto-char (match-beginning 1))
469 (if (and (setq form (ignore-errors (read (current-buffer))))
470 (setq var (car-safe (cdr-safe form)))
471 ;; Exclude macros, eg (defcustom ,varname ...).
472 (symbolp var))
473 (setq ver (car (cdr-safe (memq :version form)))
474 alist (cons (cons var ver) alist))
475 (if form (message "Malformed defcustom: `%s'" form)))))
476 (message "%sdone" m)
477 alist))
478
479(define-button-type 'cusver-xref 'action #'cusver-goto-xref)
480
481(defun cusver-goto-xref (button)
482 "Jump to a lisp file for the BUTTON at point."
483 (let ((file (button-get button 'file))
484 (var (button-get button 'var)))
485 (if (not (file-readable-p file))
486 (message "Cannot read `%s'" file)
487 (with-current-buffer (find-file-noselect file)
488 (goto-char (point-min))
489 (or (re-search-forward (format "^[ \t]*(defcustom[ \t]*%s" var) nil t)
490 (message "Unable to locate defcustom"))
491 (pop-to-buffer (current-buffer))))))
492
493;; You should probably at least do a grep over the old directory
494;; to check the results of this look sensible. Eg cus-start if
495;; something moved from C to Lisp.
496;; TODO handle renamed things with aliases to the old names.
497;; What to do about new files? Does everything in there need a :version,
498;; or eg just the defgroup?
499(defun cusver-check (newdir olddir)
500 "Check that defcustoms have :version tags where needed.
501NEWDIR is the current lisp/ directory, OLDDIR is that from the previous
502release. A defcustom that is only in NEWDIR should have a :version
503tag. We exclude cases where a defvar exists in OLDDIR, since
504just converting a defvar to a defcustom does not require a :version bump.
505
506Note that a :version tag should also be added if the value of a defcustom
507changes (in a non-trivial way). This function does not check for that."
508 (interactive "DNew Lisp directory: \nDOld Lisp directory: ")
509 (or (file-directory-p (setq newdir (expand-file-name newdir)))
510 (error "Directory `%s' not found" newdir))
511 (or (file-directory-p (setq olddir (expand-file-name olddir)))
512 (error "Directory `%s' not found" olddir))
513 (let* ((newfiles (progn (message "Finding new files with defcustoms...")
514 (cusver-find-files newdir)))
515 (oldfiles (progn (message "Finding old files with defcustoms...")
516 (cusver-find-files olddir t)))
517 (newcus (progn (message "Reading new defcustoms...")
518 (mapcar
519 (lambda (file)
520 (cons file (cusver-scan file))) newfiles)))
521 oldcus result thisfile)
522 (message "Reading old defcustoms...")
523 (dolist (file oldfiles)
524 (setq oldcus (append oldcus (cusver-scan file t))))
525 ;; newcus has elements (FILE (VAR VER) ... ).
526 ;; oldcus just (VAR . VER).
527 (message "Checking for version tags...")
528 (dolist (new newcus)
529 (setq file (car new)
530 thisfile
531 (let (missing var)
532 (dolist (cons (cdr new))
533 (or (cdr cons)
534 (assq (setq var (car cons)) oldcus)
535 (push var missing)))
536 (if missing
537 (cons file missing))))
538 (if thisfile
539 (setq result (cons thisfile result))))
540 (message "Checking for version tags... done")
541 (if (not result)
542 (message "No missing :version tags")
543 (pop-to-buffer "*cusver*")
544 (erase-buffer)
545 (insert "These defcustoms might be missing :version tags:\n\n")
546 (dolist (elem result)
547 (let* ((str (file-relative-name (car elem) newdir))
548 (strlen (length str)))
549 (dolist (var (cdr elem))
550 (insert (format "%s: %s\n" str var))
551 (make-text-button (+ (line-beginning-position 0) strlen 2)
552 (line-end-position 0)
553 'file (car elem)
554 'var var
555 'help-echo "Mouse-2: visit this definition"
556 :type 'cusver-xref)))))))
557
69c52df1
GM
558(provide 'admin)
559
d3841127 560;;; admin.el ends here