From 88c136e775857558d3bc64c7ed90ab6cea62308a Mon Sep 17 00:00:00 2001
From: Andy Wingo
Date: Sat, 12 Apr 2008 19:15:55 +0200
Subject: add search capabilities

* tekuti/page-helpers.scm (main-sidebar): Add search box.
  (find-posts-matching): New function, does a search using git-grep.

* tekuti/page.scm (page-search): New page for showing search results.

* tekuti/util.scm (match-lines): Capture the match-bind binding.

* tekuti/web.scm (choose-handler): Add the search page.

---
 tekuti/page-helpers.scm | 17 +++++++++++++++++
 tekuti/page.scm         | 11 +++++++++++
 tekuti/util.scm         |  6 +++---
 tekuti/web.scm          |  1 +
 4 files changed, 32 insertions(+), 3 deletions(-)

diff --git a/tekuti/page-helpers.scm b/tekuti/page-helpers.scm
index fdafae7..1873a07 100644
--- a/tekuti/page-helpers.scm
+++ b/tekuti/page-helpers.scm
@@ -42,6 +42,7 @@
             main-sidebar post-sidebar related-tag-cloud
             post-link admin-post-link admin-post-redirect
             show-post with-authentication
+            find-posts-matching
             atom-header atom-entry))
 
 (define (relurl . paths)
@@ -220,6 +221,11 @@
                 (img (@ (src ,(relurl "wp-content/feed-icon-14x14.png"))
                         (alt "[feed]")))
                 )))
+     (li (h2 "search")
+         (form (@ (method "POST")
+                  (action ,(relurl "search")))
+               (input (@ (name "string") (type "text") (size "15")
+                         (value "")))))
      (li (h2 "tags " ,(rellink "tags/" ">>"))
          (ul (li (@ (style "line-height: 150%"))
                  ,@(tag-cloud (top-tags index 30))))))))
@@ -242,6 +248,17 @@
         (h2 "related tags")
         ,@(tag-cloud (compute-related-tags tag index))))
 
+(define (find-posts-matching string index)
+  (let ((master (assq-ref index 'master)))
+    (dsu-sort
+     (filter
+      identity
+      (match-lines (git "grep" "-l" "-F" string master "--" "*/content")
+                   ":(.+)/content$" (_ key)
+                   (post-from-key master key)))
+     post-timestamp
+     >)))
+
 (define (with-authentication request thunk)
   (if (request-authenticated? request)
       (thunk)
diff --git a/tekuti/page.scm b/tekuti/page.scm
index d5fd439..bcb837b 100644
--- a/tekuti/page.scm
+++ b/tekuti/page.scm
@@ -250,6 +250,17 @@
                    (lp (cdr posts) new-header (cons `(p ,(post-link (car posts))) out))))))
               (else (lp (cdr posts))))))))
 
+(define (page-search request index)
+  (let* ((string (or (assoc-ref (request-form-data request) "string") ""))
+         (posts (find-posts-matching string index)))
+    (rcons* request
+            'body `((h2 "search results: \"" ,string "\"")
+                    ,@(if (null? posts)
+                          `((p "No posts matched your search string."))
+                          (map (lambda (post)
+                                 `(p ,(post-link post)))
+                               posts))))))
+
 (define (page-show-tags request index)
   (rcons* request
           'title (string-append "all tags -- " *title*)
diff --git a/tekuti/util.scm b/tekuti/util.scm
index 7130a83..7d4efdf 100644
--- a/tekuti/util.scm
+++ b/tekuti/util.scm
@@ -92,9 +92,9 @@
   (let ((line (gensym)) (seed (gensym)))
     `(,fold
       (lambda (,line ,seed)
-        (match-bind ,pattern ,line ,bindings
-                    (cons ,expr ,seed)
-                    ,seed))
+        (,match-bind ,pattern ,line ,bindings
+                     (cons ,expr ,seed)
+                     ,seed))
       '() (string-split ,string #\newline))))
 
 ;; clause := ((pat args) body...)
diff --git a/tekuti/web.scm b/tekuti/web.scm
index d181145..6b5eb89 100644
--- a/tekuti/web.scm
+++ b/tekuti/web.scm
@@ -103,6 +103,7 @@
    ((POST archives year! month! day! post!) page-new-comment)
    ((GET feed) page-feed-atom)
    ((GET feed atom) page-feed-atom)
+   ((POST search) page-search)
    ((GET tags) page-show-tags)
    ((GET tags tag!) page-show-tag)
    ((GET debug) page-debug)
-- 
cgit v1.2.3-54-g00ecf