Delete command-line.scm
This commit is contained in:
Mike Gran
parent
6af9c017ff
commit
5b86f0344c
GPG Key ID:
4AEE18F83AFDEB23
@ -1,150 +0,0 @@
|
|||||||
(define-module (potato command-line)
|
|
||||||
#:use-module (srfi srfi-1)
|
|
||||||
#:use-module (ice-9 exceptions)
|
|
||||||
#:use-module (ice-9 optargs)
|
|
||||||
#:use-module (ice-9 getopt-long)
|
|
||||||
#:use-module (potato exceptions)
|
|
||||||
#:export (OPT_QUIET
|
|
||||||
OPT_VERBOSE
|
|
||||||
opt-elevate-env-vars
|
|
||||||
opt-ignore-errors
|
|
||||||
opt-continue-on-error
|
|
||||||
opt-dry-run
|
|
||||||
opt-dump-macros
|
|
||||||
opt-no-builtins
|
|
||||||
opt-silent
|
|
||||||
parse-command-line-and-makeflags))
|
|
||||||
|
|
||||||
(define option-spec
|
|
||||||
'((help (single-char #\h) (value #f))
|
|
||||||
(version (single-char #\v) (value #f))
|
|
||||||
(quiet (single-char #\q) (value #f))
|
|
||||||
(verbose (value #f))
|
|
||||||
(elevate-env-vars (single-char #\e) (value #f))
|
|
||||||
(ignore-errors (single-char #\i) (value #f))
|
|
||||||
(continue-on-error (single-char #\k) (value #f))
|
|
||||||
(dry-run (single-char #\n) (value #f))
|
|
||||||
(dump-macros (single-char #\p) (value #f))
|
|
||||||
(no-builtins (single-char #\r) (value #f))
|
|
||||||
(silent (single-char #\s) (value #f))))
|
|
||||||
|
|
||||||
(define OPT_HELP 0)
|
|
||||||
(define OPT_VERSION 1)
|
|
||||||
(define OPT_QUIET 2)
|
|
||||||
(define OPT_VERBOSE 3)
|
|
||||||
(define opt-elevate-env-vars 1)
|
|
||||||
(define opt-ignore-errors 2)
|
|
||||||
(define opt-continue-on-error 3)
|
|
||||||
(define opt-dry-run 4)
|
|
||||||
(define opt-dump-macros 5)
|
|
||||||
(define opt-no-builtins 6)
|
|
||||||
(define opt-silent 7)
|
|
||||||
#|
|
|
||||||
;; FIXME: unused. Kill it?
|
|
||||||
(define* (open-makefile-port #:optional (name #f))
|
|
||||||
"If NAME is defined and is a regular file, a input file port will be
|
|
||||||
opened for NAME. If NAME is '-', the standard input port will be
|
|
||||||
returned. If NAME is #f, a file port will be attempted for 'makefile'
|
|
||||||
and then 'Makefile'. It will throw an exception if no file can be
|
|
||||||
found."
|
|
||||||
(cond
|
|
||||||
((equal? name "-")
|
|
||||||
current-input-port)
|
|
||||||
((string? name)
|
|
||||||
(if (file-exists? name)
|
|
||||||
(open-input-file name)
|
|
||||||
(raise-exception (make-makefile-not-found-exception))))
|
|
||||||
((file-exists? "makefile")
|
|
||||||
(open-input-file "makefile"))
|
|
||||||
((file-exists? "Makefile")
|
|
||||||
(open-input-file "Makefile"))
|
|
||||||
(else
|
|
||||||
(raise-exception (make-makefile-not-found-exception)))))
|
|
||||||
|#
|
|
||||||
|
|
||||||
(define (parse-macros lst)
|
|
||||||
"Search for list for strings of the form KEY=VAR and return a list
|
|
||||||
of pairs of KEY VAL"
|
|
||||||
(filter-map
|
|
||||||
(lambda (str)
|
|
||||||
(let ((tok (string-split str #\x)))
|
|
||||||
(cond
|
|
||||||
((= 1 (length tok))
|
|
||||||
#f)
|
|
||||||
((= 2 (length tok))
|
|
||||||
(cons (car tok) (cadr tok)))
|
|
||||||
(else
|
|
||||||
(invalid-macro "parse-macros" str)))))
|
|
||||||
lst))
|
|
||||||
|
|
||||||
(define (parse-targets lst)
|
|
||||||
"Search the list for strings that don't have equals signs, and
|
|
||||||
return them in a list."
|
|
||||||
(filter-map
|
|
||||||
(lambda (str)
|
|
||||||
(if (string-index str #\=)
|
|
||||||
#f
|
|
||||||
str))
|
|
||||||
lst))
|
|
||||||
|
|
||||||
(define* (parse-makeflags #:key (environ #t))
|
|
||||||
"Checks the MAKEFLAGS environment variable for single space-separated
|
|
||||||
letters that match options flags."
|
|
||||||
(let ((makeflags (getenv "MAKEFLAGS")))
|
|
||||||
(if (or (not makeflags) (not environ))
|
|
||||||
(list #f #f #f #f #f #f #f #f)
|
|
||||||
;; else
|
|
||||||
(let* ((tokens (string-tokenize makeflags))
|
|
||||||
(check (lambda (str)
|
|
||||||
(if (member str tokens) #t #f))))
|
|
||||||
(map check '("v" "e" "i" "k" "n" "p" "s"))))))
|
|
||||||
|
|
||||||
(define (merge-options opts1 opts2)
|
|
||||||
(map (lambda (a b)
|
|
||||||
(or a b))
|
|
||||||
opts1
|
|
||||||
opts2))
|
|
||||||
|
|
||||||
(define (display-help-and-exit argv0)
|
|
||||||
(format #t "command-line options for ~S~%" argv0)
|
|
||||||
(format #t " -h --help display this help~%")
|
|
||||||
(format #t " -v --version display library version~%")
|
|
||||||
(exit 0))
|
|
||||||
|
|
||||||
(define (display-version-and-exit argv0 ver)
|
|
||||||
(format #t "~S version ~S~%" argv0 ver)
|
|
||||||
(exit 0))
|
|
||||||
|
|
||||||
(define* (parse-command-line-and-makeflags
|
|
||||||
#:key (arguments '("unknown"))
|
|
||||||
(environ #f)
|
|
||||||
(version "unknown"))
|
|
||||||
"This does the standard parsing of the MAKEFLAGS environment
|
|
||||||
variable and the command-line arguments and sets up the
|
|
||||||
environment. ARGUMENTS, if present, should be of the form passed by
|
|
||||||
Guile's 'program-arguments' procedure."
|
|
||||||
(let* ((makeflags-options (parse-makeflags #:environ environ))
|
|
||||||
(options-requested (getopt-long arguments option-spec))
|
|
||||||
(options
|
|
||||||
(map (lambda opt
|
|
||||||
(option-ref options-requested opt #f))
|
|
||||||
'(help
|
|
||||||
version
|
|
||||||
silent
|
|
||||||
elevate-env-vars
|
|
||||||
ignore-errors
|
|
||||||
continue-on-error
|
|
||||||
dry-run
|
|
||||||
dump-macros
|
|
||||||
check-target
|
|
||||||
no-builtins))))
|
|
||||||
(when (list-ref options OPT_HELP)
|
|
||||||
(display-help-and-exit (car arguments)))
|
|
||||||
(when (list-ref options OPT_VERSION)
|
|
||||||
(display-version-and-exit (car arguments) version))
|
|
||||||
(let ((macros (parse-macros (option-ref options-requested '() '())))
|
|
||||||
(targets (parse-targets (option-ref options-requested '() '()))))
|
|
||||||
(values
|
|
||||||
(merge-options makeflags-options options)
|
|
||||||
macros
|
|
||||||
targets)))
|
|
||||||
Loading…
Reference in New Issue
Block a user