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.7 $
   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   "Composes a fresh mail message with the contents of the built XEmacs
 275 Installation file and excerpts from XEmacs make output.
 276 `compose-mail' is used to create the mail message.  Point is left at
 277 the beginning of the mail text.  You may add some personal notes if
 278 you like and send the report.
 279 See also
 280   `compose-mail', `mail-user-agent',
 281   `build-report-destination',
 282   `build-report-keep-regexp',
 283   `build-report-delete-regexp',
 284   `build-report-make-output-dir',
 285   `build-report-make-output-files', and
 286   `build-report-installation-file'."
 287   ;; `interactive' form returns value for formal parameter `args'.
 288   (interactive
 289    (let (prompt
 290          hist
 291          arg
 292          (prompts build-report-prompts))
 293      (progn
 294        (while prompts
 295          (defvar hist)
 296          (setq prompt (caar prompts))
 297          (setq hist (cdar prompts))
 298          ;; `build-report-prompts' used to be a list of lists, the
 299          ;; first element of each list being the prompt, the rest being
 300          ;; the history.  The history is now in a separate list.  We
 301          ;; better check for that.
 302          (if (listp (car hist))
 303              (setq hist (car hist)))
 304          (setq prompts (cdr prompts))
 305          (setq arg (cons (read-string prompt "" 'hist) arg)))
 306        arg)))
 307   (save-excursion
 308     (if (file-exists-p build-report-installation-file)
 309         (multiple-value-bind
 310             (major minor beta codename configuration)
 311             (build-report-installation-data build-report-installation-file)
 312           (setq build-report-subject
 313                 (format "[%%s] XEmacs %s.%s%s \"%s\", %s"
 314                         major minor beta codename configuration)))
 315       (multiple-value-bind
 316           (major minor beta codename)
 317           (build-report-version-file-data build-report-version-file)
 318         (setq build-report-subject
 319               (format "[%%s] XEmacs %s.%s%s \"%s\", %s"
 320                       major minor beta codename system-configuration))))
 321     (compose-mail
 322      ;; `build-report-destination' used to be a single string, so
 323      ;; let's test if we really get a list of destinations.
 324      (if (listp build-report-destination)
 325          (read-string
 326           "Build Report Destination: "
 327           (car build-report-destination)
 328           'build-report-destination)
 329        (read-string
 330         "Build Report Destination: "
 331         build-report-destination)
 332        )
 333      (apply 'format build-report-subject args)
 334      nil
 335      nil
 336      nil
 337      nil
 338      nil)
 339     (let* ((report-begin (point))
 340            (files (reverse (build-report-make-output-get)))
 341            (file (car files)))
 342       (while file
 343         (if (file-exists-p file)
 344             (insert (build-report-insert-make-output report-begin file))
 345           (insert (format "%s not found!\n" file)))
 346         (insert "\n")
 347         (setq files (cdr files))
 348         (setq file (car files)))
 349       (if (file-exists-p build-report-installation-file)
 350           (insert (build-report-insert-installation-file
 351                    report-begin
 352                    build-report-installation-insert-all))
 353         (insert (format "%s not found!\n" build-report-installation-file)))
 354 ;;;       (when (and (>= major 21) (>= minor 2) (or (null beta) (>= beta 32)))
 355 ;;;         (insert "\n")
 356 ;;;         (insert (build-report-insert-config-inc report-begin)))
 357       (insert "\n")
 358       (insert (build-report-insert-header report-begin))
 359       (goto-char report-begin))))
 360
 361 (defun build-report-insert-header (where)
 362   "Inserts the build-report-header at the point specified by `where'."
 363   (goto-char where)
 364   (with-temp-buffer
 365     (insert
 366      (format "
 367 > XEmacs Build Report generated by emacs-version
 368 > %s
 369 > with system-configuration
 370 > %s
 371 > follows:\n\n" emacs-version system-configuration))
 372     (buffer-string)))
 373
 374 (defun build-report-insert-make-output (where file)
 375   "Inserts the output of the XEmacs Beta make run in the
 376 current buffer at position WHERE.
 377 The make process output must have been saved in
 378 `build-report-make-output-files' during the XEmacs Beta building."
 379   (goto-char where)
 380   (with-temp-buffer
 381     (if (file-exists-p file)
 382         (progn
 383           (if (featurep 'mime-setup)
 384               (progn
 385                 (mime-edit-insert-tag
 386                  "text"
 387                  "plain"
 388                  (concat
 389                   "\nContent-Disposition: attachment;"
 390                   " filename=\""
 391                   (file-name-nondirectory
 392                    file)
 393                   "\""))
 394                 (mime-edit-insert-binary-file
 395                  file
 396                  build-report-file-encoding))
 397             (insert-file-contents file))
 398           (when build-report-keep-regexp
 399             (goto-char (point-min))
 400             (delete-non-matching-lines (build-report-keep)))
 401           (when build-report-delete-regexp
 402             (goto-char (point-min))
 403             (delete-matching-lines (build-report-delete)))
 404           (goto-char (point-min))
 405           (if build-report-keep-regexp
 406               (insert
 407                (format
 408                 "> keeping lines matching
 409 > \"%s\"
 410 "
 411                 (build-report-keep))))
 412           (if build-report-delete-regexp
 413               (insert
 414                (format
 415                 "> %sdeleting lines matching
 416 > \"%s\"
 417 "
 418                 (if build-report-keep-regexp
 419                     "and then "
 420                   "")
 421                 (build-report-delete))))
 422           (insert "\n")
 423           (goto-char (point-min))
 424           (insert
 425            (format "> Contents of %s\n" file)))
 426       (insert "> " file
 427               " does not exist!\n\n"))
 428     (buffer-string)))
 429
 430 (defun build-report-insert-installation-file (where all)
 431   "Inserts the contents of the `build-report-installation-file'
 432 created by the XEmacs Beta configure process."
 433   (goto-char where)
 434   (with-temp-buffer
 435     (if (file-exists-p build-report-installation-file)
 436         (let (file-begin last-configure)
 437           (insert "> Contents of "
 438                   build-report-installation-file
 439                   ":\n")
 440           (insert
 441            (format
 442             "> (Output from %s of ./configure)\n\n"
 443             (if all "all runs" "most recent run")))
 444           (if (featurep 'mime-setup)
 445               (progn
 446                 (mime-edit-insert-tag
 447                  "text"
 448                  "plain"
 449                  (concat
 450                   "\nContent-Disposition: attachment;"
 451                   " filename=\""
 452                   (file-name-nondirectory
 453                    build-report-installation-file)
 454                   "\""))
 455                 (mime-edit-insert-binary-file
 456                  build-report-installation-file
 457                  build-report-file-encoding)
 458                 (setq file-begin (mime-edit-content-beginning)))
 459             (setq file-begin (point))
 460             (insert-file-contents
 461              build-report-installation-file))
 462           (unless all
 463             (setq last-configure
 464                   (search-backward-regexp
 465                    "^\\(uname.*\\|osversion\\|OS\\):\\s-+" file-begin t))
 466             (if (and file-begin last-configure)
 467                 (delete-region file-begin last-configure))))
 468       (insert "> " build-report-installation-file
 469               " does not exist!\n\n"))
 470     (buffer-string)))
 471
 472 (defun build-report-keep ()
 473   "Concatenate elements of `build-report-keep-regexp' and a general
 474 MIME tag REGEXP.  The result is a REGEXP string matching either of the
 475 REGEXPs in `build-report-keep-regexp' or a general MIME tag REGEXP."
 476   (mapconcat #'identity
 477              (cons "^--\\[\\[\\|\\]\\]$" build-report-keep-regexp) "\\|"))
 478
 479 (defun build-report-delete ()
 480   "Concatenate elements of `build-report-delete-regexp' and a general
 481 MIME tag REGEXP.  The result is a REGEXP string matching either of the
 482 REGEXPs in `build-report-delete-regexp' or a general MIME tag REGEXP."
 483   (mapconcat '(lambda (item) item)
 484              build-report-delete-regexp "\\|"))
 485
 486 (defun build-report-installation-data (&optional file)
 487   "Return a list of XEmacs installation data containing MAJOR_NUMBER
 488 MINOR_NUMBER BETA_STRING CODENAME CONFIGURATION SRCDIR from FILE,
 489 which defaults to `build-report-installation-file'."
 490   (interactive "fInstallation file: ")
 491   (unless file
 492     (setq file build-report-installation-file))
 493   (let
 494       (major minor beta codename configuration srcdir)
 495     (save-window-excursion
 496       (find-file-read-only file)
 497       (goto-char (point-min))
 498       (while (< (point) (point-max))
 499         (cond
 500          ((looking-at build-report-installation-version-regexp)
 501           (goto-char (match-end 0))
 502           (setq major (match-string 1))
 503           (setq minor (match-string 2))
 504           (setq beta (match-string 3))
 505           (setq codename (match-string 6))
 506           (setq configuration (match-string 7)))
 507          ((looking-at build-report-installation-srcdir-regexp)
 508           (goto-char (match-end 0))
 509           (setq srcdir (match-string 1)))
 510          ;; We avoid matching a potentially zero-length string to avoid
 511          ;; infinite looping.
 512          ((looking-at
 513            "^.+$")
 514           (goto-char (match-end 0)))
 515          ((looking-at "\n")
 516           (goto-char (match-end 0)))))
 517       (values major minor (or beta "") codename configuration srcdir))))
 518
 519 (defun build-report-version-file-data (&optional file)
 520   "Return a list of XEmacs version information containing
 521 MAJOR_NUMBER MINOR_NUMBER BETA_STRING CODENAME from FILE, which
 522 defaults to `build-report-version-file'."
 523   (interactive "fversion.sh file: ")
 524   (unless file
 525     (setq file build-report-version-file))
 526   (let
 527       (major minor beta codename)
 528     (save-window-excursion
 529       (find-file-read-only file)
 530       (goto-char (point-min))
 531       (while (< (point) (point-max))
 532         (cond
 533          ((looking-at build-report-version-file-regexp)
 534           (goto-char (match-end 0))
 535           (setq major (match-string 1))
 536           (setq minor (match-string 2))
 537           (setq beta (match-string 3))
 538           (setq codename (match-string 4)))
 539          ;; We avoid matching a potentially zero-length string to avoid
 540          ;; infinite looping.
 541          ((looking-at
 542            "^.+$")
 543           (goto-char (match-end 0)))
 544          ((looking-at "\n")
 545           (goto-char (match-end 0)))))
 546       (values major minor (or beta "") codename))))
 547
 548 ;;; build-report.el ends here