(UU+8B71): Unify AJ1-06190.
[chise/xemacs-chise.git.1] / lisp / build-report.el
1 ;;; build-report.el --- Automatically formatted build reports for XEmacs
2
3 ;; Copyright (C) 1997-2001 Adrian Aichner
4
5 ;; Author: Adrian Aichner <adrian@xemacs.org>
6 ;; Keywords: internal
7
8 ;; This file is part of XEmacs.
9
10 ;; XEmacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; XEmacs is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
18 ;; General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
23 ;; 02111-1307, USA.
24
25 ;;; Synched up with: Not synched.
26
27 ;;; Commentary:
28
29 ;; The Idea:
30 ;; Let XEmacs report interesting aspects of how it was built.
31
32 ;; The Concept:
33 ;; User creates an XEmacs Build Report by just calling
34 ;; M-x build-report
35 ;; which will initialize a mail buffer with relevant information
36 ;; derived from the XEmacs build process. Point is left at the
37 ;; beginning of the report for user to input some personal notes and
38 ;; send the report.
39
40 ;; The Status:
41 ;; This is the first `Proof of Concept'.
42
43 ;; The Author:
44 ;; Adrian Aichner, Teradyne GmbH Munich, Sun., Apr. 20, 1997.
45
46 ;;; Code:
47
48 (require 'config)
49 (require 'custom)
50 (require 'cl)
51 (provide 'build-report)
52
53 ;;; Constant definitions used internally by `build-report'.  These are not
54 ;;; anticipated to be changed by users of `build-report'.
55 ;;; If users do need to change the value of any of these, they need to do
56 ;;; it after `build-report' has been loaded (not just required).  Please
57 ;;; report it to the maintainers of `build-report' when you think you
58 ;;; need to do this.
59 (defconst build-report-installation-version-regexp
60   "XEmacs\\s-+\\([0-9]+\\)\\.\\([0-9]+\\)\\(\\(-b\\|\\.\\)\\([0-9]+\\)\\)?\\s-+\\\\?\"\\([^\\\"]+\\)\\\\?\"\\s-+configured\\s-+for\\s-+`\\(.+\\)'\\."
61   "*REGEXP matching XEmacs Beta Version string in
62 `build-report-installation-file' file.  This variable is used by
63 `build-report-installation-data'.")
64
65 (defconst build-report-version-file-regexp
66   "emacs_major_version\\s-*=\\s-*\\([0-9]+\\)
67 emacs_minor_version\\s-*=\\s-*\\([0-9]+\\)
68 emacs_beta_version\\s-*=\\s-*\\([0-9]+\\)?
69 xemacs_codename\\s-*=\\s-*\"\\([^\"]+\\)\""
70   "*REGEXP matching XEmacs Beta Version variable assignments in
71 `build-report-version-file' file.  This variable is used by
72 `build-report-version-file-data'.")
73
74 (defconst build-report-installation-srcdir-regexp
75   "\\s-*Where should the build process find the source code\\?\\s-*\\(.*\\)$"
76   "REGEXP matching XEmacs Beta srcdir as the first substring match in
77 `build-report-installation-file' file.  This variable is used by
78 `build-report-installation-data'.")
79
80 ;;; Customization support for build-report starts here.
81
82 (defgroup build-report nil
83   "Standardizes the Creation of XEmacs Build Reports."
84   :load 'build-report
85   :group 'build)
86
87 (defcustom build-report-destination
88   (list
89    "XEmacs Build Reports List <xemacs-buildreports@xemacs.org>"
90    "XEmacs Beta List <xemacs-beta@xemacs.org>")
91   "*The list of mail addresses XEmacs Build Reports should most likely
92 go to."
93   :type '(repeat
94           :custom-show t
95           :documentation-shown t
96           string)
97   :group 'build-report)
98
99 (defcustom build-report-keep-regexp
100   (list
101    "^\\(cd\\|n?make\\)\\s-"
102    "errors?"
103    "warnings?"
104    "pure.*\\(space\\|size\\)"
105    "hides\\b"
106    "strange"
107    "shadowings"
108    "^Compil\\(ing\\s-+in\\|ation\\)"
109    "^Using"
110    "not\\s-+found"
111    "^While\\s-+compiling.*\\(\n\\s-+.+\\)*"
112    "^Note:"
113    "Installing"
114    "[Ff]ile(s) copied"
115    "\\s-+tests\\s-+")
116   "*Regexp of make process output lines to keep in the report."
117   :type '(repeat
118           :custom-show t
119           :documentation-shown t
120           regexp)
121   :group 'build-report)
122
123 (defcustom build-report-delete-regexp
124   (list
125    "confl.*with.*auto-inlining"
126    "^Formatting:"
127    "(100%) tests successful")
128   "*Regexp of make process output lines to delete from the report."
129   :type '(repeat
130           :custom-show t
131           :documentation-shown t
132           regexp)
133   :group 'build-report)
134
135 (defcustom build-report-make-output-dir
136   (cond 
137    ((equal system-type 'windows-nt)
138     (expand-file-name "nt"
139                       (gethash 'blddir (config-value-hash-table))))
140    (t
141     (gethash 'blddir (config-value-hash-table))))
142   "*Directory where the build report file is found.
143   If this is empty or nil, the default, it is replaced by the value of
144   the XEmacs build directory."
145   :type '(directory
146           :custom-show t
147           :documentation-shown t)
148   :group 'build-report)
149
150 (defcustom build-report-make-output-files
151   (list
152    "beta.err"
153    "xemacs-make-all.err" 
154    "xemacs-make-check-temacs.err"
155    "xemacs-make-check.err"
156    "xemacs-make-install.err")
157   "*List of Filenames where stdout and stderr of XEmacs make process
158 have been stored.  These are relative to
159 `build-report-make-output-dir`.  You'll have to run make with output
160 redirection or use the `build' XEmacs package to save this output. You
161 may use following alias
162
163 alias mk 'make \!* >>&\! \!$.err &'
164
165 under csh, so that you get beta.err when you run `mk beta'."
166   :type '(repeat
167           :custom-show t
168           :documentation-shown t
169           file)
170   :group 'build-report)
171
172 (defcustom build-report-installation-file
173   (expand-file-name "Installation"
174                     (gethash 'blddir (config-value-hash-table)))
175   "*Installation file produced by XEmacs configure process."
176   :type '(file
177           :custom-show t
178           :documentation-shown t)
179   :group 'build-report)
180
181 (defcustom build-report-version-file
182   (expand-file-name
183    "version.sh"
184    (gethash 'blddir (config-value-hash-table)))
185   "*version.sh file identifying XEmacs (Beta) Distribution."
186   :type '(file
187           :custom-show t
188           :documentation-shown t)
189   :group 'build-report)
190
191 (defcustom build-report-installation-insert-all
192   nil
193   "*Tell build-report to insert the whole Installation file
194   instead of just the last report."
195   :type 'boolean
196   :group 'build-report)
197
198 (defcustom build-report-subject
199   (concat "[%s] " emacs-version " on " system-configuration)
200   "*XEmacs Build Report Subject Line. %s-sequences will be substituted
201   with user input through `build-report' according to
202   `build-report-prompts' using `format'."
203   :type '(string
204           :custom-show t
205           :documentation-shown t)
206   :group 'build-report)
207
208 (defcustom build-report-prompts
209   (quote (("Status?: "  ("Success" "Failure"))))
210   "*XEmacs Build Report Prompt(s). This is a list of prompt-string
211   lists used by `build-report' in conjunction with
212   `build-report-subject'. Each list consists of a prompt string
213   followed by any number of strings which can be chosen via the history
214   mechanism."
215   :type '(repeat
216           :custom-show t
217           :documentation-shown t
218           (list
219            :tag "Prompt"
220            string
221            (repeat
222             :tag "Values"
223             string)))
224   :group 'build-report)
225
226 (defcustom build-report-file-encoding
227   "7bit"
228   "*XEmacs Build Report File Encoding to be used when MIME support is
229   available."
230   :group 'build-report)
231
232 ;; Symbol Name mappings from TM to SEMI serving as Compatibility
233 ;; Bandaid
234 (when (featurep 'mime-setup)
235   ;; No (defvaralias ...) so far. Thanks to "Didier Verna"
236   ;; <didier@xemacs.org> for reporting my incorrect defvaraliasing of
237   ;; `mime-editor/insert-tag'.
238   ;; Thanks to Jens-Ulrik Holger Petersen
239   ;; <petersen@kurims.kyoto-u.ac.jp> for suggesting the conditional
240   ;; aliasing of SEMI functions.
241   (unless (fboundp 'mime-edit-content-beginning)
242     (defalias 'mime-edit-content-beginning 'mime-editor/content-beginning))
243   (unless (fboundp 'mime-edit-insert-tag)
244     (defalias 'mime-edit-insert-tag 'mime-editor/insert-tag))
245   (unless (fboundp 'mime-edit-insert-binary-file)
246     (defalias 'mime-edit-insert-binary-file
247       'mime-editor/insert-binary-file)))
248
249 (defun build-report-make-output-get ()
250   "Returns the filename the XEmacs make output is saved in."
251   (interactive)
252   (if (or (string-equal build-report-make-output-dir "")
253           (null build-report-make-output-dir))
254       (mapcar
255        (function
256         (lambda (f)
257           (expand-file-name
258            f
259            (file-name-as-directory
260             (gethash 'blddir (config-value-hash-table))))))
261        build-report-make-output-files)
262     (mapcar
263      (function
264       (lambda (f)
265         (expand-file-name
266          f
267          (file-name-as-directory build-report-make-output-dir))))
268      build-report-make-output-files)))
269
270 ;;;###autoload
271 (defun build-report (&rest args)
272   "Report build information including Installation and make output.
273
274 Prompts for status (usually \"Success\" or \"Failure\").  Then uses
275 `compose-mail' to create a mail message.  The Subject header contains
276 status and version information.  Point is left at the beginning of the
277 mail text.  Add some notes if you like, and send the report.
278
279 Looks for Installation and the make output file (`beta.err' by
280 default, customizable via `build-report-make-output-files') in the
281 build directory of the running XEmacs by default (customizable via
282 `build-report-make-output-dir').  The output from make is filtered
283 through `build-report-keep-regexp' and `build-report-delete-regexp'
284 before including in the message.
285
286 See also `mail-user-agent', `build-report-destination', and
287 `build-report-installation-file'."
288   ;; `interactive' form returns value for formal parameter `args'.
289   (interactive
290    (let (prompt
291          hist
292          arg
293          (prompts build-report-prompts))
294      (progn
295        (while prompts
296          (defvar hist)
297          (setq prompt (caar prompts))
298          (setq hist (cdar prompts))
299          ;; `build-report-prompts' used to be a list of lists, the
300          ;; first element of each list being the prompt, the rest being
301          ;; the history.  The history is now in a separate list.  We
302          ;; better check for that.
303          (if (listp (car hist))
304              (setq hist (car hist)))
305          (setq prompts (cdr prompts))
306          (setq arg (cons (read-string prompt "" 'hist) arg)))
307        arg)))
308   (save-excursion
309     (if (file-exists-p build-report-installation-file)
310         (multiple-value-bind
311             (major minor beta codename configuration)
312             (build-report-installation-data build-report-installation-file)
313           (setq build-report-subject
314                 (format "[%%s] XEmacs %s.%s%s \"%s\", %s"
315                         major minor beta codename configuration)))
316       (multiple-value-bind
317           (major minor beta codename)
318           (build-report-version-file-data build-report-version-file)
319         (setq build-report-subject
320               (format "[%%s] XEmacs %s.%s%s \"%s\", %s"
321                       major minor beta codename system-configuration))))
322     (compose-mail
323      ;; `build-report-destination' used to be a single string, so
324      ;; let's test if we really get a list of destinations.
325      (if (listp build-report-destination)
326          (read-string
327           "Build Report Destination: "
328           (car build-report-destination)
329           'build-report-destination)
330        (read-string
331         "Build Report Destination: "
332         build-report-destination)
333        )
334      (apply 'format build-report-subject args)
335      nil
336      nil
337      nil
338      nil
339      nil)
340     (let* ((report-begin (point))
341            (files (reverse (build-report-make-output-get)))
342            (file (car files)))
343       (while file
344         (if (file-exists-p file)
345             (insert (build-report-insert-make-output report-begin file))
346           (insert (format "%s not found!\n" file)))
347         (insert "\n")
348         (setq files (cdr files))
349         (setq file (car files)))
350       (if (file-exists-p build-report-installation-file)
351           (insert (build-report-insert-installation-file
352                    report-begin
353                    build-report-installation-insert-all))
354         (insert (format "%s not found!\n" build-report-installation-file)))
355 ;;;       (when (and (>= major 21) (>= minor 2) (or (null beta) (>= beta 32)))
356 ;;;         (insert "\n")
357 ;;;         (insert (build-report-insert-config-inc report-begin)))
358       (insert "\n")
359       (insert (build-report-insert-header report-begin))
360       (goto-char report-begin))))
361
362 (defun build-report-insert-header (where)
363   "Inserts the build-report-header at the point specified by `where'."
364   (goto-char where)
365   (with-temp-buffer
366     (insert
367      (format "
368 > XEmacs Build Report generated by emacs-version
369 > %s
370 > with system-configuration
371 > %s
372 > follows:\n\n" emacs-version system-configuration))
373     (buffer-string)))
374
375 (defun build-report-insert-make-output (where file)
376   "Inserts the output of the XEmacs Beta make run in the
377 current buffer at position WHERE.
378 The make process output must have been saved in
379 `build-report-make-output-files' during the XEmacs Beta building."
380   (goto-char where)
381   (with-temp-buffer
382     (if (file-exists-p file)
383         (progn
384           (if (featurep 'mime-setup)
385               (progn
386                 (mime-edit-insert-tag
387                  "text"
388                  "plain"
389                  (concat
390                   "\nContent-Disposition: attachment;"
391                   " filename=\""
392                   (file-name-nondirectory
393                    file)
394                   "\""))
395                 (mime-edit-insert-binary-file
396                  file
397                  build-report-file-encoding))
398             (insert-file-contents file))
399           (when build-report-keep-regexp
400             (goto-char (point-min))
401             (delete-non-matching-lines (build-report-keep)))
402           (when build-report-delete-regexp
403             (goto-char (point-min))
404             (delete-matching-lines (build-report-delete)))
405           (goto-char (point-min))
406           (if build-report-keep-regexp
407               (insert
408                (format
409                 "> keeping lines matching
410 > \"%s\"
411 "
412                 (build-report-keep))))
413           (if build-report-delete-regexp
414               (insert
415                (format
416                 "> %sdeleting lines matching
417 > \"%s\"
418 "
419                 (if build-report-keep-regexp
420                     "and then "
421                   "")
422                 (build-report-delete))))
423           (insert "\n")
424           (goto-char (point-min))
425           (insert
426            (format "> Contents of %s\n" file)))
427       (insert "> " file
428               " does not exist!\n\n"))
429     (buffer-string)))
430
431 (defun build-report-insert-installation-file (where all)
432   "Inserts the contents of the `build-report-installation-file'
433 created by the XEmacs Beta configure process."
434   (goto-char where)
435   (with-temp-buffer
436     (if (file-exists-p build-report-installation-file)
437         (let (file-begin last-configure)
438           (insert "> Contents of "
439                   build-report-installation-file
440                   ":\n")
441           (insert
442            (format
443             "> (Output from %s of ./configure)\n\n"
444             (if all "all runs" "most recent run")))
445           (if (featurep 'mime-setup)
446               (progn
447                 (mime-edit-insert-tag
448                  "text"
449                  "plain"
450                  (concat
451                   "\nContent-Disposition: attachment;"
452                   " filename=\""
453                   (file-name-nondirectory
454                    build-report-installation-file)
455                   "\""))
456                 (mime-edit-insert-binary-file
457                  build-report-installation-file
458                  build-report-file-encoding)
459                 (setq file-begin (mime-edit-content-beginning)))
460             (setq file-begin (point))
461             (insert-file-contents
462              build-report-installation-file))
463           (unless all
464             (setq last-configure
465                   (search-backward-regexp
466                    "^\\(uname.*\\|osversion\\|OS\\):\\s-+" file-begin t))
467             (if (and file-begin last-configure)
468                 (delete-region file-begin last-configure))))
469       (insert "> " build-report-installation-file
470               " does not exist!\n\n"))
471     (buffer-string)))
472
473 (defun build-report-keep ()
474   "Concatenate elements of `build-report-keep-regexp' and a general
475 MIME tag REGEXP.  The result is a REGEXP string matching either of the
476 REGEXPs in `build-report-keep-regexp' or a general MIME tag REGEXP."
477   (mapconcat #'identity
478              (cons "^--\\[\\[\\|\\]\\]$" build-report-keep-regexp) "\\|"))
479
480 (defun build-report-delete ()
481   "Concatenate elements of `build-report-delete-regexp' and a general
482 MIME tag REGEXP.  The result is a REGEXP string matching either of the
483 REGEXPs in `build-report-delete-regexp' or a general MIME tag REGEXP."
484   (mapconcat '(lambda (item) item)
485              build-report-delete-regexp "\\|"))
486
487 (defun build-report-installation-data (&optional file)
488   "Return a list of XEmacs installation data containing MAJOR_NUMBER
489 MINOR_NUMBER BETA_STRING CODENAME CONFIGURATION SRCDIR from FILE,
490 which defaults to `build-report-installation-file'."
491   (interactive "fInstallation file: ")
492   (unless file
493     (setq file build-report-installation-file))
494   (let
495       (major minor beta codename configuration srcdir)
496     (save-window-excursion
497       (find-file-read-only file)
498       (goto-char (point-min))
499       (while (< (point) (point-max))
500         (cond
501          ((looking-at build-report-installation-version-regexp)
502           (goto-char (match-end 0))
503           (setq major (match-string 1))
504           (setq minor (match-string 2))
505           (setq beta (match-string 3))
506           (setq codename (match-string 6))
507           (setq configuration (match-string 7)))
508          ((looking-at build-report-installation-srcdir-regexp)
509           (goto-char (match-end 0))
510           (setq srcdir (match-string 1)))
511          ;; We avoid matching a potentially zero-length string to avoid
512          ;; infinite looping.
513          ((looking-at
514            "^.+$")
515           (goto-char (match-end 0)))
516          ((looking-at "\n")
517           (goto-char (match-end 0)))))
518       (values major minor (or beta "") codename configuration srcdir))))
519
520 (defun build-report-version-file-data (&optional file)
521   "Return a list of XEmacs version information containing
522 MAJOR_NUMBER MINOR_NUMBER BETA_STRING CODENAME from FILE, which
523 defaults to `build-report-version-file'." 
524   (interactive "fversion.sh file: ")
525   (unless file
526     (setq file build-report-version-file))
527   (let
528       (major minor beta codename)
529     (save-window-excursion
530       (find-file-read-only file)
531       (goto-char (point-min))
532       (while (< (point) (point-max))
533         (cond
534          ((looking-at build-report-version-file-regexp)
535           (goto-char (match-end 0))
536           (setq major (match-string 1))
537           (setq minor (match-string 2))
538           (setq beta (match-string 3))
539           (setq codename (match-string 4)))
540          ;; We avoid matching a potentially zero-length string to avoid
541          ;; infinite looping.
542          ((looking-at
543            "^.+$")
544           (goto-char (match-end 0)))
545          ((looking-at "\n")
546           (goto-char (match-end 0)))))
547       (values major minor (or beta "") codename))))
548
549 ;;; build-report.el ends here