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.
This commit is contained in:
parent
cbfce24dc1
commit
88c136e775
4 changed files with 32 additions and 3 deletions
|
@ -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)
|
||||
|
|
|
@ -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*)
|
||||
|
|
|
@ -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...)
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in a new issue