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
|
main-sidebar post-sidebar related-tag-cloud
|
||||||
post-link admin-post-link admin-post-redirect
|
post-link admin-post-link admin-post-redirect
|
||||||
show-post with-authentication
|
show-post with-authentication
|
||||||
|
find-posts-matching
|
||||||
atom-header atom-entry))
|
atom-header atom-entry))
|
||||||
|
|
||||||
(define (relurl . paths)
|
(define (relurl . paths)
|
||||||
|
@ -220,6 +221,11 @@
|
||||||
(img (@ (src ,(relurl "wp-content/feed-icon-14x14.png"))
|
(img (@ (src ,(relurl "wp-content/feed-icon-14x14.png"))
|
||||||
(alt "[feed]")))
|
(alt "[feed]")))
|
||||||
)))
|
)))
|
||||||
|
(li (h2 "search")
|
||||||
|
(form (@ (method "POST")
|
||||||
|
(action ,(relurl "search")))
|
||||||
|
(input (@ (name "string") (type "text") (size "15")
|
||||||
|
(value "")))))
|
||||||
(li (h2 "tags " ,(rellink "tags/" ">>"))
|
(li (h2 "tags " ,(rellink "tags/" ">>"))
|
||||||
(ul (li (@ (style "line-height: 150%"))
|
(ul (li (@ (style "line-height: 150%"))
|
||||||
,@(tag-cloud (top-tags index 30))))))))
|
,@(tag-cloud (top-tags index 30))))))))
|
||||||
|
@ -242,6 +248,17 @@
|
||||||
(h2 "related tags")
|
(h2 "related tags")
|
||||||
,@(tag-cloud (compute-related-tags tag index))))
|
,@(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)
|
(define (with-authentication request thunk)
|
||||||
(if (request-authenticated? request)
|
(if (request-authenticated? request)
|
||||||
(thunk)
|
(thunk)
|
||||||
|
|
|
@ -250,6 +250,17 @@
|
||||||
(lp (cdr posts) new-header (cons `(p ,(post-link (car posts))) out))))))
|
(lp (cdr posts) new-header (cons `(p ,(post-link (car posts))) out))))))
|
||||||
(else (lp (cdr posts))))))))
|
(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)
|
(define (page-show-tags request index)
|
||||||
(rcons* request
|
(rcons* request
|
||||||
'title (string-append "all tags -- " *title*)
|
'title (string-append "all tags -- " *title*)
|
||||||
|
|
|
@ -92,7 +92,7 @@
|
||||||
(let ((line (gensym)) (seed (gensym)))
|
(let ((line (gensym)) (seed (gensym)))
|
||||||
`(,fold
|
`(,fold
|
||||||
(lambda (,line ,seed)
|
(lambda (,line ,seed)
|
||||||
(match-bind ,pattern ,line ,bindings
|
(,match-bind ,pattern ,line ,bindings
|
||||||
(cons ,expr ,seed)
|
(cons ,expr ,seed)
|
||||||
,seed))
|
,seed))
|
||||||
'() (string-split ,string #\newline))))
|
'() (string-split ,string #\newline))))
|
||||||
|
|
|
@ -103,6 +103,7 @@
|
||||||
((POST archives year! month! day! post!) page-new-comment)
|
((POST archives year! month! day! post!) page-new-comment)
|
||||||
((GET feed) page-feed-atom)
|
((GET feed) page-feed-atom)
|
||||||
((GET feed atom) page-feed-atom)
|
((GET feed atom) page-feed-atom)
|
||||||
|
((POST search) page-search)
|
||||||
((GET tags) page-show-tags)
|
((GET tags) page-show-tags)
|
||||||
((GET tags tag!) page-show-tag)
|
((GET tags tag!) page-show-tag)
|
||||||
((GET debug) page-debug)
|
((GET debug) page-debug)
|
||||||
|
|
Loading…
Reference in a new issue