diff --git a/lib/chibi/snow/package.scm b/lib/chibi/snow/package.scm index 8ed65b0c..596591c8 100644 --- a/lib/chibi/snow/package.scm +++ b/lib/chibi/snow/package.scm @@ -69,12 +69,13 @@ (define (package-name package) (and (pair? package) (eq? 'package (car package)) - (or (cond ((assoc-get (cdr package) 'name) - => (lambda (x) (and (pair? x) x))) - (else #f)) - ;; TODO: longest common prefix - (let ((lib (assq 'library (cdr package)))) - (and lib (library-name lib)))))) + (cond ((assoc-get (cdr package) 'name) + => (lambda (x) (and (pair? x) x))) + ((assq 'library (cdr package)) + => (lambda (x) (library-name (cdr x)))) + ((assq 'progam (cdr package)) + => (lambda (x) (program-name (cdr x)))) + (else #f)))) (define (package-email pkg) (and (package? pkg) @@ -185,6 +186,9 @@ (define (package-libraries package) (and (package? package) (filter library? (cdr package)))) +(define (package-programs package) + (and (package? package) (filter program? (cdr package)))) + (define (package-provides? package name) (and (pair? package) (eq? 'package (car package)) @@ -320,3 +324,27 @@ (cons (car x) (map recurse (cdr x)))) (else x))) (else x))) + +;; programs + +(define (program? x) + (and (pair? x) (eq? 'program (car x)) (every pair? (cdr x)))) + +(define (program-name prog) + (and (pair? prog) + (cond ((assoc-get (cdr prog) 'name eq?)) + ((assoc-get (cdr prog) 'path eq?) + => (lambda (p) (list (string->symbol (path-strip-directory p))))) + (else #f)))) + +(define (get-program-file cfg prog) + (cond ((assoc-get prog 'path)) + ((assoc-get prog 'name) + => (lambda (name) (library-name->path (last name)))) + (else (error "program missing path: " prog)))) + +(define (program-install-name prog) + (or (assoc-get (cdr prog) 'install-name eq?) + (path-strip-extension + (path-strip-directory + (assoc-get (cdr prog) 'path eq?))))) diff --git a/lib/chibi/snow/package.sld b/lib/chibi/snow/package.sld index f0eb3c86..3d0837c7 100644 --- a/lib/chibi/snow/package.sld +++ b/lib/chibi/snow/package.sld @@ -1,8 +1,9 @@ (define-library (chibi snow package) - (export package? library? + (export package? library? program? package-name package-email package-url package-version - package-libraries package-provides? package-dependencies + package-libraries package-programs + package-provides? package-dependencies package-installed-files package-author package-digest-mismatches package-signature-mismatches package-digest-ok? package-signature-ok? @@ -12,6 +13,7 @@ library-url library-name parse-library-name library-name->path library-analyze library-include-files library-dependencies library-rewrite-includes + get-program-file program-name program-install-name invalid-package-reason valid-package? invalid-library-reason valid-library? repo-find-publisher lookup-digest rsa-identity=? diff --git a/tools/snow-chibi b/tools/snow-chibi index cef81c3b..cf97e281 100755 --- a/tools/snow-chibi +++ b/tools/snow-chibi @@ -97,7 +97,8 @@ (define verify-spec '()) (define package-spec - '((authors (list string)) + '((programs (list existing-filename)) + (authors (list string)) (maintainers (list string)) (recursive? boolean (#\r "recursive") "...") (version string)