From 38fb87bb4e34d88bc9f07e53a2e000b9eca88aac Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Sun, 25 Dec 2022 14:45:22 +0000 Subject: web: Do not pass project configuration to theme. Parameters from the project configuration may be needed by the theme. But, these parameters should not passed as explicit parameters to the generic function of the theme. Instead, they should be passed implicitly through the lexical context of the generic methods. * tissue/web/server.scm (search-handler): Do not pass project to search renderer. * tissue/web/themes/default.scm: Do not import (tissue tissue). (default-theme): New public function. (make-head-renderer): New function. (render-sxml): Make private. Remove project parameter from all generic methods. * tissue/tissue.scm (tissue-configuration): Set default value of web-search-renderer to (default-theme) instead of render-sxml. --- tissue/tissue.scm | 2 +- tissue/web/server.scm | 3 +-- tissue/web/themes/default.scm | 59 +++++++++++++++++++++++++------------------ 3 files changed, 36 insertions(+), 28 deletions(-) (limited to 'tissue') 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 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 @@ -107,33 +106,43 @@ form { text-align: center; } color: black; }") -(define-method (render-sxml (page ) project) - "Return SXML for @var{page}, a @code{} object and -@var{project}, a @code{} 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 + #:specializers (list ) + #:procedure (make-head-renderer title css)))) + +(define-method (render-sxml (page )) + "Return SXML for @var{page}, a @code{}." `(html - ,(render-sxml (make ) page project) + ,(render-sxml (make ) page) (body - ,(render-sxml (make ) page project) - ,(render-sxml (make ) page project) - ,(render-sxml (make ) page project) - ,(render-sxml (make ) page project)))) + ,(render-sxml (make ) page) + ,(render-sxml (make ) page) + ,(render-sxml (make ) page) + ,(render-sxml (make ) page)))) -(define-method (render-sxml (head ) (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 ) (page ) project) +(define-method (render-sxml (header ) (page )) `(div)) -(define-method (render-sxml (form ) (page ) project) +(define-method (render-sxml (form ) (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 ) (page ) project) +(define-method (render-sxml (result ) (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 ) (page ) project) +(define-method (render-sxml (document ) (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 ) (page ) project) +(define-method (render-sxml (issue ) (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 ) (page ) project) +(define-method (render-sxml (commit ) (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 ) (page ) project) +(define-method (render-sxml (footer ) (page )) `(div)) -- cgit v1.2.3