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.

1 files changed, 0 insertions, 83 deletions

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