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))) (app-help spec args (current-output-port)))
(define (run-application spec . o) (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 (cond
((parse-app '() (cdr spec) '() (cdr args) #f #f #f) ((parse-app '() (cdr spec) '() (cdr args) config #f #f)
=> (lambda (v) => (lambda (v)
(let ((proc (vector-ref v 0)) (let ((proc (vector-ref v 0))
(cfg (vector-ref v 1)) (cfg (vector-ref v 1))

94
tools/snow-chibi
View file

@ -14,49 +14,49 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define repo-spec ;; (define repo-spec
'((repository ;; '((repository
(conf ;; (conf
(sibling ;; (sibling
(conf ;; (conf
(name string) ;; (name string)
(url string))) ;; (url string)))
(package ;; (package
(conf ;; (conf
(name (list (or symbol integer))) ;; (name (list (or symbol integer)))
(url string) ;; (url string)
(size integer) ;; (size integer)
(checksums (alist symbol string)) ;; (checksums (alist symbol string))
(signature (alist symbol string)) ;; (signature (alist symbol string))
(library ;; (library
(conf ;; (conf
(name (list (or symbol integer))) ;; (name (list (or symbol integer)))
(path string) ;; (path string)
(depends ;; (depends
(list (list (or symbol integer string ;; (list (list (or symbol integer string
(list (member < > <= >=) string))))) ;; (list (member < > <= >=) string)))))
(provides (list (list (or symbol string)))) ;; (provides (list (list (or symbol string))))
(platforms (list (or symbol (list symbol)))) ;; (platforms (list (or symbol (list symbol))))
(features (list symbol)) ;; (features (list symbol))
(authors (list string)) ;; (authors (list string))
(maintainers (list string)) ;; (maintainers (list string))
(description string) ;; (description string)
(created string) ;; (created string)
(updated string) ;; (updated string)
(version string) ;; (version string)
(licenses ;; (licenses
(list ;; (list
(or (member gpl2 gpl3 lgpl mit bsd artistic apache public-domain) ;; (or (member gpl2 gpl3 lgpl mit bsd artistic apache public-domain)
(list 'license ;; (list 'license
(conf (name string) ;; (conf (name string)
(url string) ;; (url string)
(checksums (alist symbol string))))))))))))))) ;; (checksums (alist symbol string)))))))))))))))
(define conf-spec (define conf-spec
;; name type aliases doc ;; name type aliases doc
'((verbose? boolean (#\v "verbose") "print additional informative messages") '((verbose? boolean (#\v "verbose") "print additional informative messages")
(always-yes? boolean (#\y "always-yes") "answer all questions with yes") (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") (host string "base uri of snow repository")
(local-root-repository dirname "repository cache dir for root") (local-root-repository dirname "repository cache dir for root")
(local-user-repository dirname "repository cache dir for non-root users") (local-user-repository dirname "repository cache dir for non-root users")
@ -68,22 +68,10 @@
)) ))
(define (conf-default-path name) (define (conf-default-path name)
(make-path (get-environment-variable "HOME") (make-path (or (get-environment-variable "HOME") ".")
(string-append "." name) (string-append "." name)
"config.scm")) "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 search-spec '())
(define show-spec '()) (define show-spec '())
(define install-spec '()) (define install-spec '())
@ -170,4 +158,6 @@
(,app-help-command args ...)) (,app-help-command args ...))
))) )))
(run-application app-spec) (run-application app-spec
(command-line)
(conf-load (conf-default-path "snow")))