#!/usr/bin/guile \
-e "(scripts mkpimmc)" -s
!#
;;; mkpimmc --- Make a pre-inst.merged-module-catalog file

;;	Copyright (C) 2004 Free Software Foundation, Inc.
;;
;; This program 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.
;;
;; This program 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 this software; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;
;; As a special exception, the Free Software Foundation gives permission
;; for additional uses of the text contained in its release of GUILE.
;;
;; The exception is that, if you link the GUILE library with other files
;; to produce an executable, this does not by itself cause the
;; resulting executable to be covered by the GNU General Public License.
;; Your use of that executable is in no way restricted on account of
;; linking the GUILE library code into it.
;;
;; This exception does not however invalidate any other reasons why
;; the executable file might be covered by the GNU General Public License.
;;
;; This exception applies only to the code released by the
;; Free Software Foundation under the name GUILE.  If you copy
;; code from other Free Software Foundation releases into a copy of
;; GUILE, as the General Public License permits, the exception does
;; not apply to the code that you add in this way.  To avoid misleading
;; anyone as to the status of such modified files, you must delete
;; this exception notice from them.
;;
;; If you write modifications of your own for GUILE, it is your choice
;; whether to permit this exception to apply to your modifications.
;; If you do not wish that, delete this exception notice.

;;; Author: Thien-Thi Nguyen <ttn@gnu.org>

;;; Commentary:

;; Usage: mkpimmc [--verbose] [--deps DEPS] PIMMC SRCDIR -- [ARGS ...]
;;
;; Make two module catalogs in cwd and in SRCDIR (if SRCDIR is not "."),
;; merge them, and write the result to PIMMC, which stands for "pre-inst
;; merged module catalog".  The ARGS ... are passed straight through to
;; the make-module-catalog program.  Note that the "--" is required.
;; The constiuent module catalogs are deleted after the merge.
;;
;; Optional arg `--verbose' displays "Calling: ..." for each of the backend
;; programs used (make-module-catalog and merge-module-catalogs, basically)
;; along w/ the args passed to them.
;;
;; Optional arg `--deps DEPS' specifies either a directory or a filename to
;; write a makefile frag containing dependency info for PIMMC.  If DEPS is a
;; directory, the filename for the makefile frag is computed by inserting a
;; "P" between the PIMMC extension (portion of PIMMC following the last ".")
;; and the last dot.  For example, a.b would result in a.Pb (this is to be
;; consistent with GNU auto* tools dependency tracking machinery).  If there
;; is no "." in PIMMC, simply prefix with "P".
;;
;; Sometimes the makefile frag will contain invalid (out of date) filenames,
;; for example, due to upgrading the auto* tools, resulting in spurious "no
;; rule to make target FOO" errors from make(1).  You can either remove the
;; offending line from DEPS directly, or simply replace the contents of DEPS
;; with "# dummy".  Either way, the next time mkpimmc is run, DEPS should be
;; correctly regenerated.
;;
;; Typically you will use mkpimmc in the top-level Makefile.am like so:
;;
;; noinst_DATA = pre-inst.merged-module-catalog
;; pre-inst.merged-module-catalog:
;;         guile-tools mkpimmc -d .deps $@ $(srcdir) \
;;           -- -d in,lo,o -X '~$$' -X CVS
;;
;; Note that the dollar signs are doubled to avoid confusing make(1).
;; To take advantage of the automatic dependency tracking, include this
;; fragment in configure.ac:
;;
;; AC_CONFIG_COMMANDS([module-catalog-prep],[
;;   test -d .deps || mkdir .deps
;;   prereq=.deps/pre-inst.Pmerged-module-catalog
;;   test -f $prereq || echo '# dummy' > $prereq
;;   grep -q "include $prereq" Makefile \
;;     || echo include $prereq >> Makefile
;; ])
;;
;; Alternatively, you can use the GUILE_MODULE_CATALOG_PREP m4 macro
;; from guile.m4, which normally achieves the same result.

;;; Code:

(define-module (scripts mkpimmc)
  #:use-module ((scripts make-module-catalog) #:select ((main . MAKE)))
  #:use-module ((scripts merge-module-catalogs) #:select ((main . MERGE)))
  #:autoload (scripts PROGRAM) (HVQC-MAIN))

(define (call-proc verbose?)
  (let ((hey (if verbose?
                 (lambda (c-line)
                   (simple-format #t "Calling:")
                   (for-each (lambda (x)
                               (simple-format #t " ~A" x))
                             c-line)
                   (newline))
                 identity)))
    ;; rv
    (lambda (program args)
      (let (($0 (assq-ref `((,MAKE . "make-module-catalog")
                            (,MERGE . "merge-module-catalogs"))
                          program)))
        (catch #t
               (lambda ()
                 (let ((c-line (cons $0 args)))
                   (hey c-line)
                   (program c-line)))
               (lambda (key . rest)
                 (or (car rest)
                     (error (simple-format #f "~A: ~S ~S" $0 key rest)))))))))

(define (mkpimmc/qop qop)
  (let ((args (qop '()))
        (deps (qop 'deps))
        (call (call-proc (qop 'verbose))))
    (or (< 1 (length args))
        (error "mkpimmc: missing args, try `--help'"))
    (let* ((pimmc (car args))
           (srcdir (cadr args))
           (cwd (getcwd))
           (dirs (list cwd))
           (rest (cddr args))
           (cats #f))
      (or (string=? "." srcdir)
          (set! dirs (cons (begin (chdir srcdir) (getcwd)) dirs)))
      (set! cats (map (lambda (dir)
                        (in-vicinity dir ".module-catalog"))
                      dirs))
      (chdir cwd)
      (call MAKE (append rest dirs))
      (call MERGE
            `("-o" ,pimmc
              ,@(if (not deps)
                    '()
                    (list "-d"
                          (if (and (file-exists? deps)
                                   (file-is-directory? deps))
                              (in-vicinity
                               deps
                               (let* ((base (basename pimmc))
                                      (dot (1+ (or (string-rindex base #\.)
                                                   -1))))
                                 (simple-format #f "~AP~A"
                                                (substring base 0 dot)
                                                (substring base dot))))
                              deps)))
              ,@cats))
      (for-each (lambda (file)
                  (simple-format #t "Deleting ~A\n" file)
                  (delete-file file))
                cats)))
  #t)

(define (main args)
  (HVQC-MAIN args mkpimmc/qop
             '(usage . commentary)
             '(package . "Guile")
             '(option-spec (verbose (single-char #\v))
                           (deps    (single-char #\d) (value #t)))))

;;; mkpimmc ends here
