web: Implement themes for the search page.

We factor out all display related code to a theming module, and
support powerful user customization of the theme thanks to generic
functions.

* tissue/commit.scm (document->sxml): Move to (tissue web themes
default).
* tissue/document.scm (document->sxml): Move to (tissue web themes
default).
* tissue/file-document.scm (document->sxml): Move to (tissue web
themes default).
* tissue/issue.scm (sanitize-string, document->sxml): Move to (tissue
web themes default).
* tissue/tissue.scm: Import (tissue web themes default).
(<tissue-configuration>)[web-search-renderer]: New field.
(tissue-configuration-web-search-renderer): New function.
(tissue-configuration): Accept web-search-renderer argument.
* tissue/web/server.scm: Import (oop goops) and (tissue web
themes). Do not import (tissue document).
(%css, make-search-page, search-handler): Move to (tissue web themes
default).
* tissue/web/themes.scm, tissue/web/themes/default.scm: New files.
* Makefile (sources): Add $(top_level_module_dir)/web/themes/*.scm.

9 files changed, 421 insertions, 323 deletions

diff --git a/Makefile b/Makefile
index 2bc955c..3e8359b 100644
--- a/Makefile
+++ b/Makefile
@@ -30,7 +30,9 @@ libdir ?= $(exec_prefix)/lib
 datarootdir ?= $(prefix)/share
 
 top_level_module_dir = $(project)
-sources = $(wildcard $(top_level_module_dir)/*.scm) $(wildcard $(top_level_module_dir)/web/*.scm)
+sources = $(wildcard $(top_level_module_dir)/*.scm) \
+          $(wildcard $(top_level_module_dir)/web/*.scm) \
+          $(wildcard $(top_level_module_dir)/web/themes/*.scm)
 objects = $(sources:.scm=.go)
 scripts = $(wildcard bin/*)
 tests = $(wildcard tests/*)
diff --git a/tissue/commit.scm b/tissue/commit.scm
index 3dfd45f..e08f5a6 100644
--- a/tissue/commit.scm
+++ b/tissue/commit.scm
@@ -90,26 +90,6 @@ search results."
       (newline port)
       (newline port))))
 
-(define-method (document->sxml (commit <commit>) mset)
-  "Render COMMIT, a <commit> object, to SXML. MSET is the xapian MSet
-object representing a list of search results."
-  `(li (@ (class ,(string-append "search-result search-result-commit")))
-       (a (@ (href ,(document-web-uri commit))
-             (class "search-result-title"))
-          ,(document-title commit))
-       (div (@ (class "search-result-metadata"))
-            (span (@ (class ,(string-append "document-type commit-document-type")))
-                  "commit")
-            ,(string-append
-              (format #f " authored ~a by ~a"
-                      (human-date-string (doc:commit-author-date commit))
-                      (doc:commit-author commit))))
-       ,@(let ((snippet (document-sxml-snippet commit mset)))
-           (if snippet
-               (list `(div (@ (class "search-result-snippet"))
-                           ,@snippet))
-               (list)))))
-
 (define (repository-commits repository)
   "Return a list of <commit> objects representing commits in
 REPOSITORY."
diff --git a/tissue/document.scm b/tissue/document.scm
index 65a68b6..38270a5 100644
--- a/tissue/document.scm
+++ b/tissue/document.scm
@@ -43,8 +43,7 @@
             document-snippet-source-text
             document-snippet
             print
-            document-sxml-snippet
-            document->sxml))
+            document-sxml-snippet))
 
 (define (slot-set object slot-name value)
   "Set @var{slot-name} in @var{object} to @var{value}. This is a purely
@@ -138,7 +137,6 @@ mutate @var{object}."
 (define-generic document-text)
 (define-generic document-recency-date)
 (define-generic print)
-(define-generic document->sxml)
 
 (define-method (document-type (document <document>))
   (string-trim-both (symbol->string (class-name (class-of document)))
diff --git a/tissue/file-document.scm b/tissue/file-document.scm
index 847fb42..7673964 100644
--- a/tissue/file-document.scm
+++ b/tissue/file-document.scm
@@ -116,32 +116,6 @@ MSet object representing a list of search results."
       (newline port)
       (newline port))))
 
-(define-method (document->sxml (document <file-document>) mset)
-  "Render DOCUMENT to SXML. MSET is the xapian MSet object representing
-a list of search results."
-  `(li (@ (class "search-result search-result-document"))
-       (a (@ (href ,(document-web-uri document))
-             (class "search-result-title"))
-          ,(document-title document))
-       (div (@ (class "search-result-metadata"))
-            (span (@ (class ,(string-append "document-type file-document-type")))
-                  "document")
-            ,(string-append
-              (format #f " created ~a by ~a"
-                      (human-date-string (file-document-created-date document))
-                      (file-document-creator document))
-              (if (> (length (file-document-commits document))
-                     1)
-                  (format #f ", last updated ~a by ~a"
-                          (human-date-string (file-document-last-updated-date document))
-                          (file-document-last-updater document))
-                  "")))
-       ,@(let ((snippet (document-sxml-snippet document mset)))
-           (if snippet
-               (list `(div (@ (class "search-result-snippet"))
-                           ,@snippet))
-               (list)))))
-
 (define file-modification-table-for-current-repository
   (memoize-thunk
    (cut file-modification-table (current-git-repository))))
diff --git a/tissue/issue.scm b/tissue/issue.scm
index 869b0ed..e20b4d0 100644
--- a/tissue/issue.scm
+++ b/tissue/issue.scm
@@ -160,89 +160,6 @@
     (newline)
     (newline)))
 
-(define (sanitize-string str)
-  "Downcase STR and replace spaces with hyphens."
-  (string-map (lambda (c)
-                (case c
-                  ((#\space) #\-)
-                  (else c)))
-              (string-downcase str)))
-
-(define-method (document->sxml (issue <issue>) mset)
-  "Render ISSUE, an <issue> object, to SXML. MSET is the xapian MSet
-object representing a list of search results."
-  `(li (@ (class ,(string-append "search-result search-result-issue "
-                                 (if (issue-open? issue)
-                                     "search-result-open-issue"
-                                     "search-result-closed-issue"))))
-       (a (@ (href ,(document-web-uri issue))
-             (class "search-result-title"))
-          ,(document-title issue))
-       (ul (@ (class "tags"))
-           ,@(map (lambda (tag)
-                    (let ((words (string-split tag (char-set #\- #\space))))
-                      `(li (@ (class
-                                ,(string-append "tag"
-                                                (string-append " tag-" (sanitize-string tag))
-                                                (if (not (null? (lset-intersection
-                                                                 string=? words
-                                                                 (list "bug" "critical"))))
-                                                    " tag-bug"
-                                                    "")
-                                                (if (not (null? (lset-intersection
-                                                                 string=? words
-                                                                 (list "progress"))))
-                                                    " tag-progress"
-                                                    "")
-                                                (if (not (null? (lset-intersection
-                                                                 string=? words
-                                                                 (list "chore"))))
-                                                    " tag-chore"
-                                                    "")
-                                                (if (not (null? (lset-intersection
-                                                                 string=? words
-                                                                 (list "enhancement" "feature"))))
-                                                    " tag-feature"
-                                                    ""))))
-                           (a (@ (href ,(string-append
-                                         "/search?query="
-                                         (uri-encode
-                                          ;; Quote tag if it has spaces.
-                                          (string-append "tag:"
-                                                         (if (string-any #\space tag)
-                                                             (string-append "\"" tag "\"")
-                                                             tag))))))
-                              ,tag))))
-                  (issue-keywords issue)))
-       (div (@ (class "search-result-metadata"))
-            (span (@ (class ,(string-append "document-type issue-document-type "
-                                            (if (issue-open? issue)
-                                                "open-issue-document-type"
-                                                "closed-issue-document-type"))))
-                  ,(if (issue-open? issue)
-                       "issue"
-                       "✓ issue"))
-            ,(string-append
-              (format #f " opened ~a by ~a"
-                      (human-date-string (file-document-created-date issue))
-                      (file-document-creator issue))
-              (if (> (length (file-document-commits issue))
-                     1)
-                  (format #f ", last updated ~a by ~a"
-                          (human-date-string (file-document-last-updated-date issue))
-                          (file-document-last-updater issue))
-                  "")
-              (if (zero? (issue-tasks issue))
-                  ""
-                  (format #f "; ~a of ~a tasks done"
-                          (issue-completed-tasks issue)
-                          (issue-tasks issue)))))
-       ,@(let ((snippet (document-sxml-snippet issue mset)))
-           (if snippet
-               (list `(div (@ (class "search-result-snippet"))
-                           ,@snippet))
-               (list)))))
-
 (define (hashtable-prepend! hashtable key new-values)
   "Prepend NEW-VALUES to the list of values KEY is associated to in
 HASHTABLE. Deduplicate the resulting list if necessary. If KEY is not
diff --git a/tissue/tissue.scm b/tissue/tissue.scm
index e42420a..2e901d2 100644
--- a/tissue/tissue.scm
+++ b/tissue/tissue.scm
@@ -22,23 +22,26 @@
   #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:use-module (tissue git)
+  #:use-module (tissue web themes default)
   #:export (tissue-configuration
             tissue-configuration?
             tissue-configuration-project
             tissue-configuration-aliases
             tissue-configuration-indexed-documents
             tissue-configuration-web-css
+            tissue-configuration-web-search-renderer
             tissue-configuration-web-files
             gemtext-files-in-directory))
 
 (define-record-type <tissue-configuration>
   (make-tissue-configuration project aliases indexed-documents
-                             web-css web-files)
+                             web-css web-search-renderer web-files)
   tissue-configuration?
   (project delayed-tissue-configuration-project)
   (aliases delayed-tissue-configuration-aliases)
   (indexed-documents delayed-tissue-configuration-indexed-documents)
   (web-css delayed-tissue-configuration-web-css)
+  (web-search-renderer delayed-tissue-configuration-web-search-renderer)
   (web-files delayed-tissue-configuration-web-files))
 
 (define tissue-configuration-project
@@ -53,6 +56,9 @@
 (define tissue-configuration-web-css
   (compose force delayed-tissue-configuration-web-css))
 
+(define tissue-configuration-web-search-renderer
+  (compose force delayed-tissue-configuration-web-search-renderer))
+
 (define tissue-configuration-web-files
   (compose force delayed-tissue-configuration-web-files))
 
@@ -96,7 +102,10 @@ directory they are in."
                                      #`(delay #,arg)))
                                #'(args :::)))))))))))))
 
-(define-lazy (tissue-configuration #:key project (aliases '()) (indexed-documents '()) web-css (web-files '()))
+(define-lazy (tissue-configuration #:key project (aliases '()) (indexed-documents '())
+                                   web-css
+                                   (web-search-renderer render-sxml)
+                                   (web-files '()))
   "Construct a <tissue-configuration> object. All arguments are
 evaluated lazily.
 
@@ -115,6 +124,12 @@ documents to index.
 document root and must begin with a @code{\"/\"}. If it is @code{#f},
 no stylesheet is used in the generated web pages.
 
+@var{web-search-renderer} is a function that accepts two arguments---a
+@code{<search-page>} object describing the search page and a
+@code{<tissue-configuration>} object describing the project. It must
+return the rendered SXML.
+
 @var{web-files} is a list of @code{<file>} objects representing files to be
 written to the web output."
-   (make-tissue-configuration project aliases indexed-documents web-css web-files))
+   (make-tissue-configuration project aliases indexed-documents
+                              web-css web-search-renderer web-files))
diff --git a/tissue/web/server.scm b/tissue/web/server.scm
index e9665ec..cca67ae 100644
--- a/tissue/web/server.scm
+++ b/tissue/web/server.scm
@@ -25,6 +25,7 @@
   #:use-module (srfi srfi-171)
   #:use-module (ice-9 filesystem)
   #:use-module (ice-9 match)
+  #:use-module (oop goops)
   #:use-module (htmlprag)
   #:use-module (sxml simple)
   #:use-module ((system repl server) #:select (make-unix-domain-server-socket))
@@ -38,11 +39,11 @@
                                             (case symbol
                                               ((parse-query) 'xapian:parse-query)
                                               (else symbol))))
-  #:use-module (tissue document)
   #:use-module (tissue git)
   #:use-module (tissue search)
   #:use-module (tissue tissue)
   #:use-module (tissue utils)
+  #:use-module (tissue web themes)
   #:export (log-request
             mime-type-for-extension
             try-paths
@@ -50,155 +51,6 @@
             search-handler
             start-web-server))
 
-(define %css
-  "
-body {
-    max-width: 1000px;
-    margin: 0 auto;
-}
-
-form { text-align: center; }
-.search-filter {
-    background-color: gray;
-    color: white;
-    padding: 0 0.2em;
-}
-
-.search-results-statistics {
-    list-style: none;
-    padding: 0;
-}
-.search-results-statistics li {
-    display: inline;
-    margin: 0.5em;
-}
-.search-results-statistics a { color: blue; }
-.current-search-type { font-weight: bold; }
-
-.search-results { padding: 0; }
-.search-result {
-    list-style-type: none;
-    padding: 0.5em;
-}
-.search-result a { text-decoration: none; }
-.document-type {
-    font-variant: small-caps;
-    font-weight: bold;
-}
-.search-result-metadata {
-    color: dimgray;
-    font-size: smaller;
-}
-.search-result-snippet { font-size: smaller; }
-
-.tags {
-    list-style-type: none;
-    padding: 0;
-    display: inline;
-}
-.tag { display: inline; }
-.tag a {
-    padding: 0 0.2em;
-    color: white;
-    background-color: blue;
-    margin: auto 0.25em;
-    font-size: smaller;
-}
-.tag-bug a { background-color: red; }
-.tag-feature a { background-color: green; }
-.tag-progress a, .tag-unassigned a {
-    background-color: orange;
-    color: black;
-}
-.tag-chore a {
-    background-color: khaki;
-    color: black;
-}")
-
-(define* (make-search-page results query css
-                           #:key
-                           page-uri-path page-uri-parameters
-                           matches
-                           matched-open-issues matched-closed-issues
-                           matched-documents matched-commits
-                           current-search-type)
-  "Return SXML for a page with search RESULTS produced for QUERY.
-
-CSS is a URI to a stylesheet. PAGE-URI-PATH is the path part of the
-URI to the page. PAGE-URI-PARAMETERS is an association list of
-parameters in the query string of the URI of the page.
-
-MATCHES is the number of matches. MATCHED-OPEN-ISSUES,
-MATCHED-CLOSED-ISSUES, MATCHED-DOCUMENTS and MATCHED-COMMITS are
-respectively the number of open issues, closed issues, documents and
-commits matching the current query. CURRENT-SEARCH-TYPE is the type of
-document search results are being showed for."
-  `(html
-    (head
-     (title "Tissue search")
-     (style ,%css)
-     ,@(if css
-           (list `(link (@ (href "/style.css")
-                           (rel "stylesheet")
-                           (type "text/css"))))
-           (list)))
-    (body
-     (form (@ (action "/search") (method "GET"))
-           (input (@ (type "text")
-                     (name "query")
-                     (value ,query)
-                     (placeholder "Enter search query")))
-           (input (@ (type "hidden")
-                     (name "type")
-                     (value ,(symbol->string current-search-type))))
-           (input (@ (type "submit") (value "Search"))))
-     (details (@ (class "search-hint"))
-              (summary "Hint")
-              (p "Refine your search with filters "
-                 ,@(append-map (lambda (filter)
-                                 (list `(span (@ (class "search-filter"))
-                                              ,filter)
-                                       ", "))
-                               (list "type:issue"
-                                     "type:document"
-                                     "is:open"
-                                     "is:closed"
-                                     "title:git"
-                                     "creator:mani"
-                                     "lastupdater:vel"
-                                     "assigned:muthu"
-                                     "tag:feature-request"))
-                 "etc. Optionally, combine search terms with boolean
-operators "
-                 (span (@ (class "search-filter"))
-                       "AND")
-                 " and "
-                 (span (@ (class "search-filter"))
-                       "OR")
-                 ". See " (a (@ (href "https://xapian.org/docs/queryparser.html"))
-                             "Xapian::QueryParser Syntax")
-                 " for detailed documentation."))
-     ,(let ((search-result-statistic
-             (lambda (search-type format-string matches)
-               `(li (a (@ (href ,(string-append
-                                  page-uri-path
-                                  "?"
-                                  (query-string
-                                   (acons "type" (symbol->string search-type)
-                                          (alist-delete "type" page-uri-parameters)))))
-                          ,@(if (eq? search-type current-search-type)
-                                '((class "current-search-type"))
-                                '()))
-                       ,(format #f format-string matches))))))
-        `(ul (@ (class "search-results-statistics"))
-             ,(search-result-statistic 'all "~a All" matches)
-             ,(search-result-statistic 'open-issue "~a open issues" matched-open-issues)
-             ,(search-result-statistic 'closed-issue "~a closed issues" matched-closed-issues)
-             ,(search-result-statistic 'document "~a documents" matched-documents)
-             ,(search-result-statistic 'commit "~a commits" matched-commits)))
-     (ul (@ (class "search-results"))
-         ,@results))))
-
 (define (log-request request)
   "Log @var{request} to standard output."
   (format #t "~a ~a\n"
@@ -239,8 +91,7 @@ query. QUERY and FILTER are Xapian Query objects."
     #:maximum-items (database-document-count db))))
 
 (define (search-handler request body xapian-index project)
-  (let* ((path (uri-path (request-uri request)))
-         (parameters (query-parameters (uri-query (request-uri request))))
+  (let* ((parameters (query-parameters (uri-query (request-uri request))))
          (search-query (or (assoc-ref parameters "query")
                            ""))
          (search-type (match (assoc-ref parameters "type")
@@ -255,41 +106,31 @@ query. QUERY and FILTER are Xapian Query objects."
             (sxml->html
              (call-with-database xapian-index
                (lambda (db)
-                 (let* ((query (parse-query search-query))
-                        (mset (enquire-mset
-                               (let* ((query (new-Query (Query-OP-FILTER)
-                                                        query
-                                                        (or (assq-ref filter-alist search-type)
-                                                            (Query-MatchAll))))
-                                      (enquire (enquire db query)))
-                                 ;; Sort by recency date (slot
-                                 ;; 0) when query is strictly
-                                 ;; boolean.
-                                 (when (boolean-query? query)
-                                   (Enquire-set-sort-by-value enquire 0 #t))
-                                 enquire)
-                               #:offset 0
-                               #:maximum-items (database-document-count db))))
-                   (make-search-page
-                    (reverse
-                     (mset-fold (lambda (item result)
-                                  (cons (document->sxml
-                                         (call-with-input-string (document-data (mset-item-document item))
-                                           (compose scm->object read))
-                                         mset)
-                                        result))
-                                '()
-                                mset))
-                    search-query
-                    (tissue-configuration-web-css project)
-                    #:page-uri-path path
-                    #:page-uri-parameters parameters
-                    #:matches (matches db query (Query-MatchAll))
-                    #: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))
-                    #:current-search-type search-type))))))))
+                 ((tissue-configuration-web-search-renderer project)
+                  (let ((query (parse-query search-query)))
+                    (make <search-page>
+                      #:uri (request-uri request)
+                      #:query search-query
+                      #:type search-type
+                      #:mset (enquire-mset
+                              (let* ((query (new-Query (Query-OP-FILTER)
+                                                       query
+                                                       (or (assq-ref filter-alist search-type)
+                                                           (Query-MatchAll))))
+                                     (enquire (enquire db query)))
+                                ;; Sort by recency date (slot 0) when
+                                ;; query is strictly boolean.
+                                (when (boolean-query? query)
+                                  (Enquire-set-sort-by-value enquire 0 #t))
+                                enquire)
+                              #:offset 0
+                              #:maximum-items (database-document-count db))
+                      #:matches (matches db query (Query-MatchAll))
+                      #: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)))))))
 
 (define (try-paths path)
   "Return a list of candidate paths to look for @var{path}."
diff --git a/tissue/web/themes.scm b/tissue/web/themes.scm
new file mode 100644
index 0000000..f1a107c
--- /dev/null
+++ b/tissue/web/themes.scm
@@ -0,0 +1,41 @@
+;;; tissue --- Text based issue tracker
+;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This file is part of tissue.
+;;;
+;;; tissue is free software: you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; tissue is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with tissue.  If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (tissue web themes)
+  #:use-module (oop goops)
+  #:export (<search-page>
+            search-page-uri
+            search-page-query
+            search-page-type
+            search-page-mset
+            search-page-matches
+            search-page-matched-open-issues
+            search-page-matched-closed-issues
+            search-page-matched-documents
+            search-page-matched-commits))
+
+(define-class <search-page> ()
+  (uri #:getter search-page-uri #:init-keyword #:uri)
+  (query #:getter search-page-query #:init-keyword #:query)
+  (type #:getter search-page-type #:init-keyword #:type)
+  (mset #:getter search-page-mset #:init-keyword #:mset)
+  (matches #:getter search-page-matches #:init-keyword #:matches)
+  (matched-open-issues #:getter search-page-matched-open-issues #:init-keyword #:matched-open-issues)
+  (matched-closed-issues #:getter search-page-matched-closed-issues #:init-keyword #:matched-closed-issues)
+  (matched-documents #:getter search-page-matched-documents #:init-keyword #:matched-documents)
+  (matched-commits #:getter search-page-matched-commits #:init-keyword #:matched-commits))
diff --git a/tissue/web/themes/default.scm b/tissue/web/themes/default.scm
new file mode 100644
index 0000000..2dc8872
--- /dev/null
+++ b/tissue/web/themes/default.scm
@@ -0,0 +1,330 @@
+;;; tissue --- Text based issue tracker
+;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This file is part of tissue.
+;;;
+;;; tissue is free software: you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; tissue is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with tissue.  If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (tissue web themes default)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
+  #:use-module (oop goops)
+  #:use-module (web uri)
+  #:use-module (xapian xapian)
+  #:use-module (tissue commit)
+  #: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
+            <search-page-head>
+            <search-page-header>
+            <search-page-form>
+            <search-page-result>
+            <search-page-footer>))
+
+(define-class <search-page-head> ())
+(define-class <search-page-header> ())
+(define-class <search-page-form> ())
+(define-class <search-page-result> ())
+(define-class <search-page-footer> ())
+
+(define %css
+  "
+body {
+    max-width: 1000px;
+    margin: 0 auto;
+}
+
+form { text-align: center; }
+.search-filter {
+    background-color: gray;
+    color: white;
+    padding: 0 0.2em;
+}
+
+.search-results-statistics {
+    list-style: none;
+    padding: 0;
+}
+.search-results-statistics li {
+    display: inline;
+    margin: 0.5em;
+}
+.search-results-statistics a { color: blue; }
+.current-search-type { font-weight: bold; }
+
+.search-results { padding: 0; }
+.search-result {
+    list-style-type: none;
+    padding: 0.5em;
+}
+.search-result a { text-decoration: none; }
+.document-type {
+    font-variant: small-caps;
+    font-weight: bold;
+}
+.search-result-metadata {
+    color: dimgray;
+    font-size: smaller;
+}
+.search-result-snippet { font-size: smaller; }
+
+.tags {
+    list-style-type: none;
+    padding: 0;
+    display: inline;
+}
+.tag { display: inline; }
+.tag a {
+    padding: 0 0.2em;
+    color: white;
+    background-color: blue;
+    margin: auto 0.25em;
+    font-size: smaller;
+}
+.tag-bug a { background-color: red; }
+.tag-feature a { background-color: green; }
+.tag-progress a, .tag-unassigned a {
+    background-color: orange;
+    color: black;
+}
+.tag-chore a {
+    background-color: khaki;
+    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."
+  `(html
+    ,(render-sxml (make <search-page-head>) page project)
+    (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))))
+
+(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
+            (list `(link (@ (href ,css)
+                            (rel "stylesheet")
+                            (type "text/css"))))
+            (list)))))
+
+(define-method (render-sxml (header <search-page-header>) (page <search-page>) project)
+  `(div))
+
+(define-method (render-sxml (form <search-page-form>) (page <search-page>) project)
+  `(div
+    (form (@ (action "/search") (method "GET"))
+          (input (@ (type "text")
+                    (name "query")
+                    (value ,(search-page-query page))
+                    (placeholder "Enter search query")))
+          (input (@ (type "hidden")
+                    (name "type")
+                    (value ,(symbol->string (search-page-type page)))))
+          (input (@ (type "submit") (value "Search"))))
+    (details (@ (class "search-hint"))
+             (summary "Hint")
+             (p "Refine your search with filters "
+                ,@(append-map (lambda (filter)
+                                (list `(span (@ (class "search-filter"))
+                                             ,filter)
+                                      ", "))
+                              (list "type:issue"
+                                    "type:document"
+                                    "is:open"
+                                    "is:closed"
+                                    "title:git"
+                                    "creator:mani"
+                                    "lastupdater:vel"
+                                    "assigned:muthu"
+                                    "tag:feature-request"))
+                "etc. Optionally, combine search terms with boolean operators "
+                (span (@ (class "search-filter"))
+                      "AND")
+                " and "
+                (span (@ (class "search-filter"))
+                      "OR")
+                ". See " (a (@ (href "https://xapian.org/docs/queryparser.html"))
+                            "Xapian::QueryParser Syntax")
+                " for detailed documentation."))))
+
+(define-method (render-sxml (result <search-page-result>) (page <search-page>) project)
+  (define (search-result-statistic search-type format-string matches)
+    `(li (a (@ (href ,(string-append
+                       (uri-path (search-page-uri page))
+                       "?"
+                       (query-string
+                        (acons "type" (symbol->string search-type)
+                               (alist-delete "type"
+                                             (query-parameters
+                                              (uri-query (search-page-uri page))))))))
+               ,@(if (eq? search-type (search-page-type page))
+                     '((class "current-search-type"))
+                     '()))
+            ,(format #f format-string matches))))
+  
+  `(div
+    (ul (@ (class "search-results-statistics"))
+        ,(search-result-statistic 'all "~a All" (search-page-matches page))
+        ,(search-result-statistic 'open-issue "~a open issues" (search-page-matched-open-issues page))
+        ,(search-result-statistic 'closed-issue "~a closed issues" (search-page-matched-closed-issues page))
+        ,(search-result-statistic 'document "~a documents" (search-page-matched-documents page))
+        ,(search-result-statistic 'commit "~a commits" (search-page-matched-commits page)))
+    (ul (@ (class "search-results"))
+        ,@(reverse
+           (mset-fold (lambda (item result)
+                        (cons (render-sxml
+                               (call-with-input-string (document-data (mset-item-document item))
+                                 (compose scm->object read))
+                               page project)
+                              result))
+                      '()
+                      (search-page-mset page))))))
+
+(define-method (render-sxml (document <file-document>) (page <search-page>) project)
+  `(li (@ (class "search-result search-result-document"))
+       (a (@ (href ,(document-web-uri document))
+             (class "search-result-title"))
+          ,(document-title document))
+       (div (@ (class "search-result-metadata"))
+            (span (@ (class ,(string-append "document-type file-document-type")))
+                  "document")
+            ,(string-append
+              (format #f " created ~a by ~a"
+                      (human-date-string (file-document-created-date document))
+                      (file-document-creator document))
+              (if (> (length (file-document-commits document))
+                     1)
+                  (format #f ", last updated ~a by ~a"
+                          (human-date-string (file-document-last-updated-date document))
+                          (file-document-last-updater document))
+                  "")))
+       ,@(let ((snippet (document-sxml-snippet document (search-page-mset page))))
+           (if snippet
+               (list `(div (@ (class "search-result-snippet"))
+                           ,@snippet))
+               (list)))))
+
+(define (sanitize-string str)
+  "Downcase STR and replace spaces with hyphens."
+  (string-map (lambda (c)
+                (case c
+                  ((#\space) #\-)
+                  (else c)))
+              (string-downcase str)))
+
+(define-method (render-sxml (issue <issue>) (page <search-page>) project)
+  `(li (@ (class ,(string-append "search-result search-result-issue "
+                                 (if (issue-open? issue)
+                                     "search-result-open-issue"
+                                     "search-result-closed-issue"))))
+       (a (@ (href ,(document-web-uri issue))
+             (class "search-result-title"))
+          ,(document-title issue))
+       (ul (@ (class "tags"))
+           ,@(map (lambda (tag)
+                    (let ((words (string-split tag (char-set #\- #\space))))
+                      `(li (@ (class
+                                ,(string-append "tag"
+                                                (string-append " tag-" (sanitize-string tag))
+                                                (if (not (null? (lset-intersection
+                                                                 string=? words
+                                                                 (list "bug" "critical"))))
+                                                    " tag-bug"
+                                                    "")
+                                                (if (not (null? (lset-intersection
+                                                                 string=? words
+                                                                 (list "progress"))))
+                                                    " tag-progress"
+                                                    "")
+                                                (if (not (null? (lset-intersection
+                                                                 string=? words
+                                                                 (list "chore"))))
+                                                    " tag-chore"
+                                                    "")
+                                                (if (not (null? (lset-intersection
+                                                                 string=? words
+                                                                 (list "enhancement" "feature"))))
+                                                    " tag-feature"
+                                                    ""))))
+                           (a (@ (href ,(string-append
+                                         "/search?query="
+                                         (uri-encode
+                                          ;; Quote tag if it has spaces.
+                                          (string-append "tag:"
+                                                         (if (string-any #\space tag)
+                                                             (string-append "\"" tag "\"")
+                                                             tag))))))
+                              ,tag))))
+                  (issue-keywords issue)))
+       (div (@ (class "search-result-metadata"))
+            (span (@ (class ,(string-append "document-type issue-document-type "
+                                            (if (issue-open? issue)
+                                                "open-issue-document-type"
+                                                "closed-issue-document-type"))))
+                  ,(if (issue-open? issue)
+                       "issue"
+                       "✓ issue"))
+            ,(string-append
+              (format #f " opened ~a by ~a"
+                      (human-date-string (file-document-created-date issue))
+                      (file-document-creator issue))
+              (if (> (length (file-document-commits issue))
+                     1)
+                  (format #f ", last updated ~a by ~a"
+                          (human-date-string (file-document-last-updated-date issue))
+                          (file-document-last-updater issue))
+                  "")
+              (if (zero? (issue-tasks issue))
+                  ""
+                  (format #f "; ~a of ~a tasks done"
+                          (issue-completed-tasks issue)
+                          (issue-tasks issue)))))
+       ,@(let ((snippet (document-sxml-snippet issue (search-page-mset page))))
+           (if snippet
+               (list `(div (@ (class "search-result-snippet"))
+                           ,@snippet))
+               (list)))))
+
+(define-method (render-sxml (commit <commit>) (page <search-page>) project)
+  `(li (@ (class ,(string-append "search-result search-result-commit")))
+       (a (@ (href ,(document-web-uri commit))
+             (class "search-result-title"))
+          ,(document-title commit))
+       (div (@ (class "search-result-metadata"))
+            (span (@ (class ,(string-append "document-type commit-document-type")))
+                  "commit")
+            ,(string-append
+              (format #f " authored ~a by ~a"
+                      (human-date-string (doc:commit-author-date commit))
+                      (doc:commit-author commit))))
+       ,@(let ((snippet (document-sxml-snippet commit (search-page-mset page))))
+           (if snippet
+               (list `(div (@ (class "search-result-snippet"))
+                           ,@snippet))
+               (list)))))
+
+(define-method (render-sxml (footer <search-page-footer>) (page <search-page>) project)
+  `(div))