--- /dev/null
+#!/bin/sh
+# aside from this initial boilerplate, this is actually -*- scheme -*- code
+main='(module-ref (resolve-module '\''(scripts autofrisk)) '\'main')'
+exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
+!#
+;;; autofrisk --- Generate module checks for use with auto* tools
+
+;; Copyright (C) 2002, 2006 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
+
+;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
+
+;;; Commentary:
+
+;; Usage: autofrisk [file]
+;;
+;; This program looks for the file modules.af in the current directory
+;; and writes out modules.af.m4 containing autoconf definitions.
+;; If given, look for FILE instead of modules.af and output to FILE.m4.
+;;
+;; After running autofrisk, you should add to configure.ac the lines:
+;; AUTOFRISK_CHECKS
+;; AUTOFRISK_SUMMARY
+;; Then run "aclocal -I ." to update aclocal.m4, and finally autoconf.
+;;
+;; The modules.af file consists of a series of configuration forms (Scheme
+;; lists), which have one of the following formats:
+;; (files-glob PATTERN ...)
+;; (non-critical-external MODULE ...)
+;; (non-critical-internal MODULE ...)
+;; (programs (MODULE PROG ...) ...)
+;; (pww-varname VARNAME)
+;; PATTERN is a string that may contain "*" and "?" characters to be
+;; expanded into filenames. MODULE is a list of symbols naming a
+;; module, such as `(srfi srfi-1)'. VARNAME is a shell-safe name to use
+;; instead of "probably_wont_work", the default. This var is passed to
+;; `AC_SUBST'. PROG is a string.
+;;
+;; Only the `files-glob' form is required.
+;;
+;; TODO: Write better commentary.
+;; Make "please see README" configurable.
+
+;;; Code:
+
+(define-module (scripts autofrisk)
+ :autoload (ice-9 popen) (open-input-pipe)
+ :use-module (srfi srfi-1)
+ :use-module (srfi srfi-8)
+ :use-module (srfi srfi-13)
+ :use-module (srfi srfi-14)
+ :use-module (scripts read-scheme-source)
+ :use-module (scripts frisk)
+ :export (autofrisk))
+
+(define *recognized-keys* '(files-glob
+ non-critical-external
+ non-critical-internal
+ programs
+ pww-varname))
+
+(define (canonical-configuration forms)
+ (let ((chk (lambda (condition . x)
+ (or condition (apply error "syntax error:" x)))))
+ (chk (list? forms) "input not a list")
+ (chk (every list? forms) "non-list element")
+ (chk (every (lambda (form) (< 1 (length form))) forms) "list too short")
+ (let ((un #f))
+ (chk (every (lambda (form)
+ (let ((key (car form)))
+ (and (symbol? key)
+ (or (eq? 'quote key)
+ (memq key *recognized-keys*)
+ (begin
+ (set! un key)
+ #f)))))
+ forms)
+ "unrecognized key:" un))
+ (let ((bunched (map (lambda (key)
+ (fold (lambda (form so-far)
+ (or (and (eq? (car form) key)
+ (cdr form)
+ (append so-far (cdr form)))
+ so-far))
+ (list key)
+ forms))
+ *recognized-keys*)))
+ (lambda (key)
+ (assq-ref bunched key)))))
+
+(define (>>strong modules)
+ (for-each (lambda (module)
+ (format #t "GUILE_MODULE_REQUIRED~A\n" module))
+ modules))
+
+(define (safe-name module)
+ (let ((var (object->string module)))
+ (string-map! (lambda (c)
+ (if (char-set-contains? char-set:letter+digit c)
+ c
+ #\_))
+ var)
+ var))
+
+(define *pww* "probably_wont_work")
+
+(define (>>weak weak-edges)
+ (for-each (lambda (edge)
+ (let* ((up (edge-up edge))
+ (down (edge-down edge))
+ (var (format #f "have_guile_module~A" (safe-name up))))
+ (format #t "GUILE_MODULE_AVAILABLE(~A, ~A)\n" var up)
+ (format #t "test \"$~A\" = no &&\n ~A=\"~A $~A\"~A"
+ var *pww* down *pww* "\n\n")))
+ weak-edges))
+
+(define (>>program module progs)
+ (let ((vars (map (lambda (prog)
+ (format #f "guile_module~Asupport_~A"
+ (safe-name module)
+ prog))
+ progs)))
+ (for-each (lambda (var prog)
+ (format #t "AC_PATH_PROG(~A, ~A)\n" var prog))
+ vars progs)
+ (format #t "test \\\n")
+ (for-each (lambda (var)
+ (format #t " \"$~A\" = \"\" -o \\\n" var))
+ vars)
+ (format #t "~A &&\n~A=\"~A $~A\"\n\n"
+ (list-ref (list "war = peace"
+ "freedom = slavery"
+ "ignorance = strength")
+ (random 3))
+ *pww* module *pww*)))
+
+(define (>>programs programs)
+ (for-each (lambda (form)
+ (>>program (car form) (cdr form)))
+ programs))
+
+(define (unglob pattern)
+ (let ((p (open-input-pipe (format #f "echo '(' ~A ')'" pattern))))
+ (map symbol->string (read p))))
+
+(define (>>checks forms)
+ (let* ((cfg (canonical-configuration forms))
+ (files (apply append (map unglob (cfg 'files-glob))))
+ (ncx (cfg 'non-critical-external))
+ (nci (cfg 'non-critical-internal))
+ (prog (cfg 'non-critical))
+ (report ((make-frisker) files))
+ (external (report 'external)))
+ (let ((pww-varname (cfg 'pww-varname)))
+ (or (null? pww-varname) (set! *pww* (car pww-varname))))
+ (receive (weak strong)
+ (partition (lambda (module)
+ (or (member module ncx)
+ (every (lambda (i)
+ (member i nci))
+ (map edge-down (mod-down-ls module)))))
+ external)
+ (format #t "AC_DEFUN([AUTOFRISK_CHECKS],[\n\n")
+ (>>strong strong)
+ (format #t "\n~A=~S\n\n" *pww* "")
+ (>>weak (fold (lambda (module so-far)
+ (append so-far (mod-down-ls module)))
+ (list)
+ weak))
+ (>>programs (cfg 'programs))
+ (format #t "AC_SUBST(~A)\n])\n\n" *pww*))))
+
+(define (>>summary)
+ (format #t
+ (symbol->string
+ '#{
+AC_DEFUN([AUTOFRISK_SUMMARY],[
+if test ! "$~A" = "" ; then
+ p=" ***"
+ echo "$p"
+ echo "$p NOTE:"
+ echo "$p The following modules probably won't work:"
+ echo "$p $~A"
+ echo "$p They can be installed anyway, and will work if their"
+ echo "$p dependencies are installed later. Please see README."
+ echo "$p"
+fi
+])
+}#)
+ *pww* *pww*))
+
+(define (autofrisk . args)
+ (let ((file (if (null? args) "modules.af" (car args))))
+ (or (file-exists? file)
+ (error "could not find input file:" file))
+ (with-output-to-file (format #f "~A.m4" file)
+ (lambda ()
+ (>>checks (read-scheme-source-silently file))
+ (>>summary)))))
+
+(define main autofrisk)
+
+;; Local variables:
+;; eval: (put 'receive 'scheme-indent-function 2)
+;; End:
+
+;;; autofrisk ends here
projects / lilypond.git / blobdiff