mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-11 15:07:34 +02:00
Adding description to packages, inferred from docs where possible.
This commit is contained in:
parent
7668d5ebad
commit
c008dc6dd1
1 changed files with 35 additions and 10 deletions
|
@ -276,7 +276,9 @@
|
||||||
(equal? base (take dep (length base)))
|
(equal? base (take dep (length base)))
|
||||||
;; TODO: find-library(-relative)
|
;; TODO: find-library(-relative)
|
||||||
(let* ((dir (library-path-base file lib))
|
(let* ((dir (library-path-base file lib))
|
||||||
(dep-file (make-path dir (library-name->path dep))))
|
(dep-file (make-path dir (string-append
|
||||||
|
(library-name->path dep)
|
||||||
|
".sld"))))
|
||||||
(and (file-exists? dep-file) dep-file))))
|
(and (file-exists? dep-file) dep-file))))
|
||||||
|
|
||||||
(define (package-docs cfg spec libs)
|
(define (package-docs cfg spec libs)
|
||||||
|
@ -295,6 +297,27 @@
|
||||||
libs))
|
libs))
|
||||||
(else '())))
|
(else '())))
|
||||||
|
|
||||||
|
(define (package-description cfg spec libs docs)
|
||||||
|
(cond
|
||||||
|
((conf-get cfg '(command package description)))
|
||||||
|
;; Crazy hack, make this more robust, probably opt-in.
|
||||||
|
((and (pair? docs) (pair? (car docs)) (eq? 'inline (caar docs))
|
||||||
|
(regexp-search
|
||||||
|
'(: "<p>" (* "\n") (* space) ($ (* (~ ("."))) "."))
|
||||||
|
(third (car docs))))
|
||||||
|
=> (lambda (m)
|
||||||
|
(let ((s (regexp-match-submatch m 1)))
|
||||||
|
(and s
|
||||||
|
(regexp-replace-all
|
||||||
|
'(>= 2 space)
|
||||||
|
(regexp-replace-all
|
||||||
|
"\n"
|
||||||
|
(regexp-replace-all '(: "<" (? "/") (* (~ ("<>"))) ">")
|
||||||
|
s "")
|
||||||
|
" ")
|
||||||
|
" ")))))
|
||||||
|
(else #f)))
|
||||||
|
|
||||||
(define (package-test cfg)
|
(define (package-test cfg)
|
||||||
(conf-get cfg '(command package test)))
|
(conf-get cfg '(command package test)))
|
||||||
|
|
||||||
|
@ -315,19 +338,21 @@
|
||||||
(package-output-version cfg))))
|
(package-output-version cfg))))
|
||||||
|
|
||||||
(define (package-spec+files cfg spec libs)
|
(define (package-spec+files cfg spec libs)
|
||||||
(let ((recursive? (conf-get cfg '(command package recursive?)))
|
(let* ((recursive? (conf-get cfg '(command package recursive?)))
|
||||||
(docs (package-docs cfg spec libs))
|
(docs (package-docs cfg spec libs))
|
||||||
(test (package-test cfg))
|
(desc (package-description cfg spec libs docs))
|
||||||
(version (package-output-version cfg)))
|
(test (package-test cfg))
|
||||||
|
(version (package-output-version cfg)))
|
||||||
(let lp ((ls (map (lambda (x) (cons x #f)) libs))
|
(let lp ((ls (map (lambda (x) (cons x #f)) libs))
|
||||||
(res
|
(res
|
||||||
`(,@(if (pair? docs)
|
`(,@(if (pair? docs)
|
||||||
`((doc ,@(map
|
`((manual ,@(map
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(path-strip-leading-parents
|
(path-strip-leading-parents
|
||||||
(if (pair? x) (cadr x) x)))
|
(if (pair? x) (cadr x) x)))
|
||||||
docs)))
|
docs)))
|
||||||
'())
|
'())
|
||||||
|
,@(if desc `((description ,desc)) '())
|
||||||
,@(if test `((test ,(path-strip-leading-parents test))) '())
|
,@(if test `((test ,(path-strip-leading-parents test))) '())
|
||||||
,@(if version `((version ,version)) '())))
|
,@(if version `((version ,version)) '())))
|
||||||
(files
|
(files
|
||||||
|
|
Loading…
Add table
Reference in a new issue