2 exec guile
-e main
-s $0 "$@"
4 ;;;; guile-config
--- utility
for linking programs with Guile
5 ;;;; Jim Blandy
<jim@red-bean.com
> --- September
1997
7 ;;;; Copyright
(C
) 1998, 2001, 2004, 2005, 2006, 2008, 2009 Free Software Foundation
, Inc.
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
12 ;;;; version
3 of the License
, or
(at your option
) any later version.
14 ;;;; This library is distributed
in the hope that it will be useful
,
15 ;;;; but WITHOUT ANY WARRANTY
; without even the implied warranty of
16 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;;;; Lesser General Public License
for more details.
19 ;;;; You should have received a copy of the GNU Lesser General Public
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
24 ;;; This
script has been deprecated. Just use pkg-config.
26 (use-modules
(ice-9 popen
)
30 ;;;; main
function, command-line processing
32 ;;; The
script's entry point.
34 (set-program-name! (car args))
35 (let ((args (cdr args)))
37 ((null? args) (show-help '())
39 ((assoc
(car args
) command-table
)
41 (set! subcommand-name
(car args
))
42 ((cadr row
) (cdr args
))))
46 (define program-name #f)
47 (define subcommand-name #f)
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)
53 (set! program-name (basename path)))
55 (define (show-help args)
57 ((null? args) (show-help-overview))
58 ((assoc (car args) command-table)
59 => (lambda (row) ((caddr row))))
61 (show-help-overview))))
63 (define (show-help-overview)
64 (display-line-error "Usage: ")
65 (for-each (lambda (row) ((cadddr row)))
69 (let ((dle display-line-error)
71 (dle " " p " --help - show usage info (this message)")
72 (dle " " p " --help SUBCOMMAND - show help for SUBCOMMAND")))
74 (define guile-module "guile-2.0")
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))
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))))))
89 (define (show-version args)
90 (format (current-error-port) "~A - Guile version ~A"
91 program-name (pkg-config "--modversion" guile-module)))
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.")))
99 (define (usage-version)
101 " " program-name " --version - show installed script and Guile version"))
104 ;;;; the "link" subcommand
106 ;;; Write a set of linker flags to standard output to include the
107 ;;; libraries that libguile needs to link against.
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
113 (define (build-link args)
114 (display (apply pkg-config "--libs" guile-module args)))
117 (let ((dle display-line-error))
118 (dle "Usage: " program-name " link")
119 (dle "Print linker flags for building the `guile' executable.
")
120 (dle "Print the linker command-line flags necessary to link against
")
121 (dle "the Guile library
, and any other libraries it requires.
")))
125 " " program-name " link
- print libraries to link with
"))
129 ;;;; The "compile
" subcommand
131 (define (build-compile args)
132 (display (apply pkg-config "--cflags" guile-module args)))
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.")))
140 (define (usage-compile)
142 " " program-name " compile - print C compiler flags to compile with"))
145 ;;;; The "info" subcommand
147 (define (build-info args)
150 (display-line-error "guile-config info with no args has been removed")
154 ((string=? (car args) "guileversion")
155 (display (pkg-config "--modversion" guile-module)))
157 (display (pkg-config (format #f "--variable=~A" (car args))
159 (else (display-line-error "Usage: " program-name " info VAR")
163 (let ((d display-line-error))
164 (d "Usage: " program-name " info VAR")
165 (d "Display the value of the pkg-config variable VAR used when Guile")
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.")))
172 " " program-name " info VAR - print Guile build directories"))
175 ;;;; trivial utilities
177 (define (display-line . args)
178 (apply display-line-port (current-output-port) args))
180 (define (display-line-error . args)
181 (apply display-line-port (current-error-port) args))
183 (define (display-line-port port . args)
184 (for-each (lambda (arg) (display arg port))
189 ;;;; the command table
191 ;;; We define this down here, so Guile builds the list after all the
192 ;;; functions have been defined.
193 (define command-table
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)))