From d2030165514f6befb29399bd24c28efc78fdf33a Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Sun, 29 Jun 2014 22:10:19 +0900
Subject: [PATCH] run-application takes an optional initial config argument

---
 lib/chibi/app.scm |  5 ++-
 tools/snow-chibi  | 94 +++++++++++++++++++++--------------------------
 2 files changed, 45 insertions(+), 54 deletions(-)

diff --git a/lib/chibi/app.scm b/lib/chibi/app.scm
index 4ecfe7cd..1ba222b8 100644
--- a/lib/chibi/app.scm
+++ b/lib/chibi/app.scm
@@ -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))
diff --git a/tools/snow-chibi b/tools/snow-chibi
index b478d4ae..58330d56 100755
--- a/tools/snow-chibi
+++ b/tools/snow-chibi
@@ -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")))