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