Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

run-application takes an optional initial config argument

Browse source
This commit is contained in:
Alex Shinn 2014-06-29 22:10:19 +09:00
parent 15fb65b2d5
commit d203016551
2 changed files with 45 additions and 54 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
lib/chibi/app.scm
View file

@ -263,9 +263,10 @@
(app-help spec args (current-output-port)))
(define (run-application spec . o)
(let ((args (if (pair? o) (car o) (command-line))))
(let ((args (or (and (pair? o) (car o)) (command-line)))
(config (and (pair? o) (pair? (cdr o)) (cadr o))))
(cond
((parse-app '() (cdr spec) '() (cdr args) #f #f #f)
((parse-app '() (cdr spec) '() (cdr args) config #f #f)
=> (lambda (v)
(let ((proc (vector-ref v 0))
(cfg (vector-ref v 1))

94
tools/snow-chibi
View file

@ -14,49 +14,49 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define repo-spec
'((repository
(conf
(sibling
(conf
(name string)
(url string)))
(package
(conf
(name (list (or symbol integer)))
(url string)
(size integer)
(checksums (alist symbol string))
(signature (alist symbol string))
(library
(conf
(name (list (or symbol integer)))
(path string)
(depends
(list (list (or symbol integer string
(list (member < > <= >=) string)))))
(provides (list (list (or symbol string))))
(platforms (list (or symbol (list symbol))))
(features (list symbol))
(authors (list string))
(maintainers (list string))
(description string)
(created string)
(updated string)
(version string)
(licenses
(list
(or (member gpl2 gpl3 lgpl mit bsd artistic apache public-domain)
(list 'license
(conf (name string)
(url string)
(checksums (alist symbol string)))))))))))))))
;; (define repo-spec
;; '((repository
;; (conf
;; (sibling
;; (conf
;; (name string)
;; (url string)))
;; (package
;; (conf
;; (name (list (or symbol integer)))
;; (url string)
;; (size integer)
;; (checksums (alist symbol string))
;; (signature (alist symbol string))
;; (library
;; (conf
;; (name (list (or symbol integer)))
;; (path string)
;; (depends
;; (list (list (or symbol integer string
;; (list (member < > <= >=) string)))))
;; (provides (list (list (or symbol string))))
;; (platforms (list (or symbol (list symbol))))
;; (features (list symbol))
;; (authors (list string))
;; (maintainers (list string))
;; (description string)
;; (created string)
;; (updated string)
;; (version string)
;; (licenses
;; (list
;; (or (member gpl2 gpl3 lgpl mit bsd artistic apache public-domain)
;; (list 'license
;; (conf (name string)
;; (url string)
;; (checksums (alist symbol string)))))))))))))))
(define conf-spec
;; name type aliases doc
'((verbose? boolean (#\v "verbose") "print additional informative messages")
(always-yes? boolean (#\y "always-yes") "answer all questions with yes")
(config filename "path to configuration file")
;;(config filename "path to configuration file")
(host string "base uri of snow repository")
(local-root-repository dirname "repository cache dir for root")
(local-user-repository dirname "repository cache dir for non-root users")
@ -68,22 +68,10 @@
))
(define (conf-default-path name)
(make-path (get-environment-variable "HOME")
(make-path (or (get-environment-variable "HOME") ".")
(string-append "." name)
"config.scm"))
;; We need to support:
;;
;; <prog> [<options>...] <command> [<command-options>...] <args>...
;;
;; up to arbitrarily nested sub-commands and with option parsing and
;; argument count verification.
;;
;; Furthermore, it should be possible to build this programmatically,
;; for example by searching a directory for extensions/plugins. Thus
;; even if a convenience syntax is provided it should be a thin layer
;; over a procedural interface.
(define search-spec '())
(define show-spec '())
(define install-spec '())
@ -170,4 +158,6 @@
(,app-help-command args ...))
)))
(run-application app-spec)
(run-application app-spec
(command-line)
(conf-load (conf-default-path "snow")))