summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2022-12-25 14:45:22 +0000
committerArun Isaac2022-12-25 23:33:04 +0000
commit38fb87bb4e34d88bc9f07e53a2e000b9eca88aac (patch)
tree2412e1dc42e7ab03a240da3457fc959da547aa17
parent3304bdae6d3df5ec0dd5b737743cbd2109d50423 (diff)
downloadtissue-38fb87bb4e34d88bc9f07e53a2e000b9eca88aac.tar.gz
tissue-38fb87bb4e34d88bc9f07e53a2e000b9eca88aac.tar.lz
tissue-38fb87bb4e34d88bc9f07e53a2e000b9eca88aac.zip
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.
-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))