Commit | Line | Data |
---|---|---|
7f864744 AW |
1 | #!/bin/sh |
2 | bindir=`dirname $0` | |
3 | exec $bindir/guile -e main -s $0 "$@" | |
9a56cb24 JB |
4 | !# |
5 | ;;;; guile-config --- utility for linking programs with Guile | |
6 | ;;;; Jim Blandy <jim@red-bean.com> --- September 1997 | |
093d0179 | 7 | ;;;; |
589d9eb8 | 8 | ;;;; Copyright (C) 1998, 2001, 2004, 2005, 2006, 2008 Free Software Foundation, Inc. |
093d0179 | 9 | ;;;; |
73be1d9e MV |
10 | ;;;; This library is free software; you can redistribute it and/or |
11 | ;;;; modify it under the terms of the GNU Lesser General Public | |
12 | ;;;; License as published by the Free Software Foundation; either | |
13 | ;;;; version 2.1 of the License, or (at your option) any later version. | |
093d0179 | 14 | ;;;; |
73be1d9e | 15 | ;;;; This library is distributed in the hope that it will be useful, |
093d0179 | 16 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
73be1d9e MV |
17 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
18 | ;;;; Lesser General Public License for more details. | |
093d0179 | 19 | ;;;; |
73be1d9e MV |
20 | ;;;; You should have received a copy of the GNU Lesser General Public |
21 | ;;;; License along with this library; if not, write to the Free Software | |
92205699 | 22 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
9a56cb24 JB |
23 | |
24 | ;;; TODO: | |
25 | ;;; * Add some plausible structure for returning the right exit status, | |
26 | ;;; just something that encourages people to do the correct thing. | |
27 | ;;; * Implement the static library support. This requires that | |
28 | ;;; some portion of the module system be done. | |
29 | ||
da509974 | 30 | (use-modules (ice-9 string-fun)) |
9a56cb24 JB |
31 | |
32 | \f | |
33 | ;;;; main function, command-line processing | |
34 | ||
35 | ;;; The script's entry point. | |
36 | (define (main args) | |
37 | (set-program-name! (car args)) | |
38 | (let ((args (cdr args))) | |
39 | (cond | |
40 | ((null? args) (show-help '()) | |
41 | (quit 1)) | |
42 | ((assoc (car args) command-table) | |
43 | => (lambda (row) | |
44 | (set! subcommand-name (car args)) | |
45 | ((cadr row) (cdr args)))) | |
46 | (else (show-help '()) | |
47 | (quit 1))))) | |
48 | ||
49 | (define program-name #f) | |
50 | (define subcommand-name #f) | |
0b6d8fdc | 51 | (define program-version "@GUILE_VERSION@") |
9a56cb24 JB |
52 | |
53 | ;;; Given an executable path PATH, set program-name to something | |
54 | ;;; appropriate f or use in error messages (i.e., with leading | |
55 | ;;; directory names stripped). | |
56 | (define (set-program-name! path) | |
da509974 | 57 | (set! program-name (basename path))) |
9a56cb24 JB |
58 | |
59 | (define (show-help args) | |
60 | (cond | |
61 | ((null? args) (show-help-overview)) | |
62 | ((assoc (car args) command-table) | |
63 | => (lambda (row) ((caddr row)))) | |
64 | (else | |
65 | (show-help-overview)))) | |
66 | ||
67 | (define (show-help-overview) | |
204c26b9 JB |
68 | (display-line-error "Usage: ") |
69 | (for-each (lambda (row) ((cadddr row))) | |
70 | command-table)) | |
71 | ||
72 | (define (usage-help) | |
73 | (let ((dle display-line-error) | |
74 | (p program-name)) | |
75 | (dle " " p " --help - show usage info (this message)") | |
76 | (dle " " p " --help SUBCOMMAND - show help for SUBCOMMAND"))) | |
9a56cb24 JB |
77 | |
78 | (define (show-version args) | |
204c26b9 JB |
79 | (display-line-error program-name " - Guile version " program-version)) |
80 | ||
81 | (define (help-version) | |
82 | (let ((dle display-line-error)) | |
83 | (dle "Usage: " program-name " --version") | |
84 | (dle "Show the version of this script. This is also the version of") | |
85 | (dle "Guile this script was installed with."))) | |
86 | ||
87 | (define (usage-version) | |
88 | (display-line-error | |
89 | " " program-name " --version - show installed script and Guile version")) | |
9a56cb24 JB |
90 | |
91 | \f | |
92 | ;;;; the "link" subcommand | |
93 | ||
94 | ;;; Write a set of linker flags to standard output to include the | |
95 | ;;; libraries that libguile needs to link against. | |
96 | ;;; | |
97 | ;;; In the long run, we want to derive these flags from Guile module | |
98 | ;;; declarations files that are installed along the load path. For | |
99 | ;;; now, we're just going to reach into Guile's configuration info and | |
100 | ;;; hack it out. | |
101 | (define (build-link args) | |
9a56cb24 | 102 | |
da509974 JB |
103 | ;; If PATH has the form FOO/libBAR.a, return the substring |
104 | ;; BAR, otherwise return #f. | |
105 | (define (match-lib path) | |
106 | (let* ((base (basename path)) | |
107 | (len (string-length base))) | |
108 | (if (and (> len 5) | |
9fb77163 DH |
109 | (string=? (substring base 0 3) "lib") |
110 | (string=? (substring base (- len 2)) ".a")) | |
111 | (substring base 3 (- len 2)) | |
da509974 JB |
112 | #f))) |
113 | ||
6073aaf2 MD |
114 | (if (> (length args) 0) |
115 | (error | |
116 | (string-append program-name | |
117 | " link: arguments to subcommand not yet implemented"))) | |
118 | ||
efb378b0 RB |
119 | (let ((libdir (get-build-info 'libdir)) |
120 | (other-flags | |
121 | (let loop ((libs | |
122 | ;; Get the string of linker flags we used to build | |
123 | ;; Guile, and break it up into a list. | |
124 | (separate-fields-discarding-char #\space | |
125 | (get-build-info 'LIBS) | |
126 | list))) | |
127 | ||
128 | (cond | |
129 | ((null? libs) '()) | |
130 | ||
131 | ;; Turn any "FOO/libBAR.a" elements into "-lBAR". | |
132 | ((match-lib (car libs)) | |
133 | => (lambda (bar) | |
134 | (cons (string-append "-l" bar) | |
135 | (loop (cdr libs))))) | |
136 | ||
137 | ;; Remove any empty strings that may have seeped in there. | |
138 | ((string=? (car libs) "") (loop (cdr libs))) | |
139 | ||
140 | (else (cons (car libs) (loop (cdr libs)))))))) | |
141 | ||
142 | ;; Include libguile itself in the list, along with the directory | |
143 | ;; it was installed in, but do *not* add /usr/lib since that may | |
144 | ;; prevent other programs from specifying non-/usr/lib versions | |
145 | ;; via their foo-config scripts. If *any* app puts -L/usr/lib in | |
146 | ;; the output of its foo-config script then it may prevent the use | |
147 | ;; a non-/usr/lib install of anything that also has a /usr/lib | |
148 | ;; install. For now we hard-code /usr/lib, but later maybe we can | |
149 | ;; do something more dynamic (i.e. what do we need. | |
150 | ||
e96452c4 | 151 | ;; Display the flags, separated by spaces. |
17b85401 HWN |
152 | (display (string-join |
153 | (list | |
154 | (get-build-info 'CFLAGS) | |
162426a8 RB |
155 | (if (or (string=? libdir "/usr/lib") |
156 | (string=? libdir "/usr/lib/")) | |
fbccd84e HWN |
157 | "" |
158 | (string-append "-L" (get-build-info 'libdir))) | |
589d9eb8 | 159 | "-lguile -lltdl" |
fbccd84e HWN |
160 | (string-join other-flags) |
161 | ||
162 | ))) | |
e96452c4 | 163 | (newline))) |
9a56cb24 | 164 | |
17b85401 | 165 | |
9a56cb24 JB |
166 | (define (help-link) |
167 | (let ((dle display-line-error)) | |
168 | (dle "Usage: " program-name " link") | |
169 | (dle "Print linker flags for building the `guile' executable.") | |
204c26b9 JB |
170 | (dle "Print the linker command-line flags necessary to link against") |
171 | (dle "the Guile library, and any other libraries it requires."))) | |
9a56cb24 | 172 | |
204c26b9 JB |
173 | (define (usage-link) |
174 | (display-line-error | |
175 | " " program-name " link - print libraries to link with")) | |
9a56cb24 | 176 | |
9a56cb24 | 177 | |
204c26b9 JB |
178 | \f |
179 | ;;;; The "compile" subcommand | |
9a56cb24 | 180 | |
817e0769 JB |
181 | (define (build-compile args) |
182 | (if (> (length args) 0) | |
183 | (error | |
184 | (string-append program-name | |
185 | " compile: no arguments expected"))) | |
efb378b0 RB |
186 | |
187 | ;; See gcc manual wrt fixincludes. Search for "Use of | |
188 | ;; `-I/usr/include' may cause trouble." For now we hard-code this. | |
189 | ;; Later maybe we can do something more dynamic. | |
23ac14c0 | 190 | (display |
fbccd84e | 191 | (string-append |
23ac14c0 | 192 | (if (not (string=? (get-build-info 'includedir) "/usr/include")) |
fbccd84e HWN |
193 | (string-append "-I" (get-build-info 'includedir) " ") |
194 | " ") | |
195 | ||
23ac14c0 HWN |
196 | (get-build-info 'CFLAGS) |
197 | "\n" | |
198 | ))) | |
817e0769 JB |
199 | |
200 | (define (help-compile) | |
201 | (let ((dle display-line-error)) | |
202 | (dle "Usage: " program-name " compile") | |
203 | (dle "Print C compiler flags for compiling code that uses Guile.") | |
204 | (dle "This includes any `-I' flags needed to find Guile's header files."))) | |
205 | ||
206 | (define (usage-compile) | |
207 | (display-line-error | |
208 | " " program-name " compile - print C compiler flags to compile with")) | |
9a56cb24 JB |
209 | |
210 | \f | |
211 | ;;;; The "info" subcommand | |
212 | ||
213 | (define (build-info args) | |
214 | (cond | |
215 | ((null? args) (show-all-vars)) | |
216 | ((null? (cdr args)) (show-var (car args))) | |
217 | (else (display-line-error "Usage: " program-name " info [VAR]") | |
218 | (quit 2)))) | |
219 | ||
220 | (define (show-all-vars) | |
221 | (for-each (lambda (binding) | |
222 | (display-line (car binding) " = " (cdr binding))) | |
223 | %guile-build-info)) | |
224 | ||
225 | (define (show-var var) | |
226 | (display (get-build-info (string->symbol var))) | |
227 | (newline)) | |
228 | ||
229 | (define (help-info) | |
204c26b9 JB |
230 | (let ((d display-line-error)) |
231 | (d "Usage: " program-name " info [VAR]") | |
232 | (d "Display the value of the Makefile variable VAR used when Guile") | |
233 | (d "was built. If VAR is omitted, display all Makefile variables.") | |
234 | (d "Use this command to find out where Guile was installed,") | |
235 | (d "where it will look for Scheme code at run-time, and so on."))) | |
9a56cb24 | 236 | |
204c26b9 JB |
237 | (define (usage-info) |
238 | (display-line-error | |
239 | " " program-name " info [VAR] - print Guile build directories")) | |
9a56cb24 JB |
240 | |
241 | \f | |
242 | ;;;; trivial utilities | |
243 | ||
244 | (define (get-build-info name) | |
245 | (let ((val (assq name %guile-build-info))) | |
246 | (if (not (pair? val)) | |
247 | (begin | |
248 | (display-line-error | |
249 | program-name " " subcommand-name ": no such build-info: " name) | |
250 | (quit 2))) | |
251 | (cdr val))) | |
252 | ||
253 | (define (display-line . args) | |
254 | (apply display-line-port (current-output-port) args)) | |
255 | ||
256 | (define (display-line-error . args) | |
257 | (apply display-line-port (current-error-port) args)) | |
258 | ||
259 | (define (display-line-port port . args) | |
260 | (for-each (lambda (arg) (display arg port)) | |
261 | args) | |
709a308d | 262 | (newline port)) |
9a56cb24 | 263 | |
9a56cb24 JB |
264 | \f |
265 | ;;;; the command table | |
266 | ||
267 | ;;; We define this down here, so Guile builds the list after all the | |
268 | ;;; functions have been defined. | |
269 | (define command-table | |
270 | (list | |
204c26b9 JB |
271 | (list "--version" show-version help-version usage-version) |
272 | (list "--help" show-help show-help-overview usage-help) | |
273 | (list "link" build-link help-link usage-link) | |
274 | (list "compile" build-compile help-compile usage-compile) | |
275 | (list "info" build-info help-info usage-info))) | |
9a56cb24 JB |
276 | |
277 | \f | |
278 | ;;; Local Variables: | |
279 | ;;; mode: scheme | |
280 | ;;; End: |