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