Commit | Line | Data |
---|---|---|
9a56cb24 JB |
1 | #!@-bindir-@/guile \ |
2 | -e main -s | |
3 | !# | |
4 | ;;;; guile-config --- utility for linking programs with Guile | |
5 | ;;;; Jim Blandy <jim@red-bean.com> --- September 1997 | |
6 | ||
7 | ;;; TODO: | |
8 | ;;; * Add some plausible structure for returning the right exit status, | |
9 | ;;; just something that encourages people to do the correct thing. | |
10 | ;;; * Implement the static library support. This requires that | |
11 | ;;; some portion of the module system be done. | |
12 | ||
da509974 | 13 | (use-modules (ice-9 string-fun)) |
9a56cb24 JB |
14 | |
15 | \f | |
16 | ;;;; main function, command-line processing | |
17 | ||
18 | ;;; The script's entry point. | |
19 | (define (main args) | |
20 | (set-program-name! (car args)) | |
21 | (let ((args (cdr args))) | |
22 | (cond | |
23 | ((null? args) (show-help '()) | |
24 | (quit 1)) | |
25 | ((assoc (car args) command-table) | |
26 | => (lambda (row) | |
27 | (set! subcommand-name (car args)) | |
28 | ((cadr row) (cdr args)))) | |
29 | (else (show-help '()) | |
30 | (quit 1))))) | |
31 | ||
32 | (define program-name #f) | |
33 | (define subcommand-name #f) | |
34 | (define program-version "@-GUILE_VERSION-@") | |
35 | ||
36 | ;;; Given an executable path PATH, set program-name to something | |
37 | ;;; appropriate f or use in error messages (i.e., with leading | |
38 | ;;; directory names stripped). | |
39 | (define (set-program-name! path) | |
da509974 | 40 | (set! program-name (basename path))) |
9a56cb24 JB |
41 | |
42 | (define (show-help args) | |
43 | (cond | |
44 | ((null? args) (show-help-overview)) | |
45 | ((assoc (car args) command-table) | |
46 | => (lambda (row) ((caddr row)))) | |
47 | (else | |
48 | (show-help-overview)))) | |
49 | ||
50 | (define (show-help-overview) | |
204c26b9 JB |
51 | (display-line-error "Usage: ") |
52 | (for-each (lambda (row) ((cadddr row))) | |
53 | command-table)) | |
54 | ||
55 | (define (usage-help) | |
56 | (let ((dle display-line-error) | |
57 | (p program-name)) | |
58 | (dle " " p " --help - show usage info (this message)") | |
59 | (dle " " p " --help SUBCOMMAND - show help for SUBCOMMAND"))) | |
9a56cb24 JB |
60 | |
61 | (define (show-version args) | |
204c26b9 JB |
62 | (display-line-error program-name " - Guile version " program-version)) |
63 | ||
64 | (define (help-version) | |
65 | (let ((dle display-line-error)) | |
66 | (dle "Usage: " program-name " --version") | |
67 | (dle "Show the version of this script. This is also the version of") | |
68 | (dle "Guile this script was installed with."))) | |
69 | ||
70 | (define (usage-version) | |
71 | (display-line-error | |
72 | " " program-name " --version - show installed script and Guile version")) | |
9a56cb24 JB |
73 | |
74 | \f | |
75 | ;;;; the "link" subcommand | |
76 | ||
77 | ;;; Write a set of linker flags to standard output to include the | |
78 | ;;; libraries that libguile needs to link against. | |
79 | ;;; | |
80 | ;;; In the long run, we want to derive these flags from Guile module | |
81 | ;;; declarations files that are installed along the load path. For | |
82 | ;;; now, we're just going to reach into Guile's configuration info and | |
83 | ;;; hack it out. | |
84 | (define (build-link args) | |
85 | (if (> (length args) 0) | |
86 | (error | |
87 | (string-append program-name | |
88 | " link: arguments to subcommand not yet implemented"))) | |
89 | ||
da509974 JB |
90 | ;; If PATH has the form FOO/libBAR.a, return the substring |
91 | ;; BAR, otherwise return #f. | |
92 | (define (match-lib path) | |
93 | (let* ((base (basename path)) | |
94 | (len (string-length base))) | |
95 | (if (and (> len 5) | |
96 | (string=? (make-shared-substring base 0 3) "lib") | |
97 | (string=? (make-shared-substring base (- len 2)) ".a")) | |
98 | (make-shared-substring base 3 (- len 2)) | |
99 | #f))) | |
100 | ||
9a56cb24 JB |
101 | (let* ((flags |
102 | (let loop ((libs | |
103 | ;; Get the string of linker flags we used to build | |
104 | ;; Guile, and break it up into a list. | |
105 | (separate-fields-discarding-char #\space | |
106 | (get-build-info 'LIBS) | |
107 | list))) | |
da509974 | 108 | |
9a56cb24 JB |
109 | (cond |
110 | ((null? libs) '()) | |
111 | ||
112 | ;; Turn any "FOO/libBAR.a" elements into "-lBAR". | |
da509974 JB |
113 | ((match-lib (car libs)) |
114 | => (lambda (bar) | |
115 | (cons (string-append "-l" bar) | |
9a56cb24 JB |
116 | (loop (cdr libs))))) |
117 | ||
118 | ;; Remove any empty strings that may have seeped in there. | |
119 | ((string=? (car libs) "") (loop (cdr libs))) | |
120 | ||
121 | (else (cons (car libs) (loop (cdr libs))))))) | |
122 | ||
008112c1 JB |
123 | ;; Include libguile itself in the list, along with the |
124 | ;; directory it was installed in. | |
125 | (flags (cons (string-append "-L" (get-build-info 'libdir)) | |
126 | (cons "-lguile" flags)))) | |
9a56cb24 JB |
127 | |
128 | ;; Display the flags, separated by spaces. | |
129 | (display-separated flags) | |
130 | (newline))) | |
131 | ||
132 | (define (help-link) | |
133 | (let ((dle display-line-error)) | |
134 | (dle "Usage: " program-name " link") | |
135 | (dle "Print linker flags for building the `guile' executable.") | |
204c26b9 JB |
136 | (dle "Print the linker command-line flags necessary to link against") |
137 | (dle "the Guile library, and any other libraries it requires."))) | |
9a56cb24 | 138 | |
204c26b9 JB |
139 | (define (usage-link) |
140 | (display-line-error | |
141 | " " program-name " link - print libraries to link with")) | |
9a56cb24 | 142 | |
9a56cb24 | 143 | |
204c26b9 JB |
144 | \f |
145 | ;;;; The "compile" subcommand | |
9a56cb24 | 146 | |
204c26b9 JB |
147 | (define (build-compile) #f) |
148 | (define (help-compile) #f) | |
149 | (define (usage-compile) #f) | |
9a56cb24 JB |
150 | |
151 | \f | |
152 | ;;;; The "info" subcommand | |
153 | ||
154 | (define (build-info args) | |
155 | (cond | |
156 | ((null? args) (show-all-vars)) | |
157 | ((null? (cdr args)) (show-var (car args))) | |
158 | (else (display-line-error "Usage: " program-name " info [VAR]") | |
159 | (quit 2)))) | |
160 | ||
161 | (define (show-all-vars) | |
162 | (for-each (lambda (binding) | |
163 | (display-line (car binding) " = " (cdr binding))) | |
164 | %guile-build-info)) | |
165 | ||
166 | (define (show-var var) | |
167 | (display (get-build-info (string->symbol var))) | |
168 | (newline)) | |
169 | ||
170 | (define (help-info) | |
204c26b9 JB |
171 | (let ((d display-line-error)) |
172 | (d "Usage: " program-name " info [VAR]") | |
173 | (d "Display the value of the Makefile variable VAR used when Guile") | |
174 | (d "was built. If VAR is omitted, display all Makefile variables.") | |
175 | (d "Use this command to find out where Guile was installed,") | |
176 | (d "where it will look for Scheme code at run-time, and so on."))) | |
9a56cb24 | 177 | |
204c26b9 JB |
178 | (define (usage-info) |
179 | (display-line-error | |
180 | " " program-name " info [VAR] - print Guile build directories")) | |
9a56cb24 JB |
181 | |
182 | \f | |
183 | ;;;; trivial utilities | |
184 | ||
185 | (define (get-build-info name) | |
186 | (let ((val (assq name %guile-build-info))) | |
187 | (if (not (pair? val)) | |
188 | (begin | |
189 | (display-line-error | |
190 | program-name " " subcommand-name ": no such build-info: " name) | |
191 | (quit 2))) | |
192 | (cdr val))) | |
193 | ||
194 | (define (display-line . args) | |
195 | (apply display-line-port (current-output-port) args)) | |
196 | ||
197 | (define (display-line-error . args) | |
198 | (apply display-line-port (current-error-port) args)) | |
199 | ||
200 | (define (display-line-port port . args) | |
201 | (for-each (lambda (arg) (display arg port)) | |
202 | args) | |
203 | (newline)) | |
204 | ||
205 | (define (display-separated args) | |
206 | (let loop ((args args)) | |
207 | (cond ((null? args)) | |
208 | ((null? (cdr args)) (display (car args))) | |
209 | (else (display (car args)) | |
210 | (display " ") | |
211 | (loop (cdr args)))))) | |
212 | ||
213 | \f | |
214 | ;;;; the command table | |
215 | ||
216 | ;;; We define this down here, so Guile builds the list after all the | |
217 | ;;; functions have been defined. | |
218 | (define command-table | |
219 | (list | |
204c26b9 JB |
220 | (list "--version" show-version help-version usage-version) |
221 | (list "--help" show-help show-help-overview usage-help) | |
222 | (list "link" build-link help-link usage-link) | |
223 | (list "compile" build-compile help-compile usage-compile) | |
224 | (list "info" build-info help-info usage-info))) | |
9a56cb24 JB |
225 | |
226 | \f | |
227 | ;;; Local Variables: | |
228 | ;;; mode: scheme | |
229 | ;;; End: |