Commit | Line | Data |
---|---|---|
2b8efa0c TTN |
1 | #!/bin/sh |
2 | # aside from this initial boilerplate, this is actually -*- scheme -*- code | |
3 | main='(module-ref (resolve-module '\''(scripts autofrisk)) '\'main')' | |
4 | exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" | |
5 | !# | |
6 | ;;; autofrisk --- Generate module checks for use with auto* tools | |
7 | ||
8 | ;; Copyright (C) 2002 Free Software Foundation, Inc. | |
9 | ;; | |
10 | ;; This program is free software; you can redistribute it and/or | |
11 | ;; modify it under the terms of the GNU General Public License as | |
12 | ;; published by the Free Software Foundation; either version 2, or | |
13 | ;; (at your option) any later version. | |
14 | ;; | |
15 | ;; This program is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
18 | ;; General Public License for more details. | |
19 | ;; | |
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with this software; see the file COPYING. If not, write to | |
22 | ;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, | |
23 | ;; Boston, MA 02111-1307 USA | |
24 | ||
25 | ;;; Author: Thien-Thi Nguyen <ttn@gnu.org> | |
26 | ||
27 | ;;; Commentary: | |
28 | ||
29 | ;; Usage: autofrisk [file] | |
30 | ;; | |
31 | ;; This program looks for the file modules.af in the current directory | |
32 | ;; and writes out modules.af.m4 containing autoconf definitions. | |
33 | ;; If given, look for FILE instead of modules.af and output to FILE.m4. | |
34 | ;; | |
35 | ;; After running autofrisk, you should add to configure.ac the lines: | |
36 | ;; AUTOFRISK_CHECKS | |
37 | ;; AUTOFRISK_SUMMARY | |
38 | ;; Then run "aclocal -I ." to update aclocal.m4, and finally autoconf. | |
39 | ;; | |
40 | ;; The modules.af file consists of a series of configuration forms (Scheme | |
41 | ;; lists), which have one of the following formats: | |
42 | ;; (files-glob PATTERN ...) | |
43 | ;; (non-critical-external MODULE ...) | |
44 | ;; (non-critical-internal MODULE ...) | |
45 | ;; (programs (MODULE PROG ...) ...) | |
46 | ;; (pww-varname VARNAME) | |
47 | ;; PATTERN is a string that may contain "*" and "?" characters to be | |
48 | ;; expanded into filenames. MODULE is a list of symbols naming a | |
49 | ;; module, such as `(srfi srfi-1)'. VARNAME is a shell-safe name to use | |
50 | ;; instead of "probably_wont_work", the default. This var is passed to | |
51 | ;; `AC_SUBST'. PROG is a string. | |
52 | ;; | |
53 | ;; Only the `files-glob' form is required. | |
54 | ;; | |
55 | ;; TODO: Write better commentary. | |
56 | ;; Make "please see README" configurable. | |
57 | ||
58 | ;;; Code: | |
59 | ||
60 | (define-module (scripts autofrisk) | |
61 | :autoload (ice-9 popen) (open-input-pipe) | |
62 | :use-module (srfi srfi-1) | |
63 | :use-module (srfi srfi-8) | |
64 | :use-module (srfi srfi-13) | |
65 | :use-module (srfi srfi-14) | |
66 | :use-module (scripts read-scheme-source) | |
67 | :use-module (scripts frisk) | |
68 | :export (autofrisk)) | |
69 | ||
70 | (define *recognized-keys* '(files-glob | |
71 | non-critical-external | |
72 | non-critical-internal | |
73 | programs | |
74 | pww-varname)) | |
75 | ||
76 | (define (canonical-configuration forms) | |
77 | (let ((chk (lambda (condition . x) | |
78 | (or condition (apply error "syntax error:" x))))) | |
79 | (chk (list? forms) "input not a list") | |
80 | (chk (every list? forms) "non-list element") | |
81 | (chk (every (lambda (form) (< 1 (length form))) forms) "list too short") | |
82 | (let ((un #f)) | |
83 | (chk (every (lambda (form) | |
84 | (let ((key (car form))) | |
85 | (and (symbol? key) | |
86 | (or (eq? 'quote key) | |
87 | (memq key *recognized-keys*) | |
88 | (begin | |
89 | (set! un key) | |
90 | #f))))) | |
91 | forms) | |
92 | "unrecognized key:" un)) | |
93 | (let ((bunched (map (lambda (key) | |
94 | (fold (lambda (form so-far) | |
95 | (or (and (eq? (car form) key) | |
96 | (cdr form) | |
97 | (append so-far (cdr form))) | |
98 | so-far)) | |
99 | (list key) | |
100 | forms)) | |
101 | *recognized-keys*))) | |
102 | (lambda (key) | |
103 | (assq-ref bunched key))))) | |
104 | ||
105 | (define (>>strong modules) | |
106 | (for-each (lambda (module) | |
107 | (format #t "GUILE_MODULE_REQUIRED~A\n" module)) | |
108 | modules)) | |
109 | ||
110 | (define (safe-name module) | |
111 | (let ((var (object->string module))) | |
112 | (string-map! (lambda (c) | |
113 | (if (char-set-contains? char-set:letter+digit c) | |
114 | c | |
115 | #\_)) | |
116 | var) | |
117 | var)) | |
118 | ||
119 | (define *pww* "probably_wont_work") | |
120 | ||
121 | (define (>>weak weak-edges) | |
122 | (for-each (lambda (edge) | |
123 | (let* ((up (edge-up edge)) | |
124 | (down (edge-down edge)) | |
125 | (var (format #f "have_guile_module~A" (safe-name up)))) | |
126 | (format #t "GUILE_MODULE_AVAILABLE(~A, ~A)\n" var up) | |
127 | (format #t "test \"$~A\" = no &&\n ~A=\"~A $~A\"~A" | |
128 | var *pww* down *pww* "\n\n"))) | |
129 | weak-edges)) | |
130 | ||
131 | (define (>>program module progs) | |
132 | (let ((vars (map (lambda (prog) | |
133 | (format #f "guile_module~Asupport_~A" | |
134 | (safe-name module) | |
135 | prog)) | |
136 | progs))) | |
137 | (for-each (lambda (var prog) | |
138 | (format #t "AC_PATH_PROG(~A, ~A)\n" var prog)) | |
139 | vars progs) | |
140 | (format #t "test \\\n") | |
141 | (for-each (lambda (var) | |
142 | (format #t " \"$~A\" = \"\" -o \\\n" var)) | |
143 | vars) | |
144 | (format #t "~A &&\n~A=\"~A $~A\"\n\n" | |
145 | (list-ref (list "war = peace" | |
146 | "freedom = slavery" | |
147 | "ignorance = strength") | |
148 | (random 3)) | |
149 | *pww* module *pww*))) | |
150 | ||
151 | (define (>>programs programs) | |
152 | (for-each (lambda (form) | |
153 | (>>program (car form) (cdr form))) | |
154 | programs)) | |
155 | ||
156 | (define (unglob pattern) | |
157 | (let ((p (open-input-pipe (format #f "echo '(' ~A ')'" pattern)))) | |
158 | (map symbol->string (read p)))) | |
159 | ||
160 | (define (>>checks forms) | |
161 | (let* ((cfg (canonical-configuration forms)) | |
162 | (files (apply append (map unglob (cfg 'files-glob)))) | |
163 | (ncx (cfg 'non-critical-external)) | |
164 | (nci (cfg 'non-critical-internal)) | |
165 | (prog (cfg 'non-critical)) | |
166 | (report ((make-frisker) files)) | |
167 | (external (report 'external))) | |
168 | (let ((pww-varname (cfg 'pww-varname))) | |
169 | (or (null? pww-varname) (set! *pww* (car pww-varname)))) | |
170 | (receive (weak strong) | |
171 | (partition (lambda (module) | |
172 | (or (member module ncx) | |
173 | (every (lambda (i) | |
174 | (member i nci)) | |
175 | (map edge-down (mod-down-ls module))))) | |
176 | external) | |
177 | (format #t "AC_DEFUN([AUTOFRISK_CHECKS],[\n\n") | |
178 | (>>strong strong) | |
179 | (format #t "\n~A=~S\n\n" *pww* "") | |
180 | (>>weak (fold (lambda (module so-far) | |
181 | (append so-far (mod-down-ls module))) | |
182 | (list) | |
183 | weak)) | |
184 | (>>programs (cfg 'programs)) | |
185 | (format #t "AC_SUBST(~A)\n])\n\n" *pww*)))) | |
186 | ||
187 | (define (>>summary) | |
188 | (format #t | |
189 | (symbol->string | |
190 | '#{ | |
191 | AC_DEFUN([AUTOFRISK_SUMMARY],[ | |
192 | if test ! "$~A" = "" ; then | |
193 | p=" ***" | |
194 | echo "$p" | |
195 | echo "$p NOTE:" | |
196 | echo "$p The following modules probably won't work:" | |
197 | echo "$p $~A" | |
198 | echo "$p They can be installed anyway, and will work if their" | |
199 | echo "$p dependencies are installed later. Please see README." | |
200 | echo "$p" | |
201 | fi | |
202 | ]) | |
203 | }#) | |
204 | *pww* *pww*)) | |
205 | ||
206 | (define (autofrisk . args) | |
207 | (let ((file (if (null? args) "modules.af" (car args)))) | |
208 | (or (file-exists? file) | |
209 | (error "could not find input file:" file)) | |
210 | (with-output-to-file (format #f "~A.m4" file) | |
211 | (lambda () | |
212 | (>>checks (read-scheme-source-silently file)) | |
213 | (>>summary))))) | |
214 | ||
215 | (define main autofrisk) | |
216 | ||
217 | ;; Local variables: | |
218 | ;; eval: (put 'receive 'scheme-indent-function 2) | |
219 | ;; End: | |
220 | ||
221 | ;;; autofrisk ends here |