diff options
| -rw-r--r-- | tissue/tissue.scm | 2 | ||||
| -rw-r--r-- | tissue/web/server.scm | 3 | ||||
| -rw-r--r-- | tissue/web/themes/default.scm | 59 |
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)) |