summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--tissue/tissue.scm2
-rw-r--r--tissue/web/server.scm3
-rw-r--r--tissue/web/themes/default.scm59
3 files changed, 36 insertions, 28 deletions
diff --git a/tissue/tissue.scm b/tissue/tissue.scm
index 2e901d2..fed9fe3 100644
--- a/tissue/tissue.scm
+++ b/tissue/tissue.scm
@@ -104,7 +104,7 @@ directory they are in."
(define-lazy (tissue-configuration #:key project (aliases '()) (indexed-documents '())
web-css
- (web-search-renderer render-sxml)
+ (web-search-renderer (default-theme))
(web-files '()))
"Construct a <tissue-configuration> object. All arguments are
evaluated lazily.
diff --git a/tissue/web/server.scm b/tissue/web/server.scm
index cca67ae..ad74d6b 100644
--- a/tissue/web/server.scm
+++ b/tissue/web/server.scm
@@ -129,8 +129,7 @@ query. QUERY and FILTER are Xapian Query objects."
#:matched-open-issues (matches db query (assq-ref filter-alist 'open-issue))
#:matched-closed-issues (matches db query (assq-ref filter-alist 'closed-issue))
#:matched-documents (matches db query (assq-ref filter-alist 'document))
- #:matched-commits (matches db query (assq-ref filter-alist 'commit))))
- project)))))))
+ #:matched-commits (matches db query (assq-ref filter-alist 'commit)))))))))))
(define (try-paths path)
"Return a list of candidate paths to look for @var{path}."
diff --git a/tissue/web/themes/default.scm b/tissue/web/themes/default.scm
index 2dc8872..7ab8c89 100644
--- a/tissue/web/themes/default.scm
+++ b/tissue/web/themes/default.scm
@@ -26,10 +26,9 @@
#:use-module (tissue document)
#:use-module (tissue file-document)
#:use-module (tissue issue)
- #:use-module (tissue tissue)
#:use-module (tissue utils)
#:use-module (tissue web themes)
- #:export (render-sxml
+ #:export (default-theme
<search-page-head>
<search-page-header>
<search-page-form>
@@ -107,33 +106,43 @@ form { text-align: center; }
color: black;
}")
-(define-method (render-sxml (page <search-page>) project)
- "Return SXML for @var{page}, a @code{<search-page>} object and
-@var{project}, a @code{<tissue-configuration>} object."
+(define* (default-theme #:key (title "tissue issue tracker") css)
+ "Return a generic function that renders a page using the default
+theme.
+
+@var{title} is the title to use in the head of the HTML. @var{css} is
+a URI to a CSS stylesheet to link to. If it is @code{#f}, no
+stylesheet is linked to."
+ (add-methods render-sxml
+ (make <method>
+ #:specializers (list <search-page-head> <search-page>)
+ #:procedure (make-head-renderer title css))))
+
+(define-method (render-sxml (page <search-page>))
+ "Return SXML for @var{page}, a @code{<search-page>}."
`(html
- ,(render-sxml (make <search-page-head>) page project)
+ ,(render-sxml (make <search-page-head>) page)
(body
- ,(render-sxml (make <search-page-header>) page project)
- ,(render-sxml (make <search-page-form>) page project)
- ,(render-sxml (make <search-page-result>) page project)
- ,(render-sxml (make <search-page-footer>) page project))))
+ ,(render-sxml (make <search-page-header>) page)
+ ,(render-sxml (make <search-page-form>) page)
+ ,(render-sxml (make <search-page-result>) page)
+ ,(render-sxml (make <search-page-footer>) page))))
-(define-method (render-sxml (head <search-page-head>) (page <search-page>) project)
- `(head
- (title ,(string-append (tissue-configuration-project project)
- " issue tracker"))
- (style ,%css)
- ,@(let ((css (tissue-configuration-web-css project)))
- (if css
+(define (make-head-renderer title css)
+ (lambda (_ page)
+ `(head
+ (title ,title)
+ (style ,%css)
+ ,@(if css
(list `(link (@ (href ,css)
(rel "stylesheet")
(type "text/css"))))
(list)))))
-(define-method (render-sxml (header <search-page-header>) (page <search-page>) project)
+(define-method (render-sxml (header <search-page-header>) (page <search-page>))
`(div))
-(define-method (render-sxml (form <search-page-form>) (page <search-page>) project)
+(define-method (render-sxml (form <search-page-form>) (page <search-page>))
`(div
(form (@ (action "/search") (method "GET"))
(input (@ (type "text")
@@ -170,7 +179,7 @@ form { text-align: center; }
"Xapian::QueryParser Syntax")
" for detailed documentation."))))
-(define-method (render-sxml (result <search-page-result>) (page <search-page>) project)
+(define-method (render-sxml (result <search-page-result>) (page <search-page>))
(define (search-result-statistic search-type format-string matches)
`(li (a (@ (href ,(string-append
(uri-path (search-page-uri page))
@@ -198,12 +207,12 @@ form { text-align: center; }
(cons (render-sxml
(call-with-input-string (document-data (mset-item-document item))
(compose scm->object read))
- page project)
+ page)
result))
'()
(search-page-mset page))))))
-(define-method (render-sxml (document <file-document>) (page <search-page>) project)
+(define-method (render-sxml (document <file-document>) (page <search-page>))
`(li (@ (class "search-result search-result-document"))
(a (@ (href ,(document-web-uri document))
(class "search-result-title"))
@@ -235,7 +244,7 @@ form { text-align: center; }
(else c)))
(string-downcase str)))
-(define-method (render-sxml (issue <issue>) (page <search-page>) project)
+(define-method (render-sxml (issue <issue>) (page <search-page>))
`(li (@ (class ,(string-append "search-result search-result-issue "
(if (issue-open? issue)
"search-result-open-issue"
@@ -308,7 +317,7 @@ form { text-align: center; }
,@snippet))
(list)))))
-(define-method (render-sxml (commit <commit>) (page <search-page>) project)
+(define-method (render-sxml (commit <commit>) (page <search-page>))
`(li (@ (class ,(string-append "search-result search-result-commit")))
(a (@ (href ,(document-web-uri commit))
(class "search-result-title"))
@@ -326,5 +335,5 @@ form { text-align: center; }
,@snippet))
(list)))))
-(define-method (render-sxml (footer <search-page-footer>) (page <search-page>) project)
+(define-method (render-sxml (footer <search-page-footer>) (page <search-page>))
`(div))