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.

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))