summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xbin/tissue4
-rw-r--r--tissue/web.scm163
2 files changed, 1 insertions, 166 deletions
diff --git a/bin/tissue b/bin/tissue
index 95c1f9a..7bc01f1 100755
--- a/bin/tissue
+++ b/bin/tissue
@@ -315,9 +315,7 @@ Export the repository as a website to OUTPUT-DIRECTORY.
"
(command-line-program)))
((output-directory)
- (parameterize ((%project-name (tissue-configuration-project (load-config)))
- (%tags-path (tissue-configuration-web-tags-path
- (load-config))))
+ (parameterize ((%project-name (tissue-configuration-project (load-config))))
(build-website (getcwd)
output-directory
(tissue-configuration-web-css (load-config))
diff --git a/tissue/web.scm b/tissue/web.scm
index c811358..0b8be84 100644
--- a/tissue/web.scm
+++ b/tissue/web.scm
@@ -25,41 +25,28 @@
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-28)
#:use-module (srfi srfi-171)
- #:use-module (skribilo ast)
#:use-module (skribilo engine)
#:use-module (skribilo evaluator)
- #:use-module (skribilo lib)
- #:use-module (skribilo package base)
#:use-module (skribilo reader)
- #:use-module (skribilo utils keywords)
- #:use-module (skribilo writer)
- #:use-module (sxml simple)
#:use-module (web uri)
#:use-module (tissue conditions)
#:use-module (tissue issue)
#:use-module (tissue utils)
#:export (%project-name
- %tags-path
file
file?
file-name
file-writer
- issue-listing
replace-extension
copier
gemtext-reader
gemtext-exporter
skribe-exporter
- tag-issue-lister
- tag-pages
build-website))
(define %project-name
(make-parameter #f))
-(define %tags-path
- (make-parameter #f))
-
(define-record-type <file>
(file name writer)
file?
@@ -80,46 +67,6 @@ NEW-EXTENSION."
(string-append (substring file 0 (1+ (string-index-right file #\.)))
new-extension))
-(define-markup (issue-list-item #:rest opts
- #:key (ident #f) (class "issue-list-item")
- (file #f) (title #f)
- (creator #f) (created-date #f)
- (last-updater #f) (last-updated-date #f)
- (assigned #f) (keywords #f) (open #f)
- (tasks #f) (completed-tasks #f)
- (posts #f))
- (new container
- (markup 'issue-list-item)
- (ident (or ident (symbol->string (gensym "issue-list-item"))))
- (class class)
- (loc &invocation-location)
- (required-options '(#:file #:title
- #:creator #:created-date
- #:last-updater #:last-updated-date
- #:assigned #:keywords #:open
- #:tasks #:completed-tasks
- #:posts))
- (options `((#:file ,file)
- (#:title ,title)
- (#:creator ,creator)
- (#:created-date ,created-date)
- (#:last-updater ,last-updater)
- (#:last-updated-date ,last-updated-date)
- (#:assigned ,assigned)
- (#:keywords ,keywords)
- (#:open ,open)
- (#:tasks ,tasks)
- (#:completed-tasks ,completed-tasks)
- (#:posts ,posts)
- ,@(the-options opts #:ident #:class
- #:file #:title
- #:creator #:created-date
- #:last-updater #:last-updated-date
- #:assigned #:keywords #:open
- #:tasks #:completed-tasks
- #:posts)))
- (body (the-body opts))))
-
(define (sanitize-string str)
"Downcase STR and replace spaces with hyphens."
(string-map (lambda (c)
@@ -128,92 +75,6 @@ NEW-EXTENSION."
(else c)))
(string-downcase str)))
-(define (issue-list-item-markup-writer-action markup engine)
- (sxml->xml
- `(li (@ (class "issue-list-item"))
- (a (@ (href ,(string-append
- "/" (encode-and-join-uri-path
- (string-split
- (replace-extension (markup-option markup #:file)
- "html")
- #\/)))))
- ,(markup-option markup #:title))
- ,@(map (lambda (tag)
- (let ((words (string-split tag (char-set #\- #\space))))
- `(a (@ (href ,(string-append (%tags-path) "/"
- (uri-encode (sanitize-string tag))
- ".html"))
- (class ,(string-append "tag"
- (string-append " tag-" (sanitize-string tag))
- (if (not (null? (lset-intersection
- string=? words
- (list "bug" "critical"))))
- " tag-bug"
- "")
- (if (not (null? (lset-intersection
- string=? words
- (list "progress"))))
- " tag-progress"
- "")
- (if (not (null? (lset-intersection
- string=? words
- (list "chore"))))
- " tag-chore"
- "")
- (if (not (null? (lset-intersection
- string=? words
- (list "enhancement" "feature"))))
- " tag-feature"
- ""))))
- ,tag)))
- (markup-option markup #:keywords))
- (span (@ (class "issue-list-item-metadata"))
- ,(string-append
- (format " opened ~a by ~a"
- (date->string (markup-option markup #:created-date)
- "~b ~d ~Y")
- (markup-option markup #:creator))
- (if (> (length (markup-option markup #:posts))
- 1)
- (format ", last updated ~a by ~a"
- (date->string (markup-option markup #:last-updated-date)
- "~b ~d ~Y")
- (markup-option markup #:last-updater))
- "")
- (if (zero? (markup-option markup #:tasks))
- ""
- (format "; ~a of ~a tasks done"
- (markup-option markup #:completed-tasks)
- (markup-option markup #:tasks))))))))
-
-(markup-writer 'issue-list-item
- (find-engine 'html)
- #:options '(#:file #:title
- #:creator #:created-date
- #:last-updater #:last-updated-date
- #:assigned #:keywords #:open
- #:tasks #:completed-tasks
- #:posts)
- #:action issue-list-item-markup-writer-action)
-
-(define* (issue-listing #:optional (issues (reverse (issues))))
- "Return an issue listing for ISSUES, a list of <issue> objects. By
-default, all issues are listed newest first."
- (itemize (map (lambda (issue)
- (issue-list-item #:file (issue-file issue)
- #:title (issue-title issue)
- #:creator (issue-creator issue)
- #:created-date (issue-created-date issue)
- #:last-updater (issue-last-updater issue)
- #:last-updated-date (issue-last-updated-date issue)
- #:assigned (issue-assigned issue)
- #:keywords (issue-keywords issue)
- #:open (issue-open? issue)
- #:tasks (issue-tasks issue)
- #:completed-tasks (issue-completed-tasks issue)
- #:posts (issue-posts issue)))
- issues)))
-
(define (exporter file proc)
"Return a writer function that exports FILE using PROC. PROC is
passed two arguments---the input port to read from and the output port
@@ -259,30 +120,6 @@ to write to."
(evaluate-ast-from-port in #:reader reader)
(find-engine 'html))))))
-(define* (tag-issue-lister tag #:key title)
- "Return a writer function that writes a issue listing of issues with TAG.
-
-TITLE is the title to use in the head of the generated HTML, among
-other places."
- (lambda (port)
- (with-output-to-port port
- (cut evaluate-document
- (document #:title title
- (issue-listing
- (reverse (filter (lambda (issue)
- (member tag (issue-keywords issue)))
- (issues)))))
- (find-engine 'html)))))
-
-(define (tag-pages)
- "Return a list of <file> objects representing tag pages to be
-exported to the web output."
- (map (lambda (tag)
- (file (string-append (%tags-path) "/" (sanitize-string tag) ".html")
- (tag-issue-lister tag
- #:title (string-append tag " — " (%project-name)))))
- (delete-duplicates (append-map issue-keywords (issues)))))
-
(define (with-current-directory directory thunk)
"Change current directory to DIRECTORY, execute THUNK and restore
original current directory."