;;; 	$Id: build.el,v 1.51 2003/01/11 18:09:53 adrian Exp $

;;{{{ Legalese

;; Copyright (C) 1997-2002 Adrian Aichner

;; Author: Adrian Aichner <adrian@xemacs.org>
;; Date: $Date: 2003/01/11 18:09:53 $
;; Version: $Revision: 1.51 $
;; Keywords: internal

;; This file is part of XEmacs.

;; XEmacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XEmacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: Not synched.

;;}}}

;;{{{ provide/require

(provide 'build)

(require 'custom)
(require 'cus-edit)
(require 'widget)
(require 'build-report)

(autoload 'ring-insert-at-beginning "ring")
(autoload 'efs-copy-file "efs")

;; `url-copy-file' (buffer: build.el, mode: Lisp)

(eval-when-compile
  (require 'cl))

;; Pull in compile, if it is available.
(condition-case nil
    (require 'compile)
  (error nil))

(eval-when-compile
  (require 'wid-edit))

;; Pull in pcl-cvs, if it is available.
(condition-case nil
    (require 'pcl-cvs)
  (error nil))

;;}}}

(defcustom build-from-what
  "Tarballs"
  "The Source Code units XEmacs is to be built from (\"Tarballs\" or
\"CVS\")."
  :type '(choice
          :custom-state t
          (const "Tarballs")
          (const "CVS"))
  :group 'build)

(defcustom build-with-what
  "GNU Tools"
  "The Toolset XEmacs is to be built with (\"GNU Tools\" or
\"Microsoft Tools\")."
  :type '(choice
          :custom-state t
          (const "GNU Tools")
          (const "Microsoft Tools"))
  :group 'build)

;;{{{ Version info

;;;
;;; Version-handling, based on ideas from w3.
;;;
(defconst build-version-number
  (let ((x "2.00"))
    (if (string-match "Name:[ \t\n]+\\([^\n]+\\) \\$" x)
	(setq x (match-string 1 x))
      (setq x (substring x 0)))
    (mapconcat
     (function (lambda (x) (if (= x ?-) "." (char-to-string x)))) x ""))
  "Version number of build package.")

(defconst build-version-date
  (let ((x "2002-03-07"))
    (if (string-match "Date:[ \t\n]+\\([^\n]+\\) \\$" x)
	(match-string 1 x)
      x))
  "Date this version of build was released.")

(defconst build-version
  (format "build %s %s" build-version-number build-version-date)
  "More descriptive version of build-version-number.")

;;;###autoload
(defun build-version (&optional here)
  "Show the version number of `build' in the minibuffer.
If optional argument HERE is non-nil, insert info at point."
  (interactive "P")
  (if here
      (insert build-version)
    (if (interactive-p)
        (message-or-box "%s" build-version)
      build-version)))
;;}}}

;;{{{ Build

(defgroup build nil
  "Simplifies Building XEmacs; i.e. Fetching, Configuring, Making, and
Reporting."
  :link '(url-link :tag "XEmacs Build Reference Manual"
                   "http://www.xemacs.org/Documentation/packages/html/build.html")
  :link '(url-link :tag "XEmacs Beta README"
                   "ftp://ftp@ftp.xemacs.org/pub/xemacs/beta/README")
  :link '(url-link :tag "XEmacs Gamma README"
                   "ftp://ftp@ftp.xemacs.org/pub/xemacs/gamma/README")
  :link '(url-link :tag "XEmacs Stable README"
                   "ftp://ftp@ftp.xemacs.org/pub/xemacs/stable/README")
  :group 'emacs)


(defun build-call-process (command infile buffer displayp)
  (let (exit-status result)
    (with-temp-buffer
      (condition-case signal
          (setq exit-status
                (apply 'call-process
                       (append
                        (list (car command) infile buffer displayp)
                        (cdr command))))
        (error
         (warn "\n%s\ncannot be executed: %S %S\n"
               (mapconcat 'identity command " ")
               (car signal) (cdr signal))))
      ;; return value of result
      (setq result (cons exit-status (buffer-string))))))

;;;###autoload
(defun build ()
  "Creates a widget-based interface to build a beta/release version of
XEmacs.  All aspects of fetching tarballs, configuring, making and
reporting can be customized and executed from the newly created buffer
*Build*."
  (interactive)
  (let
      (exit-status
       (command
        (list
         "cvs" "-v"))
       infile
       (buffer (list t t))
       displayp
       result
;        build-from-cvs-button-widget
;        build-from-tarballs-button-widget
       (name "*Build XEmacs*"))
    (kill-buffer (get-buffer-create name))
    (switch-to-buffer (get-buffer-create name))
    (kill-all-local-variables)
    ;; Determine availability of CVS client.
    (message-or-box
     "build: checking whether you have cvs, please wait")
    (setq result
          (build-call-process command infile buffer displayp))
    (cond
     ((null (car result))
      (setq build-cvs-available-p nil)
      (warn "\nprogram %s cannot be found or executed\n"
            (car command))
      (setq build-from-what "Tarballs"))
     ((/= (car result) 0)
      (setq build-cvs-available-p nil)
      (warn "\n%s\nfailed with following output:\n%s\n"
            (mapconcat 'identity command " ")
            (cdr result))
      (setq build-from-what "Tarballs")
      (widget-insert
       "\n\nPlease install cvs, unless you want to build from our tary balls.\n"))
     (t
      (setq build-cvs-available-p t)
      (setq build-from-what "CVS")
      (message-or-box
       "build: cvs is available")))
    ;; Create widget-based interface.
    (widget-insert
     "Visit info documentation for the XEmacs build package inside ")
    (widget-create
     'info-link
     :tag "XEmacs"
     :value "(build)")
    (widget-insert "\nor on the XEmacs website at\n")
    (widget-create
     'url-link
     :value
     "http://www.xemacs.org/Documentation/packages/html/build.html")
    (widget-insert "\n\n")
    (let
	((inhibit-read-only t))
      (setq build-current-build-settings-widget
	    (widget-create
	     'string
	     :tag "Current Build Settings"
	     :value
	     "unknown")))
    (widget-apply
     build-current-build-settings-widget
     :deactivate)
    (widget-insert "\n")
    (widget-create 'push-button
		   :notify (lambda (&rest ignore)
                             (let
                                 ((name (widget-value build-settings-widget)))
                               (widget-apply
                                build-current-build-settings-widget
                                :activate)
                               (widget-value-set
                                build-current-build-settings-widget
                                name)
                               (widget-apply
                                build-current-build-settings-widget
                                :deactivate)
                               (widget-setup)
                               (build-settings-load name build-settings)
                               (message-or-box
                                "loaded \"%s\" build-settings"
                                name)))
                   "Load")
    (widget-insert " ")
    (widget-create 'push-button
		   :notify (lambda (&rest ignore)
                             (let*
                                 ((args
                                   (widget-get build-settings-widget :args))
                                  (value (widget-value build-settings-widget))
                                  new-args)
                               (if (string= value "default")
                                   (message-or-box
                                    "cannot delete \"%s\" build-settings"
                                    value)
                                 (when
                                     (yes-or-no-p
                                      (format "delete \"%s\" build-settings? " value))
                                   (setq
                                    new-args
                                    (remrassoc
                                     (list
                                      :value
                                      value)
                                     args))
                                   (widget-put
                                    build-settings-widget
                                    :args new-args)
                                   (widget-put
                                    build-settings-name-widget
                                    :args
                                    (cons (list 'string :value "default")
                                          new-args))
                                   (widget-value-set
                                    build-settings-widget
                                    (widget-get
                                     (first (widget-get build-settings-widget :args))
                                     :value))
                                   (widget-setup)
                                   (setq
                                    build-settings
                                    (remassoc
                                     value
                                     build-settings))
                                   (message-or-box
                                    "deleted \"%s\" build-settings"
                                    value)))))
		   "Delete")
    (widget-insert " ")
    (setq build-settings-widget
	  (widget-create 'choice
			 :tag "build settings"
                         :value "default"
                         :args
                         (cons
                          (list 'item :value "default")
                          (mapcar
                           (function
                            (lambda (setting)
                              (let ((name setting))
                                (list 'item :value (car setting))))) 
                           build-settings))
; 			 :notify (lambda (widget &rest ignore)
; 				   (setq build-settings (widget-value widget)))
			 '(item :value "default")))
    (widget-value-set
     build-settings-widget
     (widget-get
      (first (widget-get build-settings-widget :args))
      :value))
    (widget-create 'push-button
		   :notify (lambda (&rest ignore)
                             (let
                                 ((name
                                   (widget-value build-settings-name-widget)))
                               (unless
                                   (and
                                    (assoc name build-settings)
                                    (not
                                     (yes-or-no-p
                                      (format "overwrite current \"%s\" build-settings? " name))))
                                 (setq
                                  build-settings
                                  (build-settings-save-custom-group
                                   'build
                                   name
                                   build-settings))
                                 (unless
                                     (rassoc
                                      (cdr (list 'item :value name))
                                      (widget-get build-settings-widget :args))
                                   (widget-put
                                    build-settings-widget
                                    :args
                                    (cons (list 'item :value name)
                                          (widget-get build-settings-widget :args)))
                                   (widget-put
                                    build-settings-name-widget
                                    :args
                                    (cons (list 'item :value name)
                                          (widget-get build-settings-name-widget :args))))
                                 (customize-save-variable 'build-settings build-settings)
                                 (message-or-box
                                  "saved \"%s\" build-settings"
                                  name))))
		   "Save")
    (widget-insert " ")
    (setq build-settings-name-widget
	  (widget-create 'choice
			 :tag "current build settings as"
			 :value "default"
                         :args
                         (cons
                          (list 'string :value "default")
                          (mapcar
                           (function
                            (lambda (setting)
                              (let ((name setting))
                                (list 'item :value (car setting))))) 
                           build-settings))
; 			 :notify (lambda (widget &rest ignore)
; 				   (setq build-settings (widget-value widget)))
                         ))
    (widget-insert "Build settings are named build configurations allowing you to switch\nbetween them quickly, once you have set them up and saved them.  Please\nmake sure you have gone through all required customizations of the\nbuild process before you save them.  You may change existing settings\nat a later time, though.\n\n")
    (widget-create 'push-button
		   :notify (lambda (&rest ignore)
			     (customize-browse 'build))
		   "Browse Build Options ...")
    (widget-insert "\nBrowse and customize any options of the build process according to\nyour current choices for the sources to build from and the tools to\nbuild with.\n")
    (setq build-from-what-choice-widget
	  (widget-create 'choice
			 :tag "Build from"
			 :value build-from-what
			 :notify (lambda (widget &rest ignore)
				   (setq build-from-what (widget-value widget))
				   (cond
				    ((string-equal build-from-what "CVS")
				     (widget-apply
				      build-from-cvs-button-widget
				      :activate)
				     (widget-apply
				      build-from-tarballs-button-widget
				      :deactivate))
				    ((string-equal build-from-what "Tarballs")
				     (widget-apply
				      build-from-cvs-button-widget
				      :deactivate)
				     (widget-apply
				      build-from-tarballs-button-widget
				      :activate))))
			 '(item :value "CVS")
			 '(item :value "Tarballs")))
    (widget-insert
     "Please decide now whether to build XEmacs from tarballs in .tar.gz\nformat or from CVS sources.  Using CVS is highly recommended.")
    (widget-insert "\n\n")
    (setq build-with-what-choice-widget
	  (widget-create 'choice
			 :tag "Build with"
			 :value build-with-what
			 :notify (lambda (widget &rest ignore)
				   (setq build-with-what (widget-value widget)))
			 '(item :value "GNU Tools")
			 '(item :value "Microsoft Tools")
			 ))
    (widget-insert
     "Furthermore, please specify whether you will build with GNU tools\nusing configure and make or Microsoft Tools using nt\\xemacs.mak and\nVC++ 4.0 or higher.")
    (widget-insert "\n\n")
    (setq
     build-from-cvs-button-widget
     (widget-create 'push-button
		    :notify (lambda (&rest ignore)
			      (build-from-CVS))
		    "Build XEmacs From CVS Now"))
    (widget-insert "\n")
    ;; Recommend installation of CVS or provide cvs version
    ;; information.
    (if build-cvs-available-p
        (widget-insert (format "cvs -v returns this:\n%s\n" (cdr result)))
      (widget-insert
       "\n\nPlease install cvs, unless you want to build from our tary balls.\n"))
    ;; Building XEmacs from tarballs.
    (setq
     build-from-tarballs-button-widget
     (widget-create 'push-button
		    :notify (lambda (&rest ignore)
			      (build-from-tarballs))
		    "Build XEmacs From Tarballs Now"))
    ;; Initialize these buttons according to `build-from-what'.
    (cond
     ((string-equal build-from-what "CVS")
      (widget-apply
       build-from-cvs-button-widget
       :activate)
      (widget-apply
       build-from-tarballs-button-widget
       :deactivate))
     ((string-equal build-from-what "Tarballs")
      (widget-apply
       build-from-cvs-button-widget
       :deactivate)
      (widget-apply
       build-from-tarballs-button-widget
       :activate)))
    (widget-insert
     "\nProceed after you have chosen what sources to build from and what\ntools to build with.\n")
;    (widget-browse-other-window build-settings-widget)
    (use-local-map widget-keymap)
    (widget-setup)
    (custom-mode)
    (goto-char (point-min))))

;;}}}

;;{{{ Build Compilation

;;{{{ Compilation
(make-variable-buffer-local
 'compilation-finish-function)
(make-variable-buffer-local
 'compilation-exit-message-function)

(setq
 compilation-finish-function
 'build-compilation-finish-function
 compilation-exit-message-function
 (function build-compilation-exit-message-function))

;;}}}

(defun build-compilation-mode-hook ()
  (set (make-local-variable 'auto-save-hook)
       '(lambda ()
          (message "Auto-saved %s\n" (buffer-name))))
  (auto-save-mode 1)
  (insert
   (format
    "Compilation started at %s %+.4d (%s)\n"
    (current-time-string)
    (/ (nth 0 (current-time-zone)) 36)
    (nth 1 (current-time-zone)))))

(defun build-compilation-finish-function (comp-buffer finish-string)
  (message "Build Make finished in %s with status \"%s\"."
           (buffer-name comp-buffer) finish-string))

(defun build-compilation-exit-message-function (proc exit-msg)
  (message "Build Make exited with proc status \"%s\", exit status \"%s\", exit message \"%s\"."
           (process-status proc) (process-exit-status proc) exit-msg)
  (cons exit-msg (process-exit-status proc)))

;;}}}

;;{{{ Build Configure

(defconst build-configure-option-category
  "^\\(\\S-+\\).+\\(options\\|features\\):$"
  "REGEXP matching an XEmacs configuration option category in
configure.usage")

(defconst build-configure-option-paragraph
  "^\\(--[a-zA-Z][-a-zA-Z0-9]+\\)\\(=\\(\\S-+\\)\\)?\\(\\s-+(\\*)\\)?\\s-+\\(\\(.+\\)\\(\n[ \t]+.+\\)*\\)$"
  "REGEXP matching one XEmacs configuration option in
configure.usage")

(defun build-configure (&optional dir)
  "Configure XEmacs according to the settings in customized group
`build' and its members."
  (interactive)
  (if dir
      (cd dir))
  (let ((cmd
         (format "sh configure%s"
                 (mapconcat
                  (function (lambda (e)
                              (cond
                               ((or (string= "" (rest e))
                                    (string= "autodetected" (rest e))
                                    (string= "defaulted" (rest e)))
                                "")
                               ((string= "yes" (rest e))
                                (format " '%s'" (first e)))
                               ((and
                                 (string-match "\\`--without-\\(.+\\)\\'" (first e))
                                 (string= "no" (rest e)))
                                (format " '-with-%s'" (match-string 1 (first e))))
                               (t
                                (format " '%s=%s'" (first e) (rest e))))))
                  (delete-duplicates
                   build-configure-options :from-end t
                   :test (lambda (a b)
                           (string=
                            (first a) (first b))))
                  "")))
        (compilation-mode-hook
         'build-compilation-mode-hook)
        (compilation-buffer-name-function
         '(lambda (mode)
            (generate-new-buffer-name
             (cond
              ((string-equal build-from-what "Tarballs")
               (concat build-tarball-prefix "-configure.err"))
              ((string-equal build-from-what "CVS")
               (concat build-cvs-checkout-dir "-configure.err")))
             ))))
    (compile cmd)))

;;; Functionality which was prototyped in co2cu.el:

(defun build-configure-customize (a-list)
  (mapcar
   (lambda (cat)
     (princ (format "(defgroup build-configure-%s nil\n" (first cat)))
     (princ (format "  \"%s options.\"\n" (first cat)))
     (princ "  :group 'build-configure)\n\n")
     (list (first cat)
           (mapcar
            (lambda (opt)
              (cond
               ((or (member "TYPE[,TYPE]..." (second opt))
                    (and (member "TYPE" (second opt))
                         (string-match
                          "list\\s-+of"
                          (apply 'concat (fourth opt)))))
                (build-configure-types cat opt)
                )
               ((member "TYPE" (second opt))
                (build-configure-type cat opt)
                )
               ((member "FLAGS" (second opt))
                (build-configure-string cat opt)
                )
               ;; compiler=XXXX prior to r21.0-b34
               ((member "XXXX" (second opt))
                (build-configure-file cat opt)
                )
               ;; compiler=prog after Martin Buchholz's configure
               ;; mega-patch to r21.0-b34-pre2
               ((member "prog" (second opt))
                (build-configure-file cat opt)
                )
               ((member "VALUE" (second opt))
                (build-configure-string cat opt)
                )
               ((member "DIR" (second opt))
                (build-configure-dir cat opt)
                )
               ((member "LIB" (second opt))
                (build-configure-file cat opt)
                )
               ((member "PATH" (second opt))
                (build-configure-path cat opt)
                )
               ((or (null (second opt))
                    (subsetp (second opt)
                             '("no" "yes") :test 'string-equal))
                (build-configure-type cat opt)
                )
               (t
                (build-configure-type cat opt)
                )
               ))
            (delete-duplicates
             (cdr cat) :from-end t
             :test (lambda (a b)
                     (string=
                      (first a) (first b)))))))
   a-list))

(defun build-configure-process-option (option value detected doc category a-list)
  (let (prev-val prev-doc pos doc-vals)
    (unless (null value)
      (setq prev-val
            (first (cdr (assoc option (assoc category a-list)))))
      (setq prev-val
            (append prev-val (list value))))
    (setq detected
          (or
           (second (cdr (assoc option (assoc category a-list))))
           (null (null detected))))
    (setq prev-doc
          (third (cdr (assoc option (assoc category a-list)))))
    (unless (null doc)
      (setq prev-doc (append prev-doc (list doc)))
      (setq pos 0)
      (setq doc-vals (concat (first prev-doc)))
      (while (string-match "`\\(\\w+\\)'" doc pos)
        (setq prev-val
              (append prev-val (list (match-string 1 doc))))
        (setq pos (match-end 0)))
      (unless
          (null
           (string-match "\\([Vv]alid\\s-+types\\s-+are\\s-+\\|(\\)\\(\\(\\w+\\)\\(,\\s-*\\(\\(and\\|or\\)\\s-+\\)?\\(\\w+\\)\\)+\\)\\()\\|\\.\\)" doc 0))
        (setq doc-vals (match-string 2 doc))
        (setq pos 0)
        (while
            (string-match "\\(\\(,\\s-*\\(\\(and\\|or\\)\\s-+\\)?\\)?\\(\\w+\\)\\)" doc-vals pos)
          (setq prev-val
                (append prev-val (list (match-string 5 doc-vals))))
          (setq pos (match-end 0)))))
    (setcdr
     (assoc category a-list)
     (acons
      option
      (list prev-val detected prev-doc)
      (cdr (assoc category a-list))))))

(defun build-configure-generate (&optional file)
  (interactive "fconfigure.usage file: ")
  (unless file
    (setq file
          (expand-file-name
           "configure.usage"
           (cond
            ((string-equal build-from-what "Tarballs")
             (expand-file-name
              build-tarball-prefix
              build-tarball-dest))
            ((string-equal build-from-what "CVS")
             (expand-file-name
              build-cvs-checkout-dir
              build-cvs-checkout-parent-dir))))))
  (let
      (category categories option value detected doc build-configure-alist
                (buffer "build-configure.el"))
    (kill-buffer (get-buffer-create buffer))
    (with-output-to-temp-buffer buffer
      (save-window-excursion
        (find-file-read-only file)
        (build-configure-prolog file)
        (goto-char (point-min))
        (while (< (point) (point-max))
          (cond
           ((looking-at build-configure-option-paragraph)
            (goto-char (match-end 0))
            (build-configure-process-option
             (match-string 1)
             (match-string 3)
             (match-string 4)
             (match-string 5)
             category
             build-configure-alist))
           ((looking-at build-configure-option-category)
            (goto-char (match-end 0))
            (setq category (match-string 1))
            (setq build-configure-alist
                  (append build-configure-alist (list (list category)))))
           ;; We avoid matching a potentially zero-length string to
           ;; avoid infinite looping.
           ((looking-at
             "^.+$")
            (goto-char (match-end 0)))
           ((looking-at "\n")
            (goto-char (match-end 0)))))
        (build-configure-customize build-configure-alist)
;        (print build-configure-alist)
        ))
;    (set-buffer buffer)
;    (switch-to-buffer (get-buffer-create name))
    (kill-all-local-variables)
    (lisp-mode)
    (font-lock-mode 1)
    (toggle-read-only 1)))

(defun build-configure-string (cat opt)
  (princ (format "(defcustom build-configure%s\n" (first opt)))
  (princ "  \"\"\n")
  (princ (format "  %S\n" (build-configure-fill-doc (fourth opt))))
  (princ (format "  :group \'build-configure-%s\n" (first cat)))
  (princ "  :type '(string)\n")
  (princ "  :set 'build-configure-set-value)\n")
  (princ "\n"))

(defun build-configure-file (cat opt)
  (princ (format "(defcustom build-configure%s\n" (first opt)))
  (princ "  \"\"\n")
  (princ (format "  %S\n" (build-configure-fill-doc (fourth opt))))
  (princ (format "  :group \'build-configure-%s\n" (first cat)))
  (princ "  :type '(file)\n")
  (princ "  :set 'build-configure-set-value)\n")
  (princ "\n"))

(defun build-configure-dir (cat opt)
  (princ (format "(defcustom build-configure%s\n" (first opt)))
  (princ "  \"\"\n")
  (princ (format "  %S\n" (build-configure-fill-doc (fourth opt))))
  (princ (format "  :group \'build-configure-%s\n" (first cat)))
  (princ "  :type '(directory)\n")
  (princ "  :set 'build-configure-set-value)\n")
  (princ "\n"))

(defun build-configure-path (cat opt)
  (princ (format "(defcustom build-configure%s\n" (first opt)))
  (princ "  '()\n")
  (princ (format "  %S\n" (build-configure-fill-doc (fourth opt))))
  (princ (format "  :group \'build-configure-%s\n" (first cat)))
  (princ "  :type '(repeat\n")
  (princ "          :custom-show t\n")
  (princ "          :documentation-shown t\n")
  (princ "          (directory))\n")
  (princ "  :set 'build-set-path)\n")
  (princ "\n"))

(defun build-configure-types (cat opt)
  (princ (format "(defcustom build-configure%s\n" (first opt)))
  (princ (format "  '(%S)\n"
                 (if (third opt) "autodetected" "defaulted")))
  (princ (format "  %S\n" (build-configure-fill-doc (fourth opt))))
  (princ (format "  :group \'build-configure-%s\n" (first cat)))
  (princ "  :type '(choice\n")
  (if (third opt)
      (princ "          (const (\"autodetected\"))\n")
    (princ "          (const (\"defaulted\"))\n"))
  (princ "          (const (\"no\"))\n")
  (princ "          (set")
  (mapc (lambda (e)
          (princ (format "\n           (const %S)" e)))
        (set-difference
         (second opt)
         '("no" "TYPE[,TYPE]..." "TYPE")
         :test 'string=))
  (princ "))\n")
  (princ "  :set 'build-set-types)\n")
  (princ "\n"))

(defun build-configure-type (cat opt)
  (princ (format "(defcustom build-configure%s\n" (first opt)))
  (princ (format "  %S\n"
                 (if (third opt) "autodetected" "defaulted")))
  (princ (format "  %S\n" (build-configure-fill-doc (fourth opt))))
  (princ (format "  :group \'build-configure-%s\n" (first cat)))
  (princ "  :type '(choice\n")
  (if (third opt)
      (princ "          (const \"autodetected\")\n")
    (princ "          (const \"defaulted\")\n"))
  (princ "          (const \"no\")")
  (if (subsetp (second opt) '("no" "yes") :test 'string-equal)
      (princ "\n          (const \"yes\")")
    (mapc (lambda (e)
            (princ (format "\n          (const %S)" e)))
          (set-difference
           (second opt)
           '("no" "TYPE[,TYPE]..." "TYPE")
           :test 'string=)))
  (princ ")\n")
  (princ "  :set 'build-configure-set-value)\n")
  (princ "\n"))

(defun build-configure-fill-doc (doc)
  (with-temp-buffer
    (let ((sentence-end-double-space t)
          (use-hard-newlines t)
          (colon-double-space t))
      (insert (mapconcat 'eval doc "  "))
      (canonically-space-region (point-min) (point-max))
      (fill-region (point-min) (point-max))
      (goto-char (point-min))
      (while (re-search-forward "\\s-+\\'" nil t)
        (replace-match "" nil nil))
      (buffer-string))))

(defun build-configure-prolog (file)
  (princ ";;; Produced from
;;; ")
  (princ file)
  (princ "
;;; by ")
  (princ
   ;; Make sure the RCS keyword Id does not end up in the output file,
   ;; in case build.el is not `co -kv ...' or during development.
   (with-temp-buffer
     (insert build-version)
     (while (re-search-backward "\\$" nil t)
       (replace-match "" nil nil))
     (buffer-string)))
  (princ "\n;;; at\n;;; ")
  (princ (format-time-string "%a %b %d %T %Z %Y"))
  (princ "
(provide 'build-configure)\n
(setq build-configure-options nil)\n
(defun build-configure-sym-to-opt (sym)
  (substring (symbol-name sym) 15))\n
(defun build-set-path (sym val)
  (setq  build-configure-options
	 (acons (build-configure-sym-to-opt sym)
		(mapconcat '(lambda (item) item) val \":\")
		build-configure-options))
  (set-default sym val))\n
(defun build-set-types (sym val)
  (setq build-configure-options
	(acons (build-configure-sym-to-opt sym)
	       (mapconcat '(lambda (item) item) val \",\")
	       build-configure-options))
  (set-default sym val))\n
(defun build-configure-set-value (sym val)
  (setq build-configure-options
	(acons (build-configure-sym-to-opt sym) val
	       build-configure-options))
  (set-default sym val))\n
(defgroup build-configure nil
  \"XEmacs Build Configuration.\"
  :group 'build)\n
"))

;;}}}

;;{{{ Build CVS

(defvar build-cvs-available-p nil
  "Internal variable keeping track whether CVS is available.")

(defgroup build-cvs nil
  "Standardizes the fetching of XEmacs from the CVS repository."
  :group 'build)

(defun build-cvs-get-branch-and-release-tags ()
  "Retrieve all symbolic names (CVS tags) for XEmacs from version.sh."
  (interactive)
  (let*
      (exit-status
       (file "XEmacs/xemacs/version.sh")
       (co-command
        (list
         "cvs" "-d" build-cvs-xemacs-repository "checkout" file))
       (status-command
        (list
         "cvs" "-d" build-cvs-xemacs-repository "status" "-v" file))
       infile
       (buffer (list t t))
       displayp
       result
       last-match-end
       this-match-beginning
       tags)
    (with-temp-buffer
      (cd (temp-directory))
      (unless
	  (file-exists-p file)
	(message-or-box
	 "build: checking out %s to determine cvs tags" file)
	(setq result
	      (build-call-process co-command infile buffer displayp))
	(cond
	 ((null (car result))
	  (warn "\nprogram %s cannot be found or executed\n"
		(car co-command)))
	 ((/= (car result) 0)
	  (warn "\n%s\nfailed with following output:\n%s\n"
		(mapconcat 'identity co-command " ")
		(cdr result)))
	 (t
	  (message-or-box
	   "build: %s has been checked out" file))))
      (message-or-box
       "build: retrieving cvs tags from %s" file)
      (setq result
	    (build-call-process status-command infile buffer displayp))
      (cond
       ((null (car result))
	(warn "\nprogram %s cannot be found or executed\n"
	      (car status-command)))
       ((/= (car result) 0)
	(warn "\n%s\nfailed with following output:\n%s\n"
	      (mapconcat 'identity status-command " ")
	      (cdr result)))
       (t
	(message-or-box
	 "build: cvs tags have been retrieved from %s" file)))
      (if
	  (setq this-match-beginning
		(string-match "^\\s-+Existing Tags:\n" (cdr result)))
	  (setq last-match-end (match-end 0)))
      (while
	  (and 
	   (setq this-match-beginning 
		 (string-match
		  "\t\\(\\S-+\\)\\s-+\\(.*\\)\n" (cdr result) last-match-end))
	   (= last-match-end this-match-beginning))
	(setq last-match-end (match-end 0))
	(if last-match-end
	    (push (list
		   (match-string 1 (cdr result))
		   (match-string 2 (cdr result))) tags)))
      (reverse tags))))

(defun build-cvs-checkout-options-validate (sym val)
  (cond
   ((string-match "-\\(d\\|N\\)\\b" val)
    (customize-set-value sym build-cvs-checkout-options)
    (warn "cannot use -d and -N.  `build-cvs-checkout-dir' will be used as -d argument if set, else `build-cvs-xemacs-module' will be used.  The -N option is unsupported."))
   (t
    (build-cvs-set-var-and-update-buffer sym val))))

(defun build-cvs-set-var-and-update-buffer (sym val)
  "Internal function for build."
  (set-default sym val)
  (when (fboundp 'build-from-CVS)
    (save-window-excursion
      (save-excursion
        (build-from-CVS)))))

(defcustom build-cvs-checkout-options
  "-P"
  "CVS checkout command-line options to use for all CVS commands."
  :type 'string
  :set 'build-cvs-checkout-options-validate
  :group 'build-cvs)

(defcustom build-cvs-options
  "-z3"
  "CVS command-line options to use for all CVS commands."
  :type 'string
  :set 'build-cvs-set-var-and-update-buffer
  :group 'build-cvs)

(defcustom build-cvs-update-options
  "-P -d"
  "CVS update command-line options to use for all CVS commands."
  :type 'string
  :set 'build-cvs-set-var-and-update-buffer
  :group 'build-cvs)

(defcustom build-cvs-checkout-parent-dir
  (temp-directory)
  "The parent directory on the local host into which the
`build-cvs-xemacs-module' will be checked out, named according to
`build-cvs-checkout-dir'."
  :type 'directory
  :set 'build-cvs-set-var-and-update-buffer
  :group 'build-cvs)

(defconst build-cvs-xemacs-module
  "xemacs"
  "CVS XEmacs module name to be checked out.")

(defvar build-cvs-checkout-dir
  nil
  "Internal variable updated from user variable
  `build-cvs-working-dir-naming'.")

(defcustom build-cvs-use-pcl-cvs
  nil
  "*Whether build is to use PCL-CVS, when available.
Alternatively, build will run CVS commands via `compile'."
  :type 'boolean
  :set 'build-cvs-set-var-and-update-buffer
  :group 'build-cvs)

(defcustom build-cvs-xemacs-repository
  ":pserver:cvs@cvs.xemacs.org:/pack/xemacscvs"
  "CVS Repository where XEmacs can be checked out from."
  :type 'string
  :set 'build-cvs-set-var-and-update-buffer
  :group 'build-cvs)

(defcustom build-cvs-working-dir-naming
  '(format "%s-%s"
           build-cvs-xemacs-module
           build-cvs-xemacs-release)
  "The naming of the directory on the local host into which the
`build-cvs-xemacs-module' will be checked out. Be aware that cvs
checkout options -d and -N will affect the resulting directory
structure.  Therefor these options are disallowed in
`build-cvs-checkout-options'.  The -N option is not supported, in order
to avoid unknown directory structures."
  :type '(choice
          (const :tag "Named after CVS MODULE" build-cvs-xemacs-module)
          (const :tag "Named after RELEASE Tag" build-cvs-xemacs-release)
          (const :tag "Named after MODULE-RELEASE"
                 (format "%s-%s"
                         build-cvs-xemacs-module
                         build-cvs-xemacs-release))
          (string :tag "Working Dir Named manually" ""))
  :set 'build-cvs-set-var-and-update-buffer
  :group 'build-cvs)

(defcustom build-cvs-xemacs-release
  "HEAD"
  "CVS XEmacs release to be checked out.
The list of available releases is updated via cvs, if installed, by
`build-from-CVS'.  Use \"Specify Tag Name\" to fill in the name of a
release tag not yet in the list of choices."
  :type '(choice :custom-state t
                 (string :tag "Unlisted Release Name" "")
                 (const :tag "release-21-1 (branch: 1.165.2)" "release-21-1")
                 (const :tag "release-21-4 (branch: 1.166.2)" "release-21-4")
                 (const :tag "r21-5-9 (revision: 1.183)" "r21-5-9"))
  :set 'build-cvs-set-var-and-update-buffer
  :group 'build-cvs)

(defun build-cvs-login ()
  "Login to XEmacs CVS repository."
  (interactive)
  (unless (file-exists-p build-cvs-checkout-parent-dir)
    (make-directory build-cvs-checkout-parent-dir t))
  (cd build-cvs-checkout-parent-dir)
  (let (exit-status
        (command
         (list
          "cvs" build-cvs-options "-d" build-cvs-xemacs-repository "login"))
        (file (make-temp-name (expand-file-name "cvs-login" (getenv "TEMP"))))
        (buffer (list t t))
        displayp)
    (with-temp-file file (insert "cvs\n"))
    (message-or-box "build: cvs login at cvs.xemacs.org, please wait")
    (setq result
          (build-call-process command file buffer displayp))
    (cond
     ((null (car result))
      (setq build-cvs-available-p nil)
      (warn "\nprogram %s cannot be found or executed\n"
            (car command)))
     ((/= (car result) 0)
      (setq build-cvs-available-p nil)
      (warn "\n%s\nfails with following output:\n%s\n"
            (mapconcat 'identity command " ")
            (cdr result)))
     (t
      (setq build-cvs-available-p t)
      (message-or-box "build: cvs login succeeded")))
    (delete-file file)))

(defun build-cvs-checkout (&optional release-tag)
  "Fetch XEmacs from the repository."
  (interactive "sXEmacs Release Tag: ")
  (unless (file-exists-p build-cvs-checkout-parent-dir)
    (make-directory build-cvs-checkout-parent-dir t))
  (cd build-cvs-checkout-parent-dir)
  (let ((cmd
         (format "cvs %s -d%s checkout %s -d %s%s %s"
                 build-cvs-options
                 build-cvs-xemacs-repository
                 build-cvs-checkout-options
                 build-cvs-checkout-dir
                 (if (and release-tag
                          (not (string-equal release-tag "")))
                     (concat " -r " release-tag)
                   "")
                 build-cvs-xemacs-module))
        (compilation-mode-hook
         'build-compilation-mode-hook)
        (compilation-buffer-name-function
         '(lambda (mode)
            (generate-new-buffer-name
             (format "%s-cvs-checkout%s.err" build-cvs-checkout-dir
                     (if (and release-tag
                              (not (string-equal release-tag "")))
                         (format "-%s" release-tag)
                       ""))))))
    (compile cmd)))

(defun build-cvs-update (&optional release-tag)
  "Update XEmacs from the repository to newest release or to release
specified by RELEASE-TAG'."
  (interactive "sXEmacs Release Tag: ")
  (cd
   (expand-file-name build-cvs-checkout-dir
                     build-cvs-checkout-parent-dir))
  (let ((cmd
         (format "cvs %s update %s%s"
                 build-cvs-options
                 build-cvs-update-options
                 (if (and release-tag
                          (not (string-equal release-tag "")))
                     (concat " -r " release-tag)
                   " -A")
                 ))
        (compilation-mode-hook
         'build-compilation-mode-hook)
        (compilation-buffer-name-function
         '(lambda (mode)
            (generate-new-buffer-name
             (concat build-cvs-checkout-dir "-cvs-update"
                     (when (and release-tag
                                (not (string-equal release-tag "")))
                       (format "-%s" release-tag))
                     ".err")))))
    (cond
     ((and
       build-cvs-use-pcl-cvs
       (featurep 'pcl-cvs))
      (cvs-update
       (expand-file-name build-cvs-checkout-dir
                         build-cvs-checkout-parent-dir)
       (split-string build-cvs-update-options "\\s-+")))
     (t
      (compile cmd)))))

;;}}}

;;{{{ Build From

(defun build-from-CVS ()
  (interactive)
  (let
      ((name
        (format "*Build XEmacs From CVS With %s*" build-with-what)))
    (kill-buffer (get-buffer-create name))
    (switch-to-buffer (get-buffer-create name))
    (kill-all-local-variables)
    (unless (file-exists-p build-cvs-checkout-parent-dir)
      (make-directory build-cvs-checkout-parent-dir t))
    (cd build-cvs-checkout-parent-dir)
    ;; #### FIXME build-cvs-checkout-dir is not driven by custom
    ;; events as it should be!
    (setq build-cvs-checkout-dir
          (eval build-cvs-working-dir-naming))
    (put 'build-cvs-xemacs-release 'custom-type
         (append
          '(choice
            :custom-state t)
          (cons
           '(string :tag "Unlisted Release Name" "")
           (mapcar
            (function
             (lambda (tag)
               (list
                'const
                :tag (format "%s %s" (first tag) (second tag)) (first tag))))
            (build-cvs-get-branch-and-release-tags)))))
    (widget-insert "\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (let
                                 ((buffer-back "*Build XEmacs*"))
                               (if (buffer-live-p (get-buffer buffer-back))
                                   (switch-to-buffer buffer-back)
                                 (build))))
                   "Go Back")
    (widget-insert
     "\nYou need to customize CVS options and then download a release\nof XEmacs.\n\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (customize-browse 'build-cvs))
                   "Browse Build CVS Options ...")
    (widget-insert "\n")
    (widget-insert
     (format "\t%+20s: %s\n" "Use Pcl Cvs"
             (if build-cvs-use-pcl-cvs "Yes" "No")))
    (widget-insert
     (format "\t%+20s: \"%s\"\n" "XEmacs CVS Repository"
             build-cvs-xemacs-repository))
    (widget-insert
     (format "\t%+20s: \"%s\"\n" "CVS Options"
             build-cvs-options))
    (widget-insert
     (format "\t%+20s: \"%s\"\n" "Checkout Options"
             build-cvs-checkout-options))
    (widget-insert
     (format "\t%+20s: \"%s\"\n" "Update Options"
             build-cvs-update-options))
    (widget-insert
     (format "\t%+20s: \"%s\"\n" "XEmacs Module"
             build-cvs-xemacs-module))
    (widget-insert
     (format "\t%+20s: \"%s\"\n" "XEmacs Release"
             build-cvs-xemacs-release))
    (widget-insert
     (format "\t%+20s: %S\n" "Working Dir Naming"
             build-cvs-working-dir-naming))
    (widget-insert
     (format "\t%+20s: \"%s\"\n" "Checkout Parent Dir"
             build-cvs-checkout-parent-dir))
    (widget-insert
     (format "\t%+20s: \"%s\"\n" "Working Dir"
             build-cvs-checkout-dir))
    (widget-insert "\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (build-cvs-login))
                   "CVS Login XEmacs")
    (widget-insert "\n\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (build-cvs-checkout
                              build-cvs-xemacs-release))
                   "CVS Checkout XEmacs")
    (widget-insert "\n\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (build-cvs-update
                              build-cvs-xemacs-release))
                   (format
                    "CVS Update XEmacs To CVS Tag \"%s\""
                    build-cvs-xemacs-release))
    (widget-insert "\nor\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (build-cvs-update))
                   "CVS Update To Latest XEmacs on Trunk")
    (widget-insert "\nMake sure to \"Browse Build CVS Options ...\" first.\nChoose XEmacs release to be checked out.\nAlternatively you can simply get the latest sources on the trunk (not\non any branch).  This is always the latest XEmacs version under\ndevelopment.  As of 2002-03-14 the trunk is headed for XEmacs 21.5.\n\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (let
                                 ((dir
                                   (cond
                                    ((string-equal build-with-what "GNU Tools")
                                     (expand-file-name
                                      build-cvs-checkout-dir
                                      build-cvs-checkout-parent-dir))
                                    ((string-equal build-with-what "Microsoft Tools")
                                     (expand-file-name
                                      "nt"
                                      (expand-file-name
                                       build-cvs-checkout-dir
                                       build-cvs-checkout-parent-dir))))))
                               (if
                                   (file-directory-p
                                    (file-name-as-directory dir))
                                   (cond
                                    ((string-equal build-with-what "GNU Tools")
                                     (build-with-GNU dir))
                                    ((string-equal build-with-what "Microsoft Tools")
                                     (build-with-MS dir)))
                                 (message-or-box "need to checkout to create %s?" dir))))
                   (format "Build XEmacs With %s Now ..." build-with-what))
    (use-local-map widget-keymap)
    (widget-setup)
    (custom-mode)
    (goto-char (point-min))))

(defun build-from-tarballs ()
  (interactive)
  (let
      ((name
        (format "*Build XEmacs From Tarballs With %s*" build-with-what)))
    (kill-buffer (get-buffer-create name))
    (switch-to-buffer (get-buffer-create name))
    (kill-all-local-variables)
    (cd build-tarball-dest)
    (widget-insert "\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (let
                                 ((buffer-back "*Build XEmacs*"))
                               (if (buffer-live-p (get-buffer buffer-back))
                                   (switch-to-buffer buffer-back)
                                 (build))))
                   "Go Back")
    (widget-insert
     "\nYou need to customize Tarball options and then download a beta/release\nversion of XEmacs.\n\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (customize-browse 'build-tarball))
                   "Browse Build Tarball Options ...")
    (widget-insert "\n\t")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (dired build-tarball-site))
                   "Browse Build Tarball Site ...")
    (widget-insert "\n\t")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (build-tarball-expand-all))
                   "View Build Tarball Set ...")
    (widget-insert "\n\t")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (build-tarball-get-all))
                   "Download Build Tarball Set")
    (widget-insert "\n\t")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (build-tarball-extract-all))
                   "Install Downloaded Build Tarball Set")
    (widget-insert "\n\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (cond
                              ((string-equal build-with-what "GNU Tools")
                               (build-with-GNU
                                (expand-file-name
                                 build-tarball-prefix
                                 build-tarball-dest)))
                              ((string-equal build-with-what "Microsoft Tools")
                               (build-with-MS
                                (expand-file-name
                                 "nt"
                                 (expand-file-name
                                  build-tarball-prefix
                                  build-tarball-dest))))))
                   (format "Build XEmacs With %s Now ..." build-with-what))
    (use-local-map widget-keymap)
    (widget-setup)
    (custom-mode)
    (goto-char (point-min))))

;;}}}

;;{{{ Build Tarballs

(defgroup build-tarball nil
  "Standardized the fetching of XEmacs beta/release tarballs."
  :group 'build)

(defcustom build-tarball-dest
  (temp-directory)
  "The destination directory on the local host the `build-tarball-set'
will be deposited in."
  :type 'directory
  :group 'build-tarball)

(defcustom build-tarball-dir
  "beta"
  "The sub-directory under `build-tarball-site' in which the
`build-tarball-set' is located."
  :type '(choice
          :custom-state t
          (const "beta")
          (const "gamma")
          (const "stable"))
  :group 'build-tarball)

(defcustom build-tarball-prefix
  "xemacs-21.5.6"
  "The prefix shared among all of the `build-tarball-set'.  This makes
it easy to switch over from one beta/gamma/stable release tarball set
to the next,
e.g. from \"xemacs-21.5.5\" to \"xemacs-21.5.6\"."
  :type 'string
  :group 'build-tarball)

(defcustom build-tarball-set
  nil
  "The set of final name components of XEmacs tarballs you wish to
fetch."
  :type'(set
         (const :tag "XEmacs byte-compiled lisp tarball" "-elc.tar.gz")
         (const :tag "XEmacs byte-compiled lisp tarball signature" "-elc.tar.gz.asc")
         (const :tag "XEmacs info tarball" "-info.tar.gz")
         (const :tag "XEmacs info tarball signature" "-info.tar.gz.asc")
         (const :tag "XEmacs Mule tarball" "-mule.tar.gz")
         (const :tag "XEmacs Mule tarball signature" "-mule.tar.gz.asc")
         (const :tag "XEmacs source tarball" ".tar.gz")
         (const :tag "XEmacs source tarball signature" ".tar.gz.asc")
         (repeat
          :custom-show t
          :documentation-shown t
          (string "")))
  :group 'build-tarball)

(defcustom build-tarball-site
  "/ftp@ftp.xemacs.org:/pub/xemacs/"
  "The EFS path to a top-level XEmacs directory to fetch the XEmacs
  `build-tarball-set' from.
The list of available sites is dynamically generated based on
`package-get-download-sites'.  In addition you may set the value to a
manually chosen EFS path."
  :link '(url-link :tag "XEmacs Download Locations"
                   "http://www.xemacs.org/Download/")
  :type (append
         '(choice :custom-state t)
         (cons
          '(directory :tag "EFS Path" "/user@host.domain:/directory/")
          (remove
           nil
           (mapcar
            (function
             (lambda (entry)
               (let (comment host path efs-path)
                 (setq comment (nth 0 entry)
                       host (nth 1 entry)
                       path (nth 2 entry))
                 (when
                     (and host
                          (not (string-equal comment "Pre-Releases")))
                   (setq efs-path (format "/ftp@%s:/%s" host path))
                   (list
                    'const
                    :tag (format "%s - %s" efs-path comment)
                    (file-name-directory efs-path))))))
            package-get-download-sites))))
  :group 'build-tarball)

(defun build-tarball-expand (item)
  (let ((prfx
         (expand-file-name
          build-tarball-prefix
          (concat build-tarball-site build-tarball-dir))))
    (concat prfx item)))

(defun build-tarball-collapse (item)
  (let ((str
         (concat build-tarball-site build-tarball-dir build-tarball-prefix)))
    (string-match str item)
    (replace-match "" t t item)))

(defun build-tarball-get (file)
  (if (not (featurep 'efs))
      (message-or-box
       "please install efs to be able to \"Download Build Tarball Set\".")
    (let ((efs-mode-hook
           '(lambda ()
              (set (make-local-variable 'efs-expire-ftp-buffers) nil)
              (set (make-local-variable 'auto-save-hook)
                   '(lambda ()
                      (message "Auto-saved %s\n" (buffer-name))))
              (auto-save-mode 1))))
      (efs-copy-file
       (build-tarball-expand file)
       (concat
        (expand-file-name
         build-tarball-prefix build-tarball-dest)
        file)
       1 nil t))))

(defun build-tarball-extract (file)
  (cd build-tarball-dest)
  (let ((cmd
         (format "gunzip -c %s%s | tar -xvf -" build-tarball-prefix file))
        (compilation-mode-hook
         'build-compilation-mode-hook)
        (compilation-buffer-name-function
         '(lambda (mode)
            (generate-new-buffer-name
             (concat
              (file-name-sans-extension
               (file-name-sans-extension
                (concat build-tarball-prefix file))) "-toc.err"))))
        )
    (if (string-match "tar\\.gz$" file)
        (compile cmd)
      (warn "%s is not a tar.gz file, skipped."
            (concat build-tarball-prefix file)))))

(defun build-tarball-get-all ()
  "Get all the expanded files of `build-tarball-set'.
Use `build-tarball-expand-all' to find out which tarballs would be
fetched by this function.  All tarballs are saved under
`build-tarball-dest'"
  (interactive)
  (mapc 'build-tarball-get build-tarball-set))

(defun build-tarball-extract-all ()
  "Extract all files from the locally present `build-tarball-set' which
have to be in \".tar.gz\" format."
  (interactive)
  (mapc 'build-tarball-extract build-tarball-set))

(defun build-tarball-expand-all ()
  "Print the expanded value of `build-tarball-set' to temporary buffer
\"*Build Tarball Set*\"."
  (interactive)
  (cd build-tarball-dest)
  (with-output-to-temp-buffer
      "*Build Tarball Set*"
    (princ (mapconcat 'build-tarball-expand build-tarball-set "\n"))))

(defun build-tarball-add-url ()
  "Add URL near point to `build-tarball-set' via
`url-get-url-at-point'."
  (interactive)
  (setq build-tarball-set (cons (url-get-url-at-point) build-tarball-set)))

;;}}}

;;{{{ Build With

(defvar build-with-MS-has-config-inc
  nil
  "Internal variable indicating whether the XEmacs to be built has
support for config.inc.")

(defgroup build-with-MS nil
  "Standardizes the building of XEmacs with MiroSoft tools."
  :group 'build)

(defcustom build-with-MS-make-command
  "nmake"
  "Path of Microsoft make utility used to build XEmacs."
  :type 'file
  :group 'build-with-MS)

(defcustom build-with-MS-make-options
  '("/f xemacs.mak")
  "Options to use with Microsoft make utility when building XEmacs."
  :type '(repeat string)
  :group 'build-with-MS)

(defun build-with-GNU (dir)
  (interactive)
  (let
      ((name "*Build XEmacs With GNU Tools*"))
    ;; Overwrite any customized setting for this build session so
    ;; that build-report will find the right information.
    (customize-set-variable
     'build-report-installation-file
     (expand-file-name "Installation" dir))
    (customize-set-variable
     'build-report-version-file
     (expand-file-name "version.sh" dir))
    (kill-buffer (get-buffer-create name))
    (switch-to-buffer (get-buffer-create name))
    (kill-all-local-variables)
    (cd dir)
    (widget-insert "\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (let
                                 (buffer-back get-back)
			       (cond
				((string-equal build-from-what "Tarballs")
				 (setq buffer-back "*Build XEmacs From Tarballs With GNU Tools*")
				 (setq get-back 'build-from-tarballs))
				((string-equal build-from-what "CVS")
				 (setq buffer-back "*Build XEmacs From CVS With GNU Tools*")
				 (setq get-back 'build-from-CVS)))
                               (if (buffer-live-p (get-buffer buffer-back))
                                   (switch-to-buffer buffer-back)
                                 (funcall get-back))))
                   "Go Back")
    (widget-insert "\n\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (build-configure-generate "configure.usage"))
                   "Generate Build Configure")
    (widget-insert "\n\t")
    (widget-apply
     (widget-create 'push-button
                    :notify (lambda (&rest ignore)
                              (eval-buffer "build-configure.el"))
                    "Activate Generated Build Configure")
     (if (boundp 'build-configure-options)
         :deactivate
       :activate))
    (when (boundp 'build-configure-options)
      (widget-insert
       "\n\tYou will need to restart XEmacs first if you want to activate the\n\tgenerated interface to Build Make again."))
    (widget-insert "\n\t")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (customize-browse 'build-configure))
                   "Browse Build Configure ...")
    (widget-insert "\n\t")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (build-configure))
                   "Run XEmacs Configure")
    (widget-insert "\n\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (build-make-generate))
                   "Generate XEmacs Make")
;    (widget-insert "\n\t")
;    (widget-create 'push-button
;		   :notify (lambda (&rest ignore)
;			     (customize-browse 'build-make))
;		   "Browse Build-Make")
    (widget-insert "\n\t")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (call-interactively 'build-make))
                   "Run XEmacs Make")
    (widget-insert "\n\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (build-build-report))
                   "Generate XEmacs Build Report ...")
    (widget-insert "\n\n")
    (use-local-map widget-keymap)
    (widget-setup)
    (custom-mode)
    (goto-char (point-min))))

(defun build-with-MS (dir)
  (interactive "DXEmacs source directry: ")
  (let
      ((name "*Build XEmacs With Microsoft Tools*"))
    ;; Overwrite any customized setting for this build session so
    ;; that build-report will find the right information.
    (customize-set-variable
     'build-report-installation-file
     (expand-file-name
      "Installation"
      (expand-file-name
       ".."
       dir)))
    (customize-set-variable
     'build-report-version-file
     (expand-file-name
      "version.sh"
      (expand-file-name
       ".."
       dir)))
    (setq build-with-MS-has-config-inc
          (multiple-value-bind
              (major minor beta codename)
              (build-report-version-file-data
               build-report-version-file)
            ;; APA: config.inc file was introduced by Ben Wing in 21.2-b32.
            (if
                (and
                 (>= (string-to-int major) 21)
                 (or
                  ;; 21.2 versions >= b32
                  (and
                   (= (string-to-int minor) 2)
                   (>= (string-to-int beta) 32))
                  ;; 21 versions with minor number > 2
                  (> (string-to-int minor) 2)))
                t
              nil)))
    (kill-buffer (get-buffer-create name))
    (switch-to-buffer (get-buffer-create name))
    (kill-all-local-variables)
    (cd (expand-file-name "" dir))
    (widget-insert "\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (let
                                 (buffer-back get-back)
			       (cond
				((string-equal build-from-what "Tarballs")
				 (setq buffer-back "*Build XEmacs From Tarballs With Microsoft Tools*")
				 (setq get-back 'build-from-tarballs))
				((string-equal build-from-what "CVS")
				 (setq buffer-back "*Build XEmacs From CVS With Microsoft Tools*")
				 (setq get-back 'build-from-CVS)))
                               (if (buffer-live-p (get-buffer buffer-back))
                                   (switch-to-buffer buffer-back)
                                 (funcall get-back))))
                   "Go Back")
    (widget-insert "\n")
    (widget-insert
     "\nYou need to customize Microsoft Tools options.\n\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (customize-browse 'build-with-MS))
                   "Browse Build With MS Options ...")
    (widget-insert "\n\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (build-make-generate "xemacs.mak"))
                   "Generate XEmacs Make")
    (widget-insert "\n\t")
    (widget-apply
     (widget-create 'push-button
                    :notify (lambda (&rest ignore)
                              (eval-buffer "build-make.el"))
                    "Activate Generated Build Make")
     (if (boundp 'build-make-options)
         :deactivate
       :activate))
    (when (boundp 'build-make-options)
      (widget-insert
       "\n\tYou will need to restart XEmacs to activate\n\tthe generated interface to Build Make again."))
    (widget-insert "\n\t")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (customize-browse 'build-make))
                   "Browse Build Make ...")
    (widget-insert "\n\t")
    (widget-apply
     (widget-create 'push-button
                    :notify (lambda (&rest ignore)
                              (eval-buffer "build-make.el")
                              (build-config-inc-generate))
                    "Generate config.inc")
     (if build-with-MS-has-config-inc
         :activate
       :deactivate))
    (widget-insert
     "\n\tXEmacs versions prior to 21.2-b32 do not use config.inc.\n\tThose are configured by passing all variable values to nmake\n\ton the command-line.\n\nDon't forget to save config.inc before building!")
    (widget-insert "\n\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (build-make
                              "distclean"
                              (mapconcat
                               'identity
                               (cons
                                build-with-MS-make-command
                                build-with-MS-make-options)
                               " ")))
                   "Clean XEmacs Distribution")
    (widget-insert "\n\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (build-make
                              "all"
                              (concat
                               (mapconcat
                                'identity
                                (cons
                                 build-with-MS-make-command
                                 build-with-MS-make-options)
                                " ")
                               (unless build-with-MS-has-config-inc
                                 (build-make-get-option-string)))))
                   "Build XEmacs")
    (widget-insert "\n\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (build-make
                              "install"
                              (concat
                               (mapconcat
                                'identity
                                (cons
                                 build-with-MS-make-command
                                 build-with-MS-make-options)
                                " ")
                               (unless build-with-MS-has-config-inc
                                 (build-make-get-option-string)))))
                   "Build and Install XEmacs")
    (widget-insert "\n\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (build-make
                              "check-temacs"
                              (concat
                               (mapconcat
                                'identity
                                (cons
                                 build-with-MS-make-command
                                 build-with-MS-make-options)
                                " ")
                               (unless build-with-MS-has-config-inc
                                 (build-make-get-option-string)))))
                   "Check temacs (XEmacs before dumping)")
    (widget-insert "\n\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (build-make
                              "check"
                              (concat
                               (mapconcat
                                'identity
                                (cons
                                 build-with-MS-make-command
                                 build-with-MS-make-options)
                                " ")
                               (unless build-with-MS-has-config-inc
                                 (build-make-get-option-string)))))
                   "Check XEmacs")
    (widget-insert "\n\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (build-build-report))
                   "Generate XEmacs Build Report ...")
    (widget-insert "\n\n")
    (use-local-map widget-keymap)
    (widget-setup)
    (custom-mode)
    (goto-char (point-min))))

;;}}}

;;{{{ Build Report

(defun build-build-report ()
  (interactive)
  (let
      ((name "*Generate XEmacs Build Report*"))
    (kill-buffer (get-buffer-create name))
    (switch-to-buffer (get-buffer-create name))
    (widget-insert "\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (let
                                 (buffer-back get-back dir)
			       (cond
				((string-equal build-with-what "GNU Tools")
				 (setq buffer-back "*Build XEmacs With GNU Tools*")
				 (setq get-back 'build-with-GNU))
				((string-equal build-with-what "Microsoft Tools")
				 (setq buffer-back "*Build XEmacs With Microsoft Tools*")
				 (setq get-back 'build-with-MS)))
			       (cond
				((string-equal build-from-what "Tarballs")
				 (setq dir
				       (expand-file-name
					build-tarball-prefix
					build-tarball-dest)))
				((string-equal build-from-what "CVS")
				 (setq dir
				       (expand-file-name
					build-cvs-checkout-dir
					build-cvs-checkout-parent-dir))))
                               (if (buffer-live-p (get-buffer buffer-back))
                                   (switch-to-buffer buffer-back)
                                 (funcall get-back dir))))
                   "Go Back")
    (widget-insert "\n\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (customize-browse 'build-report))
                   "Browse Build Report ...")
    (widget-insert "\n\nYou may need to customize Build Report options in order to find all\ninformation created by your last building of XEamcs.\n\n")
    (widget-create 'push-button
                   :notify (lambda (&rest ignore)
                             (call-interactively 'build-report))
                   "Generate Build Report ...")
    (widget-insert "\n")
    (use-local-map widget-keymap)
    (widget-setup)
    (custom-mode)
    (goto-char (point-min))))

;;}}}

;;{{{ Build Make

(defvar build-make-alist
  nil
  "Internal variable keeping track of makefile macros and targets")

(defconst build-make-target-doc-paragraph
  "^##\\s-*make\\s-+\\([^
 	]+\\(\\s-+or\\s-+make\\s-+\\([^
 	]+\\)\\)*\\)\\(\\s-*\\(\\(.*\\)\\(\n##\\s-\\{3,\\}.+\\)*\\)\\)$"
  "Internal REGEXP matching a XEmacs makefile target comment.  These comments
don't exist in `xemacs.mak'")

(defconst build-make-target-paragraph
  "\\(^#.+
\\)?\\(\\(\\w\\|_\\)+\\)\\s-*:.*"
  "Internal REGEXP matching a XEmacs makefile target name.")

(defconst build-make-macro-paragraph
  "^\\(?:!message Please specify root directory for your .* installation: \\)?\\(\\(\\w\\|_\\)+\\)\\s-*=\\s-*\\(\\(.*\\\\
\\)*.+\\)$"
  "Internal REGEXP matching a XEmacs makefile macro definition.")

(defconst build-make-prolog
  "
(provide 'build-make)

(setq build-make-options nil)

(defun build-make-sym-to-opt (sym)
  ;; #### Strip the \"build-make-\" prefix.
  (substring (symbol-name sym) 11))

(defun build-make-set-value (sym val)
  (setq build-make-options
        (remassoc (build-make-sym-to-opt sym) build-make-options))
  (unless (equal val (first (get sym 'standard-value)))
    (setq build-make-options
          (acons (build-make-sym-to-opt sym) val
                 build-make-options)))
  (set-default sym val))

(defgroup build-make nil
  \"build-make options.\"
  :group 'build)

"
  "Internal variable of `build'.")

(defun build-config-inc-generate (&optional dir)
  (interactive)
  (let
      ((buffer (buffer-name (generate-new-buffer "config.inc"))))
    (if dir
        (cd dir))
    (with-output-to-temp-buffer buffer
      (save-window-excursion
        (princ "# -*- mode: makefile -*-\n")
        (princ (format "# generated by %s" build-version))
        (princ "\n\n")
        (princ
         (if (boundp 'build-make-options)
             (mapconcat
              (function (lambda (e)
                          (cond
                           (t
                            (format "%s=%s\n" (first e) (rest e))))))
              (sort
               (delete-duplicates
                build-make-options :from-end t
                :test (lambda (a b)
                        (string=
                         (first a) (first b))))
               (lambda (a b)
                 (string<
                  (first a) (first b))))
              "")
           ""))
        ))
    (set-buffer buffer)
    (kill-all-local-variables)
    (makefile-mode)
    (font-lock-mode 1)
    (toggle-read-only 1)))

(defun build-make (&optional target command)
  "Build the XEmacs target argument according to the settings in
customized group `build' and its members."
  (interactive "sTarget: \nsCommand: ")
  (let ((cmd
         (if (string-equal command "")
             (format "make %s" target)
           (format "%s %s" command target)))
        (compilation-mode-hook
         'build-compilation-mode-hook)
        (compilation-buffer-name-function
         '(lambda (mode)
            (generate-new-buffer-name
             (format "%s-make%s.err"
                     (cond
                      ((string-equal build-from-what "Tarballs")
                       build-tarball-prefix)
                      ((string-equal build-from-what "CVS")
                       build-cvs-checkout-dir))
                     (if target
                         (format "-%s" target)
                       ""))))))
    (compile cmd)))

(defun build-make-generate (&optional file)
  (interactive "fMakefile: ")
  (setq build-make-alist (list (cons 'macros nil) (cons 'targets nil)))
  (unless file
    (setq file
          (expand-file-name
           "Makefile.in"
           (cond
            ((string-equal build-from-what "Tarballs")
             (expand-file-name
              build-tarball-prefix
              build-tarball-dest))
            ((string-equal build-from-what "CVS")
             (expand-file-name
              build-cvs-checkout-dir
              build-cvs-checkout-parent-dir))))))
  (let
      (category categories option value detected doc
                (buffer "build-make.el"))
    (with-output-to-temp-buffer buffer
      (save-window-excursion
        (find-file-read-only file)
;	(build-make-prolog file)
        (goto-char (point-min))
        (while (< (point) (point-max))
          (cond
           ((looking-at build-make-target-doc-paragraph)
            (goto-char (match-end 0))
            (build-make-process-target-doc
             ;; target [or target ...]
             (match-string 1)
             ;; documentation for current targets; possibly
             ;; spreading multiple lines.
             (match-string 5)
             build-make-alist))
           ((looking-at build-make-target-paragraph)
            (goto-char (match-end 0))
            (when (> (length (match-string 1)) 0)
              (build-make-process-target-doc
               ;; target name
               (match-string 2)
               ;; documentation for target; possibly
               ;; spreading multiple lines.
               (match-string 1)
               build-make-alist))
            )
           ((looking-at build-make-macro-paragraph)
            (goto-char (match-end 0))
;	    (unless (string-match "\\$" (match-string 3))
            (build-make-process-macro
             ;; macro name
             (match-string 1)
             ;; macro value
             (match-string 3)
             build-make-alist))
;	    )
           ((looking-at
             "^.+$")
            (goto-char (match-end 0)))
           ((looking-at "\n")
            (goto-char (match-end 0)))
           ))
        (build-make-customize build-make-alist)
        ))
    (set-buffer buffer)
    (insert "(setq build-make-alist (quote")
;    (cl-prettyprint (nreverse build-make-alist))
    (cl-prettyprint build-make-alist)
    (insert "))\n")
    (toggle-read-only 1)))

(defun build-make-get-option-string ()
  (if (boundp 'build-make-options)
      (mapconcat
       (function (lambda (e)
                   (cond
                    (t
                     (format " %s=\"%s\"" (first e) (rest e))))))
       (delete-duplicates
        build-make-options :from-end t
        :test (lambda (a b)
                (string=
                 (first a) (first b))))
       "")
    ""))

(defun build-make-process-target-doc (targets doc a-list)
  (setq targets (replace-in-string targets "or\\(\n\\|\\s-\\)+make" ""))
  (setq doc (replace-in-string doc "##?\\s-+" ""))
  (setq doc (build-configure-fill-doc (list doc)))
  (setcdr (assoc 'targets a-list)
          (append (list (list targets doc)) (cdr (assoc 'targets a-list)))))

(defun build-make-process-macro (name value a-list)
  (unless (assoc name (assoc 'macros a-list))
    (setcdr (assoc 'macros a-list)
            (append (list (list name value)) (cdr (assoc 'macros a-list))))))

(defun build-make-customize (a-list)
  (princ build-make-prolog)
  (mapcar
   (lambda (macro)
     (if (string-match "_DIR\\'" (first macro))
         (build-make-file (first macro) (second macro))
       (build-make-string (first macro) (second macro))))
   (rest (assoc 'macros a-list))))

(defun build-make-string (name val)
  (princ (format "(defcustom build-make-%s\n" name))
  (princ (format "  %S\n" val))
  (princ (format "  \"macro %s\"\n" name))
  (princ (format "  :group \'build-make\n"))
  (princ "  :type 'string\n")
  (princ "  :set 'build-make-set-value)\n")
  (princ "\n"))

(defun build-make-file (name val)
  (princ (format "(defcustom build-make-%s\n" name))
  (princ (format "  %S\n" val))
  (princ (format "  \"macro %s\"\n" name))
  (princ (format "  :group \'build-make\n"))
  (princ "  :type 'file\n")
  (princ "  :set 'build-make-set-value)\n")
  (princ "\n"))

;;}}}

;;{{{ Build Settings

(defcustom build-settings
  nil
  "Internal alist of named settings for building multiple XEmacs
configurations.
This variable is updated via \"Delete\", Load\", and \"Save\" buttons
of the `build' GUI."
  :type 'sexp
  :group 'build)

(defun build-settings-save-custom-group (group key alist)
  "Save customization values of custom GROUP as value of KEY in ALIST"
  (dolist
      (cgm (custom-group-members group nil))
    (let ((symbol (first cgm))
	  (type (second cgm)))
      (cond
       ((equal type 'custom-group)
	(setq alist (build-settings-save-custom-group symbol key alist)))
       (t
	(unless
	    (assoc key alist)
	  (setq alist
		(acons key nil alist)))
	(if (get symbol 'customized-value)
	    (setcdr
	     (assoc key alist)
	     (append
	      (cdr
	       (assoc key alist))
	      (list
	       (list symbol (car
			     (get symbol 'customized-value)))))))))))
  alist)

(defun build-settings-load (key alist)
  "Load build variable settings from alist."
  (interactive)
  (dolist
      (var (cdr (assoc key alist)))
    (message "%S\n\t%S" (car var) (car (cdr var)))
    (set (car var) (eval (car (cdr var))))
    ))

;;}}}

;; build.el ends here
