Commit | Line | Data |
---|---|---|
da5d81a1 AW |
1 | ;;; Parsing Guile's command-line |
2 | ||
faabd161 | 3 | ;;; Copyright (C) 1994-1998, 2000-2011, 2012, 2013 Free Software Foundation, Inc. |
da5d81a1 AW |
4 | |
5 | ;;;; This library is free software; you can redistribute it and/or | |
6 | ;;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;;; License as published by the Free Software Foundation; either | |
8 | ;;;; version 3 of the License, or (at your option) any later version. | |
9 | ;;;; | |
10 | ;;;; This library is distributed in the hope that it will be useful, | |
11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | ;;;; Lesser General Public License for more details. | |
14 | ;;;; | |
15 | ;;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;;; License along with this library; if not, write to the Free Software | |
17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
18 | ||
19 | ;;; Code: | |
20 | ||
21 | ;;; | |
22 | ;;; Please be careful not to load up other modules in this file, unless | |
23 | ;;; they are explicitly requested. Loading modules currently imposes a | |
24 | ;;; speed penalty of a few stats, an mmap, and some allocation, which | |
25 | ;;; can range from 1 to 20ms, depending on the state of your disk cache. | |
26 | ;;; Since `compile-shell-switches' is called even for the most transient | |
27 | ;;; of command-line programs, we need to keep it lean. | |
28 | ;;; | |
29 | ;;; Generally speaking, the goal is for Guile to boot and execute simple | |
30 | ;;; expressions like "1" within 20ms or less, measured using system time | |
31 | ;;; from the time of the `guile' invocation to exit. | |
32 | ;;; | |
33 | ||
34 | (define-module (ice-9 command-line) | |
a222cbc9 | 35 | #:autoload (system vm vm) (set-default-vm-engine! set-vm-engine!) |
da5d81a1 AW |
36 | #:export (compile-shell-switches |
37 | version-etc | |
38 | *GPLv3+* | |
39 | *LGPLv3+* | |
40 | emit-bug-reporting-address)) | |
41 | ||
42 | ;; An initial stab at i18n. | |
43 | (define _ gettext) | |
44 | ||
45 | (define *GPLv3+* | |
46 | (_ "License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>. | |
47 | This is free software: you are free to change and redistribute it. | |
48 | There is NO WARRANTY, to the extent permitted by law.")) | |
49 | ||
50 | (define *LGPLv3+* | |
51 | (_ "License LGPLv3+: GNU LGPL 3 or later <http://gnu.org/licenses/lgpl.html>. | |
52 | This is free software: you are free to change and redistribute it. | |
53 | There is NO WARRANTY, to the extent permitted by law.")) | |
54 | ||
55 | ;; Display the --version information in the | |
56 | ;; standard way: command and package names, package version, followed | |
57 | ;; by a short license notice and a list of up to 10 author names. | |
58 | ;; If COMMAND_NAME is NULL, the PACKAGE is asumed to be the name of | |
59 | ;; the program. The formats are therefore: | |
60 | ;; PACKAGE VERSION | |
61 | ;; or | |
62 | ;; COMMAND_NAME (PACKAGE) VERSION. | |
63 | ;; | |
64 | ;; Based on the version-etc gnulib module. | |
65 | ;; | |
66 | (define* (version-etc package version #:key | |
67 | (port (current-output-port)) | |
68 | ;; FIXME: authors | |
9c90a81b | 69 | (copyright-year 2013) |
da5d81a1 AW |
70 | (copyright-holder "Free Software Foundation, Inc.") |
71 | (copyright (format #f "Copyright (C) ~a ~a" | |
72 | copyright-year copyright-holder)) | |
73 | (license *GPLv3+*) | |
74 | command-name | |
75 | packager packager-version) | |
76 | (if command-name | |
77 | (format port "~a (~a) ~a\n" command-name package version) | |
78 | (format port "~a ~a\n" package version)) | |
79 | ||
80 | (if packager | |
81 | (if packager-version | |
82 | (format port (_ "Packaged by ~a (~a)\n") packager packager-version) | |
83 | (format port (_ "Packaged by ~a\n") packager))) | |
84 | ||
85 | (display copyright port) | |
86 | (newline port) | |
87 | (newline port) | |
88 | (display license port) | |
89 | (newline port)) | |
90 | ||
91 | ||
92 | ;; Display the usual `Report bugs to' stanza. | |
93 | ;; | |
94 | (define* (emit-bug-reporting-address package bug-address #:key | |
95 | (port (current-output-port)) | |
96 | (url (string-append | |
97 | "http://www.gnu.org/software/" | |
98 | package | |
99 | "/")) | |
100 | packager packager-bug-address) | |
101 | (format port (_ "\nReport bugs to: ~a\n") bug-address) | |
102 | (if (and packager packager-bug-address) | |
103 | (format port (_ "Report ~a bugs to: ~a\n") packager packager-bug-address)) | |
104 | (format port (_ "~a home page: <~a>\n") package url) | |
105 | (format port | |
106 | (_ "General help using GNU software: <http://www.gnu.org/gethelp/>\n"))) | |
107 | ||
108 | (define *usage* | |
faabd161 | 109 | (_ "Evaluate code with Guile, interactively or from a script. |
da5d81a1 | 110 | |
faabd161 AW |
111 | [-s] FILE load source code from FILE, and exit |
112 | -c EXPR evalute expression EXPR, and exit | |
da5d81a1 AW |
113 | -- stop scanning arguments; run interactively |
114 | ||
115 | The above switches stop argument processing, and pass all | |
116 | remaining arguments as the value of (command-line). | |
117 | If FILE begins with `-' the -s switch is mandatory. | |
118 | ||
119 | -L DIRECTORY add DIRECTORY to the front of the module load path | |
b05257b9 | 120 | -C DIRECTORY like -L, but for compiled files |
da5d81a1 | 121 | -x EXTENSION add EXTENSION to the front of the load extensions |
faabd161 | 122 | -l FILE load source code from FILE |
da5d81a1 AW |
123 | -e FUNCTION after reading script, apply FUNCTION to |
124 | command line arguments | |
faabd161 | 125 | --language=LANG change language; default: scheme |
da5d81a1 | 126 | -ds do -s script at this point |
c8286111 | 127 | --debug start with the \"debugging\" VM engine |
faabd161 AW |
128 | --no-debug start with the normal VM engine (backtraces but |
129 | no breakpoints); default is --debug for interactive | |
da5d81a1 AW |
130 | use, but not for `-s' and `-c'. |
131 | --auto-compile compile source files automatically | |
1e56cff2 | 132 | --fresh-auto-compile invalidate auto-compilation cache |
faabd161 AW |
133 | --no-auto-compile disable automatic source file compilation; |
134 | default is to enable auto-compilation of source | |
da5d81a1 | 135 | files. |
faabd161 AW |
136 | --listen[=P] listen on a local port or a path for REPL clients; |
137 | if P is not given, the default is local port 37146 | |
da5d81a1 AW |
138 | -q inhibit loading of user init file |
139 | --use-srfi=LS load SRFI modules for the SRFIs in LS, | |
140 | which is a list of numbers like \"2,13,14\" | |
141 | -h, --help display this help and exit | |
142 | -v, --version display version information and exit | |
143 | \\ read arguments from following script lines")) | |
144 | ||
145 | ||
146 | (define* (shell-usage name fatal? #:optional fmt . args) | |
147 | (let ((port (if fatal? | |
148 | (current-error-port) | |
149 | (current-output-port)))) | |
150 | (if fmt | |
151 | (apply format port fmt args)) | |
152 | ||
153 | (format port (_ "Usage: ~a [OPTION]... [FILE]...\n") name) | |
154 | (display *usage* port) | |
155 | (newline port) | |
156 | ||
157 | (emit-bug-reporting-address | |
158 | "GNU Guile" "bug-guile@gnu.org" | |
159 | #:port port | |
160 | #:url "http://www.gnu.org/software/guile/" | |
161 | #:packager (assq-ref %guile-build-info 'packager) | |
162 | #:packager-bug-address | |
163 | (assq-ref %guile-build-info 'packager-bug-address)) | |
164 | ||
165 | (if fatal? | |
166 | (exit 1)))) | |
167 | ||
faabd161 AW |
168 | ;; Try to avoid loading (ice-9 eval-string) and (system base compile) if |
169 | ;; possible. | |
170 | (define (eval-string/lang str) | |
171 | (case (current-language) | |
172 | ((scheme) | |
173 | (call-with-input-string | |
174 | str | |
175 | (lambda (port) | |
176 | (let lp () | |
177 | (let ((exp (read port))) | |
178 | (if (not (eof-object? exp)) | |
179 | (begin | |
180 | (eval exp (current-module)) | |
181 | (lp)))))))) | |
182 | (else | |
183 | ((module-ref (resolve-module '(ice-9 eval-string)) 'eval-string) str)))) | |
184 | ||
185 | (define (load/lang f) | |
186 | (case (current-language) | |
187 | ((scheme) | |
8026a774 | 188 | (load-in-vicinity (getcwd) f)) |
faabd161 AW |
189 | (else |
190 | ((module-ref (resolve-module '(system base compile)) 'compile-file) | |
191 | f #:to 'value)))) | |
da5d81a1 AW |
192 | |
193 | (define* (compile-shell-switches args #:optional (usage-name "guile")) | |
194 | (let ((arg0 "guile") | |
faabd161 | 195 | (script-cell #f) |
da5d81a1 AW |
196 | (entry-point #f) |
197 | (user-load-path '()) | |
b05257b9 | 198 | (user-load-compiled-path '()) |
da5d81a1 AW |
199 | (user-extensions '()) |
200 | (interactive? #t) | |
201 | (inhibit-user-init? #f) | |
202 | (turn-on-debugging? #f) | |
203 | (turn-off-debugging? #f)) | |
204 | ||
205 | (define (error fmt . args) | |
206 | (apply shell-usage usage-name #t fmt args)) | |
207 | ||
208 | (define (parse args out) | |
209 | (cond | |
210 | ((null? args) | |
211 | (finish args out)) | |
212 | (else | |
213 | (let ((arg (car args)) | |
214 | (args (cdr args))) | |
215 | (cond | |
216 | ((not (string-prefix? "-" arg)) ; foo | |
faabd161 | 217 | ;; If we specified the -ds option, script-cell is the cdr of |
dac9812a AW |
218 | ;; an expression like (load #f). We replace the car (i.e., |
219 | ;; the #f) with the script name. | |
da5d81a1 AW |
220 | (set! arg0 arg) |
221 | (set! interactive? #f) | |
faabd161 | 222 | (if script-cell |
dac9812a | 223 | (begin |
faabd161 | 224 | (set-car! script-cell arg0) |
dac9812a | 225 | (finish args out)) |
faabd161 AW |
226 | (finish args |
227 | (cons `((@@ (ice-9 command-line) load/lang) ,arg0) | |
228 | out)))) | |
da5d81a1 AW |
229 | |
230 | ((string=? arg "-s") ; foo | |
231 | (if (null? args) | |
232 | (error "missing argument to `-s' switch")) | |
233 | (set! arg0 (car args)) | |
da5d81a1 | 234 | (set! interactive? #f) |
faabd161 | 235 | (if script-cell |
dac9812a | 236 | (begin |
faabd161 | 237 | (set-car! script-cell arg0) |
dac9812a | 238 | (finish (cdr args) out)) |
faabd161 AW |
239 | (finish (cdr args) |
240 | (cons `((@@ (ice-9 command-line) load/lang) ,arg0) | |
241 | out)))) | |
dac9812a | 242 | |
da5d81a1 AW |
243 | ((string=? arg "-c") ; evaluate expr |
244 | (if (null? args) | |
245 | (error "missing argument to `-c' switch")) | |
246 | (set! interactive? #f) | |
247 | (finish (cdr args) | |
faabd161 AW |
248 | (cons `((@@ (ice-9 command-line) eval-string/lang) |
249 | ,(car args)) | |
da5d81a1 AW |
250 | out))) |
251 | ||
252 | ((string=? arg "--") ; end args go interactive | |
253 | (finish args out)) | |
254 | ||
255 | ((string=? arg "-l") ; load a file | |
256 | (if (null? args) | |
257 | (error "missing argument to `-l' switch")) | |
258 | (parse (cdr args) | |
a20eb9a3 | 259 | (cons `((@@ (ice-9 command-line) load/lang) ,(car args)) |
faabd161 | 260 | out))) |
da5d81a1 AW |
261 | |
262 | ((string=? arg "-L") ; add to %load-path | |
263 | (if (null? args) | |
264 | (error "missing argument to `-L' switch")) | |
265 | (set! user-load-path (cons (car args) user-load-path)) | |
266 | (parse (cdr args) | |
267 | out)) | |
268 | ||
b05257b9 MW |
269 | ((string=? arg "-C") ; add to %load-compiled-path |
270 | (if (null? args) | |
271 | (error "missing argument to `-C' switch")) | |
272 | (set! user-load-compiled-path | |
273 | (cons (car args) user-load-compiled-path)) | |
274 | (parse (cdr args) | |
275 | out)) | |
276 | ||
da5d81a1 AW |
277 | ((string=? arg "-x") ; add to %load-extensions |
278 | (if (null? args) | |
e6efefad | 279 | (error "missing argument to `-x' switch")) |
da5d81a1 AW |
280 | (set! user-extensions (cons (car args) user-extensions)) |
281 | (parse (cdr args) | |
282 | out)) | |
283 | ||
284 | ((string=? arg "-e") ; entry point | |
285 | (if (null? args) | |
286 | (error "missing argument to `-e' switch")) | |
287 | (let* ((port (open-input-string (car args))) | |
288 | (arg1 (read port)) | |
289 | (arg2 (read port))) | |
290 | ;; Recognize syntax of certain versions of guile 1.4 and | |
291 | ;; transform to (@ MODULE-NAME FUNC). | |
292 | (set! entry-point | |
293 | (cond | |
294 | ((not (eof-object? arg2)) | |
295 | `(@ ,arg1 ,arg2)) | |
296 | ((and (pair? arg1) | |
297 | (not (memq (car arg1) '(@ @@))) | |
298 | (and-map symbol? arg1)) | |
299 | `(@ ,arg1 main)) | |
300 | (else | |
301 | arg1)))) | |
302 | (parse (cdr args) | |
303 | out)) | |
304 | ||
faabd161 AW |
305 | ((string-prefix? "--language=" arg) ; language |
306 | (parse args | |
307 | (cons `(current-language | |
308 | ',(string->symbol | |
309 | (substring arg (string-length "--language=")))) | |
310 | out))) | |
311 | ||
312 | ((string=? "--language" arg) ; language | |
313 | (when (null? args) | |
314 | (error "missing argument to `--language' option")) | |
315 | (parse (cdr args) | |
316 | (cons `(current-language ',(string->symbol (car args))) | |
317 | out))) | |
318 | ||
da5d81a1 AW |
319 | ((string=? arg "-ds") ; do script here |
320 | ;; We put a dummy "load" expression, and let the -s put the | |
321 | ;; filename in. | |
faabd161 AW |
322 | (when script-cell |
323 | (error "the -ds switch may only be specified once")) | |
324 | (set! script-cell (list #f)) | |
da5d81a1 | 325 | (parse args |
faabd161 AW |
326 | (acons '(@@ (ice-9 command-line) load/lang) |
327 | script-cell | |
328 | out))) | |
da5d81a1 AW |
329 | |
330 | ((string=? arg "--debug") | |
331 | (set! turn-on-debugging? #t) | |
332 | (set! turn-off-debugging? #f) | |
333 | (parse args out)) | |
334 | ||
335 | ((string=? arg "--no-debug") | |
336 | (set! turn-off-debugging? #t) | |
337 | (set! turn-on-debugging? #f) | |
338 | (parse args out)) | |
339 | ||
340 | ;; Do auto-compile on/off now, because the form itself might | |
341 | ;; need this decision. | |
342 | ((string=? arg "--auto-compile") | |
90779ad9 AW |
343 | (set! %load-should-auto-compile #t) |
344 | (parse args out)) | |
da5d81a1 | 345 | |
1e56cff2 AW |
346 | ((string=? arg "--fresh-auto-compile") |
347 | (set! %load-should-auto-compile #t) | |
348 | (set! %fresh-auto-compile #t) | |
349 | (parse args out)) | |
350 | ||
da5d81a1 | 351 | ((string=? arg "--no-auto-compile") |
90779ad9 AW |
352 | (set! %load-should-auto-compile #f) |
353 | (parse args out)) | |
da5d81a1 AW |
354 | |
355 | ((string=? arg "-q") ; don't load user init | |
90779ad9 AW |
356 | (set! inhibit-user-init? #t) |
357 | (parse args out)) | |
da5d81a1 AW |
358 | |
359 | ((string-prefix? "--use-srfi=" arg) | |
360 | (let ((srfis (map (lambda (x) | |
361 | (let ((n (string->number x))) | |
362 | (if (and n (exact? n) (integer? n) (>= n 0)) | |
363 | n | |
364 | (error "invalid SRFI specification")))) | |
365 | (string-split (substring arg 11) #\,)))) | |
366 | (if (null? srfis) | |
367 | (error "invalid SRFI specification")) | |
368 | (parse args | |
369 | (cons `(use-srfis ',srfis) out)))) | |
370 | ||
371 | ((string=? arg "--listen") ; start a repl server | |
372 | (parse args | |
59106595 | 373 | (cons '((@@ (system repl server) spawn-server)) out))) |
da5d81a1 AW |
374 | |
375 | ((string-prefix? "--listen=" arg) ; start a repl server | |
376 | (parse | |
377 | args | |
378 | (cons | |
86b4309b | 379 | (let ((where (substring arg 9))) |
da5d81a1 AW |
380 | (cond |
381 | ((string->number where) ; --listen=PORT | |
382 | => (lambda (port) | |
383 | (if (and (integer? port) (exact? port) (>= port 0)) | |
59106595 IP |
384 | `((@@ (system repl server) spawn-server) |
385 | ((@@ (system repl server) make-tcp-server-socket) #:port ,port)) | |
86b4309b | 386 | (error "invalid port for --listen")))) |
da5d81a1 | 387 | ((string-prefix? "/" where) ; --listen=/PATH/TO/SOCKET |
59106595 IP |
388 | `((@@ (system repl server) spawn-server) |
389 | ((@@ (system repl server) make-unix-domain-server-socket) #:path ,where))) | |
da5d81a1 AW |
390 | (else |
391 | (error "unknown argument to --listen")))) | |
392 | out))) | |
393 | ||
394 | ((or (string=? arg "-h") (string=? arg "--help")) | |
395 | (shell-usage usage-name #f) | |
396 | (exit 0)) | |
397 | ||
398 | ((or (string=? arg "-v") (string=? arg "--version")) | |
399 | (version-etc "GNU Guile" (version) | |
e07f0a55 | 400 | #:license *LGPLv3+* |
da5d81a1 AW |
401 | #:command-name "guile" |
402 | #:packager (assq-ref %guile-build-info 'packager) | |
403 | #:packager-version | |
404 | (assq-ref %guile-build-info 'packager-version)) | |
405 | (exit 0)) | |
406 | ||
407 | (else | |
408 | (error "Unrecognized switch ~a" arg))))))) | |
409 | ||
410 | (define (finish args out) | |
411 | ;; Check to make sure the -ds got a -s. | |
faabd161 AW |
412 | (when (and script-cell (not (car script-cell))) |
413 | (error "the `-ds' switch requires the use of `-s' as well")) | |
da5d81a1 AW |
414 | |
415 | ;; Make any remaining arguments available to the | |
416 | ;; script/command/whatever. | |
417 | (set-program-arguments (cons arg0 args)) | |
418 | ||
419 | ;; If debugging was requested, or we are interactive and debugging | |
420 | ;; was not explicitly turned off, use the debug engine. | |
421 | (if (or turn-on-debugging? | |
422 | (and interactive? (not turn-off-debugging?))) | |
423 | (begin | |
424 | (set-default-vm-engine! 'debug) | |
972275ee | 425 | (set-vm-engine! 'debug))) |
da5d81a1 AW |
426 | |
427 | ;; Return this value. | |
428 | `(;; It would be nice not to load up (ice-9 control), but the | |
429 | ;; default-prompt-handler is nontrivial. | |
430 | (@ (ice-9 control) %) | |
431 | (begin | |
432 | ;; If we didn't end with a -c or a -s and didn't supply a -q, load | |
433 | ;; the user's customization file. | |
434 | ,@(if (and interactive? (not inhibit-user-init?)) | |
435 | '((load-user-init)) | |
436 | '()) | |
437 | ||
438 | ;; Use-specified extensions. | |
439 | ,@(map (lambda (ext) | |
440 | `(set! %load-extensions (cons ,ext %load-extensions))) | |
441 | user-extensions) | |
442 | ||
b05257b9 | 443 | ;; Add the user-specified load paths here, so they won't be in |
da5d81a1 AW |
444 | ;; effect during the loading of the user's customization file. |
445 | ,@(map (lambda (path) | |
446 | `(set! %load-path (cons ,path %load-path))) | |
447 | user-load-path) | |
b05257b9 MW |
448 | ,@(map (lambda (path) |
449 | `(set! %load-compiled-path | |
450 | (cons ,path %load-compiled-path))) | |
451 | user-load-compiled-path) | |
da5d81a1 AW |
452 | |
453 | ;; Put accumulated actions in their correct order. | |
454 | ,@(reverse! out) | |
455 | ||
456 | ;; Handle the `-e' switch, if it was specified. | |
457 | ,@(if entry-point | |
458 | `((,entry-point (command-line))) | |
459 | '()) | |
460 | ,(if interactive? | |
461 | ;; If we didn't end with a -c or a -s, start the | |
462 | ;; repl. | |
463 | '((@ (ice-9 top-repl) top-repl)) | |
464 | ;; Otherwise, after doing all the other actions | |
465 | ;; prescribed by the command line, quit. | |
466 | '(quit))))) | |
467 | ||
468 | (if (pair? args) | |
469 | (begin | |
470 | (set! arg0 (car args)) | |
471 | (let ((slash (string-rindex arg0 #\/))) | |
472 | (set! usage-name | |
473 | (if slash (substring arg0 (1+ slash)) arg0))) | |
474 | (parse (cdr args) '())) | |
475 | (parse args '())))) |