1 ;;; build-rpt.el --- Automatically formatted build reports for XEmacs
3 ;; Copyright (C) 1997-2001 Adrian Aichner
4 ;; Copyright (C) 2004 - 2007 Steve Youngs
6 ;; Author: Adrian Aichner <adrian@xemacs.org>
9 ;; This file is part of SXEmacs.
11 ;; SXEmacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; SXEmacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
24 ;;; Synched up with: Not synched.
29 ;; Let SXEmacs report interesting aspects of how it was built.
32 ;; User creates an SXEmacs Build Report by just calling
34 ;; which will initialise a mail buffer with relevant information
35 ;; derived from the SXEmacs build process. Point is left at the
36 ;; beginning of the report for user to input some personal notes and
40 ;; This is the first `Proof of Concept'.
43 ;; Adrian Aichner, Teradyne GmbH Munich, Sun., Apr. 20, 1997.
45 ;; First update for SXEmacs 2004-12-07 by Steve Youngs.
47 ;; Renamed to build-rpt so it doesn't conflict with build-report.el in
48 ;; XEmacs package "build" -- 2006-01-21 by Steve Youngs.
56 ;; gag the byte-compiler... we really do know what we are doing
58 (globally-declare-boundp
59 '(gnus-newsgroup-name gnus-article-copy mail-header-separator))
60 (globally-declare-fboundp
61 '(gnus-alive-p gnus-slave gnus-slave-unplugged gnus-post-news
62 gnus-group-mail message-field-value message-goto-to
63 message-goto-subject message-goto-body user-mail-address
67 ;;; Customization support for build-rpt starts here.
69 (defgroup build-rpt nil
70 "Standardises the Creation of SXEmacs Build Rpts."
74 (defcustom build-rpt-destination
76 "SXEmacs Build Reports <sxemacs-builds@sxemacs.org>"
77 "SXEmacs Devel <sxemacs-devel@sxemacs.org>"
78 "Steve Youngs <steve@sxemacs.org>")
79 "*The list of mail addresses SXEmacs Build Reports should most likely
83 :documentation-shown t
87 (defcustom build-rpt-keep-regexp
89 #r"^\(cd\|n?make\)\s-"
92 #r"pure.*\(space\|size\)"
96 #r"^Compil\(ing\s-+in\|ation\)"
99 "^While\\s-+compiling.*\\(\n\\s-+.+\\)*"
105 "^\\(real\\|user\\|sys\\)\\s-+[0-9]+m")
106 "*Regexp of make process output lines to keep in the report."
109 :documentation-shown t
113 (defcustom build-rpt-delete-regexp
115 "confl.*with.*auto-inlining"
117 "(100%) tests successful"
120 "*Regexp of make process output lines to delete from the report."
123 :documentation-shown t
127 (defcustom build-rpt-make-output-dir (config-value 'sxe_blddir)
128 "*Directory where the build report file is found."
131 :documentation-shown t)
134 (defcustom build-rpt-make-output-files
139 ",,make-check-temacs.out"
141 ",,make-install.out")
142 "*List of Filenames where stdout and stderr of SXEmacs make process
143 have been stored. These are relative to
144 `build-rpt-make-output-dir`. You'll have to run make with output
145 redirection, like so...
147 $ make 2>&1 | tee ,,make-all.out
148 $ make check 2>&1 | tee ,,make-check.out
152 :documentation-shown t
156 (defcustom build-rpt-installation-file
157 (expand-file-name "Installation"
158 (gethash 'sxe_blddir (config-value-hash-table)))
159 "*Installation file produced by SXEmacs configure process."
162 :documentation-shown t)
165 (defcustom build-rpt-version-file
168 (file-name-as-directory
169 (paths-construct-path
170 (list (gethash 'sxe_blddir (config-value-hash-table))
172 "*File containing version info."
175 :documentation-shown t)
178 (defcustom build-rpt-subject
180 (gethash 'SXEMACS_ARCH_VERSION (config-value-hash-table))
181 " on " system-configuration)
182 "*SXEmacs Build Report Subject Line. %s-sequences will be substituted
183 with user input through `build-rpt' according to
184 `build-rpt-prompts' using `format'."
187 :documentation-shown t)
190 (defcustom build-rpt-prompts
191 (quote (("Status?: " ("Success" "Tests fail" "Failure" "Vanilla problems" "Problems"))))
192 "*SXEmacs Build Report Prompt(s). This is a list of prompt-string
193 lists used by `build-rpt' in conjunction with
194 `build-rpt-subject'. Each list consists of a prompt string
195 followed by any number of strings which can be chosen via the history
199 :documentation-shown t
208 (defcustom build-rpt-file-encoding
210 "*SXEmacs Build Report File Encoding to be used when MIME support is
214 (defcustom build-rpt-use-gnus-p nil
215 "*Whether the SXEmacs Build Report should be set up by Gnus.
216 Note that Gnus has to be fully started, i.e. there has to be a
221 (defcustom build-rpt-use-gnus-group ""
222 "*Name of a group in the group buffer to send the build report from.
223 This is useful if there are customised settings along with the group."
227 (defcustom build-rpt-use-gnus-plugged t
228 "*When non-nil, start Gnus in \"plugged\" mode if it isn't running."
232 ;; Symbol Name mappings from TM to SEMI serving as Compatibility
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)))
249 (defun build-rpt-make-output-get ()
250 "Returns the filename the SXEmacs make output is saved in."
252 (if (or (string-equal build-rpt-make-output-dir "")
253 (null build-rpt-make-output-dir))
259 (file-name-as-directory
260 (gethash 'sxe_blddir (config-value-hash-table))))))
261 build-rpt-make-output-files)
267 (file-name-as-directory build-rpt-make-output-dir))))
268 build-rpt-make-output-files)))
270 (defun build-rpt-read-destination ()
271 (if (listp build-rpt-destination)
273 "Build Report Destination: "
274 (car build-rpt-destination)
275 'build-rpt-destination)
277 "Build Report Destination: "
278 build-rpt-destination)))
280 (defvar build-rpt-interactive nil
281 "Flag used signal when build report is being called interactively
282 and as such the user should be the one sending the email.
283 When nil the build report is sent as soon as it is built.")
285 (defvar build-rpt-email (if (listp build-rpt-destination)
286 (car build-rpt-destination)
287 build-rpt-destination)
288 "The destination for the current build-report")
293 (defun send-build-rpt (&rest args)
294 "Send report build information including Installation and make output.
296 Uses first argument for status. Then uses
297 `compose-mail' to create a mail message. The Subject header contains
298 status and version information. Point is left at the beginning of the
299 mail text. Add some notes if you like, and send the report.
301 Looks for Installation and the make output file (see
302 `build-rpt-make-output-files') in the build directory of the
303 running SXEmacs by default (customisable via
304 `build-rpt-make-output-dir'). The output from make is filtered
305 through `build-rpt-keep-regexp' and `build-rpt-delete-regexp'
306 before including in the message.
308 See also `mail-user-agent', `build-rpt-email', and
309 `build-rpt-installation-file'."
310 (let ((user-mail-address (if user-mail-address
312 (if (and (interactive-p)
313 (featurep 'sendmail))
315 (concat (user-real-login-name)
317 (if mail-host-address
321 (if (and build-rpt-use-gnus-p
324 (unless (gnus-alive-p)
325 (if build-rpt-use-gnus-plugged
326 ;; use slave in case there is a Gnus running in another
329 (gnus-slave-unplugged)))
330 (if (not (string= "" build-rpt-use-gnus-group))
331 (let ((group gnus-newsgroup-name)
333 (setq gnus-newsgroup-name build-rpt-use-gnus-group)
334 (gnus-post-news "" build-rpt-use-gnus-group)
335 (setq gnus-newsgroup-name group))
337 (unless (message-field-value "to")
339 (insert build-rpt-email))
340 (message-goto-subject)
341 (insert (apply #'format build-rpt-subject args))
343 (if (featurep 'sendmail)
347 (apply 'format build-rpt-subject args)
353 (goto-char (point-max))
354 (re-search-backward mail-header-separator)
356 (pop-to-buffer "*build-rpt*")
357 (insert (format (concat "Please save this buffer to a file and email it\n"
358 "Or, alternatively, rerun `M-x build-rpt' after installing the\n"
359 "\"mail-lib\" XEmacs package.\n\n"
360 "To: SXEmacs Builds <sxemacs-builds@sxemacs.org>\n"
362 (apply #'format build-rpt-subject args)))))
363 (let* ((rpt-begin (point))
364 (files (reverse (build-rpt-make-output-get)))
367 (if (file-exists-p file)
368 (insert (build-rpt-insert-make-output rpt-begin file))
369 (insert (format "%s not found!\n" file)))
371 (setq files (cdr files))
372 (setq file (car files)))
373 (insert (build-rpt-insert-config-values rpt-begin))
375 (insert (build-rpt-insert-ldd rpt-begin))
377 (if (file-exists-p build-rpt-installation-file)
378 (insert (build-rpt-insert-installation-file rpt-begin))
379 (insert (format "%s not found!\n" build-rpt-installation-file)))
381 (insert (build-rpt-insert-header rpt-begin))
382 (if build-rpt-interactive
383 (goto-char rpt-begin)
384 (mail-send-and-exit t))))))
387 (defun build-rpt (&rest args)
388 "Report build information including Installation and make output.
390 Prompts for status (usually \"Success\" or \"Failure\"). Then uses
391 `compose-mail' to create a mail message. The Subject header contains
392 status and version information. Point is left at the beginning of the
393 mail text. Add some notes if you like, and send the report.
395 Looks for Installation and the make output file (see
396 `build-rpt-make-output-files') in the build directory of the
397 running SXEmacs by default (customisable via
398 `build-rpt-make-output-dir'). The output from make is filtered
399 through `build-rpt-keep-regexp' and `build-rpt-delete-regexp'
400 before including in the message.
402 See also `mail-user-agent', `build-rpt-destination', and
403 `build-rpt-installation-file'."
404 ;; `interactive' form returns value for formal parameter `args'.
409 (prompts build-rpt-prompts))
413 (setq prompt (caar prompts))
414 (setq hist (cdar prompts))
415 ;; `build-rpt-prompts' used to be a list of lists, the
416 ;; first element of each list being the prompt, the rest being
417 ;; the history. The history is now in a separate list. We
418 ;; better check for that.
419 (if (listp (car hist))
420 (setq hist (car hist)))
421 (setq prompts (cdr prompts))
422 (setq arg (cons (read-string prompt "" 'hist) arg)))
424 (let ((build-rpt-email (build-rpt-read-destination))
425 (build-rpt-interactive (interactive-p)))
426 (apply 'send-build-rpt args)))
428 (defun build-rpt-insert-header (where)
429 "Inserts the build-rpt-header at the point specified by `where'."
434 > SXEmacs Build Report generated by emacs-version
436 > with system-configuration
438 > follows:\n\n" emacs-version system-configuration))
441 (defun build-rpt-insert-make-output (where file)
442 "Inserts the output of the SXEmacs Beta make run in the
443 current buffer at position WHERE.
444 The make process output must have been saved in
445 `build-rpt-make-output-files' during the SXEmacs Beta building."
448 (if (file-exists-p file)
450 (if (featurep 'mime-setup)
452 (mime-edit-insert-tag
456 "\nContent-Disposition: attachment;"
458 (file-name-nondirectory
461 (mime-edit-insert-binary-file
463 build-rpt-file-encoding))
464 (insert-file-contents file))
465 (when build-rpt-keep-regexp
466 (goto-char (point-min))
467 (delete-non-matching-lines (build-rpt-keep)))
468 (when build-rpt-delete-regexp
469 (goto-char (point-min))
470 (delete-matching-lines (build-rpt-delete)))
471 (goto-char (point-min))
474 (format "> Contents of %s\n" file)))
476 " does not exist!\n\n"))
479 (defun build-rpt-insert-installation-file (where)
480 "Inserts the contents of the `build-rpt-installation-file'
481 created by the SXEmacs Beta configure process."
484 (if (file-exists-p build-rpt-installation-file)
486 (insert "> Contents of "
487 build-rpt-installation-file
489 (insert "> (Output from ./configure)\n\n")
490 (if (featurep 'mime-setup)
492 (mime-edit-insert-tag
496 "\nContent-Disposition: attachment;"
498 (file-name-nondirectory
499 build-rpt-installation-file)
501 (mime-edit-insert-binary-file
502 build-rpt-installation-file
503 build-rpt-file-encoding))
504 (insert-file-contents
505 build-rpt-installation-file)))
506 (insert "> " build-rpt-installation-file
507 " does not exist!\n\n"))
510 (defun build-rpt-insert-config-values (where)
511 "Inserts the contents of the `config-value-hash-table'.
512 created by the SXEmacs Beta configure process."
515 (if (null (config-value-hash-table))
516 (insert "> `config-value-hash-table' is empty, which is weird :(!\n\n")
518 (insert "> Contents of `config-value-hash-table':\n")
522 #'(lambda (key value)
523 (if (and (stringp value)
525 (setq value-empty (cons key value-empty))
526 (insert (format "%s %S\n" key value))))
527 (config-value-hash-table))
529 ;; we are at `curp' again
530 (insert (format "Empty keys: %s\n\n"
531 (mapconcat #'prin1-to-string
532 value-empty " "))))))
535 (defun build-rpt-insert-ldd (where)
536 "Inserts the output of the shell command ldd sxemacs."
539 (let ((running-binary-tests
541 (expand-file-name (car command-line-args)
542 command-line-default-directory))
544 (locate-file (car command-line-args)
545 (split-string (getenv "PATH") ":")))))
548 (let ((sysconfl (split-string system-configuration "-")))
550 ((member "apple" sysconfl)
555 ;; perform binary finder tests
556 (while (and (null running-binary) (car-safe running-binary-tests))
557 (let ((candidate (funcall (car running-binary-tests))))
560 (file-exists-p candidate)
562 running-binary-tests (cdr running-binary-tests))))
564 (if (null running-binary)
565 (insert "cannot obtain ld-dependencies.\n")
566 (insert (shell-command-to-string (concat ldd " " running-binary)))
567 (goto-char (point-min))
568 (while (re-search-forward "^\\s-+" nil t)
570 (goto-char (point-min))
571 (insert "> shared library dependencies:\n"))
574 (defun build-rpt-keep ()
575 "Concatenate elements of `build-rpt-keep-regexp' and a general
576 MIME tag REGEXP. The result is a REGEXP string matching either of the
577 REGEXPs in `build-rpt-keep-regexp' or a general MIME tag REGEXP."
578 (mapconcat #'identity
579 (cons #r"^--\[\[\|\]\]$" build-rpt-keep-regexp) "\\|"))
581 (defun build-rpt-delete ()
582 "Concatenate elements of `build-rpt-delete-regexp' and a general
583 MIME tag REGEXP. The result is a REGEXP string matching either of the
584 REGEXPs in `build-rpt-delete-regexp' or a general MIME tag REGEXP."
585 (mapconcat '(lambda (item) item)
586 build-rpt-delete-regexp "\\|"))
588 ;; To ensure we always get the right build reporter, alias the
589 ;; incompatible one to ours if it is ever loaded.
591 (eval-after-load "build-report"
592 (defalias 'build-report 'build-rpt))
595 ;;; build-rpt.el ends here