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