Commit | Line | Data |
---|---|---|
7f864744 | 1 | #!/bin/sh |
275baf01 | 2 | exec guile -e main -s $0 "$@" |
9a56cb24 JB |
3 | !# |
4 | ;;;; guile-config --- utility for linking programs with Guile | |
5 | ;;;; Jim Blandy <jim@red-bean.com> --- September 1997 | |
093d0179 | 6 | ;;;; |
c1a15f3d | 7 | ;;;; Copyright (C) 1998, 2001, 2004, 2005, 2006, 2008, 2009 Free Software Foundation, Inc. |
093d0179 | 8 | ;;;; |
73be1d9e MV |
9 | ;;;; This library is free software; you can redistribute it and/or |
10 | ;;;; modify it under the terms of the GNU Lesser General Public | |
11 | ;;;; License as published by the Free Software Foundation; either | |
53befeb7 | 12 | ;;;; version 3 of the License, or (at your option) any later version. |
093d0179 | 13 | ;;;; |
73be1d9e | 14 | ;;;; This library is distributed in the hope that it will be useful, |
093d0179 | 15 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
73be1d9e MV |
16 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
17 | ;;;; Lesser General Public License for more details. | |
093d0179 | 18 | ;;;; |
73be1d9e | 19 | ;;;; You should have received a copy of the GNU Lesser General Public |
53befeb7 NJ |
20 | ;;;; License along with this library; if not, write to the Free |
21 | ;;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
22 | ;;;; Boston, MA 02110-1301 USA | |
9a56cb24 | 23 | |
275baf01 | 24 | ;;; This script has been deprecated. Just use pkg-config. |
9a56cb24 | 25 | |
275baf01 AW |
26 | (use-modules (ice-9 popen) |
27 | (ice-9 rdelim)) | |
9a56cb24 JB |
28 | |
29 | \f | |
30 | ;;;; main function, command-line processing | |
31 | ||
32 | ;;; The script's entry point. | |
33 | (define (main args) | |
34 | (set-program-name! (car args)) | |
35 | (let ((args (cdr args))) | |
36 | (cond | |
37 | ((null? args) (show-help '()) | |
38 | (quit 1)) | |
39 | ((assoc (car args) command-table) | |
40 | => (lambda (row) | |
41 | (set! subcommand-name (car args)) | |
42 | ((cadr row) (cdr args)))) | |
43 | (else (show-help '()) | |
44 | (quit 1))))) | |
45 | ||
46 | (define program-name #f) | |
47 | (define subcommand-name #f) | |
9a56cb24 JB |
48 | |
49 | ;;; Given an executable path PATH, set program-name to something | |
50 | ;;; appropriate f or use in error messages (i.e., with leading | |
51 | ;;; directory names stripped). | |
52 | (define (set-program-name! path) | |
da509974 | 53 | (set! program-name (basename path))) |
9a56cb24 JB |
54 | |
55 | (define (show-help args) | |
56 | (cond | |
57 | ((null? args) (show-help-overview)) | |
58 | ((assoc (car args) command-table) | |
59 | => (lambda (row) ((caddr row)))) | |
60 | (else | |
61 | (show-help-overview)))) | |
62 | ||
63 | (define (show-help-overview) | |
204c26b9 JB |
64 | (display-line-error "Usage: ") |
65 | (for-each (lambda (row) ((cadddr row))) | |
66 | command-table)) | |
67 | ||
68 | (define (usage-help) | |
69 | (let ((dle display-line-error) | |
70 | (p program-name)) | |
71 | (dle " " p " --help - show usage info (this message)") | |
72 | (dle " " p " --help SUBCOMMAND - show help for SUBCOMMAND"))) | |
9a56cb24 | 73 | |
c1a15f3d | 74 | (define guile-module "guile-2.0") |
275baf01 AW |
75 | |
76 | (define (pkg-config . args) | |
77 | (let* ((real-args (cons "pkg-config" args)) | |
78 | (pipe (apply open-pipe* OPEN_READ real-args)) | |
79 | (output (read-delimited "" pipe)) | |
80 | (ret (close-pipe pipe))) | |
81 | (case (status:exit-val ret) | |
82 | ((0) (if (eof-object? output) "" output)) | |
d4876cb4 AW |
83 | (else (display-line-error |
84 | (format #f "error: ~s exited with non-zero error code ~A" | |
85 | (cons "pkg-config" args) (status:exit-val ret))) | |
86 | ;; assume pkg-config sent diagnostics to stdout | |
87 | (exit (status:exit-val ret)))))) | |
275baf01 | 88 | |
9a56cb24 | 89 | (define (show-version args) |
275baf01 AW |
90 | (format (current-error-port) "~A - Guile version ~A" |
91 | program-name (pkg-config "--modversion" guile-module))) | |
204c26b9 JB |
92 | |
93 | (define (help-version) | |
94 | (let ((dle display-line-error)) | |
95 | (dle "Usage: " program-name " --version") | |
96 | (dle "Show the version of this script. This is also the version of") | |
97 | (dle "Guile this script was installed with."))) | |
98 | ||
99 | (define (usage-version) | |
100 | (display-line-error | |
101 | " " program-name " --version - show installed script and Guile version")) | |
9a56cb24 JB |
102 | |
103 | \f | |
104 | ;;;; the "link" subcommand | |
105 | ||
106 | ;;; Write a set of linker flags to standard output to include the | |
107 | ;;; libraries that libguile needs to link against. | |
108 | ;;; | |
109 | ;;; In the long run, we want to derive these flags from Guile module | |
110 | ;;; declarations files that are installed along the load path. For | |
111 | ;;; now, we're just going to reach into Guile's configuration info and | |
112 | ;;; hack it out. | |
113 | (define (build-link args) | |
275baf01 | 114 | (display (apply pkg-config "--libs" guile-module args))) |
17b85401 | 115 | |
9a56cb24 JB |
116 | (define (help-link) |
117 | (let ((dle display-line-error)) | |
118 | (dle "Usage: " program-name " link") | |
119 | (dle "Print linker flags for building the `guile' executable.") | |
204c26b9 JB |
120 | (dle "Print the linker command-line flags necessary to link against") |
121 | (dle "the Guile library, and any other libraries it requires."))) | |
9a56cb24 | 122 | |
204c26b9 JB |
123 | (define (usage-link) |
124 | (display-line-error | |
125 | " " program-name " link - print libraries to link with")) | |
9a56cb24 | 126 | |
9a56cb24 | 127 | |
204c26b9 JB |
128 | \f |
129 | ;;;; The "compile" subcommand | |
9a56cb24 | 130 | |
817e0769 | 131 | (define (build-compile args) |
275baf01 | 132 | (display (apply pkg-config "--cflags" guile-module args))) |
817e0769 JB |
133 | |
134 | (define (help-compile) | |
135 | (let ((dle display-line-error)) | |
136 | (dle "Usage: " program-name " compile") | |
137 | (dle "Print C compiler flags for compiling code that uses Guile.") | |
138 | (dle "This includes any `-I' flags needed to find Guile's header files."))) | |
139 | ||
140 | (define (usage-compile) | |
141 | (display-line-error | |
142 | " " program-name " compile - print C compiler flags to compile with")) | |
9a56cb24 JB |
143 | |
144 | \f | |
145 | ;;;; The "info" subcommand | |
146 | ||
147 | (define (build-info args) | |
148 | (cond | |
275baf01 AW |
149 | ((null? args) |
150 | (display-line-error "guile-config info with no args has been removed") | |
151 | (quit 2)) | |
152 | ((null? (cdr args)) | |
153 | (cond | |
154 | ((string=? (car args) "guileversion") | |
155 | (display (pkg-config "--modversion" guile-module))) | |
156 | (else | |
807da880 AW |
157 | (display (pkg-config (format #f "--variable=~A" (car args)) |
158 | guile-module))))) | |
275baf01 | 159 | (else (display-line-error "Usage: " program-name " info VAR") |
9a56cb24 JB |
160 | (quit 2)))) |
161 | ||
9a56cb24 | 162 | (define (help-info) |
204c26b9 | 163 | (let ((d display-line-error)) |
275baf01 AW |
164 | (d "Usage: " program-name " info VAR") |
165 | (d "Display the value of the pkg-config variable VAR used when Guile") | |
166 | (d "was built.\n") | |
204c26b9 JB |
167 | (d "Use this command to find out where Guile was installed,") |
168 | (d "where it will look for Scheme code at run-time, and so on."))) | |
9a56cb24 | 169 | |
204c26b9 JB |
170 | (define (usage-info) |
171 | (display-line-error | |
275baf01 | 172 | " " program-name " info VAR - print Guile build directories")) |
9a56cb24 JB |
173 | |
174 | \f | |
175 | ;;;; trivial utilities | |
176 | ||
9a56cb24 JB |
177 | (define (display-line . args) |
178 | (apply display-line-port (current-output-port) args)) | |
179 | ||
180 | (define (display-line-error . args) | |
181 | (apply display-line-port (current-error-port) args)) | |
182 | ||
183 | (define (display-line-port port . args) | |
184 | (for-each (lambda (arg) (display arg port)) | |
185 | args) | |
709a308d | 186 | (newline port)) |
9a56cb24 | 187 | |
9a56cb24 JB |
188 | \f |
189 | ;;;; the command table | |
190 | ||
191 | ;;; We define this down here, so Guile builds the list after all the | |
192 | ;;; functions have been defined. | |
193 | (define command-table | |
194 | (list | |
204c26b9 JB |
195 | (list "--version" show-version help-version usage-version) |
196 | (list "--help" show-help show-help-overview usage-help) | |
197 | (list "link" build-link help-link usage-link) | |
198 | (list "compile" build-compile help-compile usage-compile) | |
199 | (list "info" build-info help-info usage-info))) | |
9a56cb24 JB |
200 | |
201 | \f | |
202 | ;;; Local Variables: | |
203 | ;;; mode: scheme | |
204 | ;;; End: |