aliens/tekuti
1
0
Fork 0
Code Activity

add "related posts" foo

Browse source 
* tekuti/page-helpers.scm (post-sidebar): New function, pops up a sidebar
  for related posts.

* tekuti/page.scm (page-show-post): Show the post sidebar.

* tekuti/tags.scm (compute-related-posts): New function, computes the set
  of related posts based on the number of tags which they share in
  common.
This commit is contained in:
Andy Wingo 2008-04-11 12:59:47 +02:00
parent 062e0f109a
commit df96b1f07e
3 changed files with 41 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
tekuti/page-helpers.scm
View file

@ -29,6 +29,7 @@
#:use-module (tekuti util) #:use-module (tekuti util)
#:use-module (tekuti git) #:use-module (tekuti git)
#:use-module (tekuti post) #:use-module (tekuti post)
#:use-module (tekuti tags)
#:use-module (tekuti comment) #:use-module (tekuti comment)
#:use-module (tekuti url) #:use-module (tekuti url)
#:use-module (tekuti request) #:use-module (tekuti request)
@ -37,7 +38,7 @@
#:export (relurl rellink redirect post-url #:export (relurl rellink redirect post-url
published-posts published-posts
post-editing-form post-editing-form
sidebar-ul main-sidebar tag-cloud sidebar-ul main-sidebar tag-cloud post-sidebar
post-link admin-post-link admin-post-redirect post-link admin-post-link admin-post-redirect
show-post with-authentication show-post with-authentication
atom-header atom-entry)) atom-header atom-entry))
@ -222,6 +223,19 @@
(ul (li (@ (style "line-height: 150%")) (ul (li (@ (style "line-height: 150%"))
,@(tag-cloud (top-tags index 30)))))))) ,@(tag-cloud (top-tags index 30))))))))
(define (post-sidebar post index)
(sidebar-ul
`((li (h2 (a (@ (href ,(relurl "feed/atom")))
"subscribe "
(img (@ (src ,(relurl "wp-content/feed-icon-14x14.png"))
(alt "[feed]")))
)))
(li (h2 "related")
(ul ,@(map (lambda (post-and-tags)
`(li (@ (style "margin-top: 5px"))
,(post-link (car post-and-tags))))
(take-max (compute-related-posts post index) 10)))))))
(define (with-authentication request thunk) (define (with-authentication request thunk)
(if (request-authenticated? request) (if (request-authenticated? request)
(thunk) (thunk)

4
tekuti/page.scm
View file

@ -52,7 +52,6 @@
page-show-tag page-show-tag
page-debug page-debug
page-search page-search
page-show-post
page-feed-atom page-feed-atom
page-debug page-debug
page-not-found)) page-not-found))
@ -185,7 +184,8 @@
=> (lambda (post) => (lambda (post)
(rcons* request (rcons* request
'title (string-append (post-title post) " -- " *title*) 'title (string-append (post-title post) " -- " *title*)
'body (show-post post #t)))) 'body `(,(post-sidebar post index)
,(show-post post #t)))))
(else (else
(page-not-found request index)))) (page-not-found request index))))

25
tekuti/tags.scm
View file

@ -31,7 +31,7 @@
#:use-module (tekuti post) #:use-module (tekuti post)
#:use-module (tekuti git) #:use-module (tekuti git)
#:use-module ((srfi srfi-1) #:select (filter)) #:use-module ((srfi srfi-1) #:select (filter))
#:export (tag-link reindex-tags)) #:export (tag-link compute-related-posts reindex-tags))
(define (tag-link tagname) (define (tag-link tagname)
`(a (@ (href ,(string-append *public-url-base* "tags/" `(a (@ (href ,(string-append *public-url-base* "tags/"
@ -49,5 +49,28 @@
posts) posts)
hash)) hash))
(define (compute-related-posts post index)
(let ((hash (assq-ref index 'tags))
(master (assq-ref index 'master)))
(if hash
(let ((accum (make-hash-table)))
(for-each
(lambda (tag)
(for-each
(lambda (key)
(if (not (equal? key (post-key post)))
(hash-push! accum key tag)))
(or (hash-ref hash tag) '())))
(post-tags post))
(dsu-sort (dsu-sort
(hash-fold
(lambda (key tags rest)
(acons (post-from-key master key) tags rest))
'() accum)
(lambda (x) (post-timestamp (car x)))
>)
length >))
'())))
(define (reindex-tags old-index index) (define (reindex-tags old-index index)
(compute-tags (filter post-published? (assq-ref index 'posts)))) (compute-tags (filter post-published? (assq-ref index 'posts))))