aliens/tekuti
1
0
Fork 0
Code Activity

tweak tag cloud code

Browse source 
* tekuti/page-helpers.scm (top-tags, tag-cloud, main-sidebar): Make the
  tag cloud code a bit more modular. Up the number of tags shown to 30.

* tekuti/util.scm: Allow # in the path part of a URL. Yick.
This commit is contained in:
Andy Wingo 2008-04-11 12:05:24 +02:00
parent 11eed1fbc8
commit 062e0f109a
2 changed files with 28 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
tekuti/page-helpers.scm
View file

@ -183,41 +183,44 @@
(define (admin-post-redirect request post) (define (admin-post-redirect request post)
(redirect request (admin-post-url post))) (redirect request (admin-post-url post)))
;; fixme: borks in the no-tags case; ugly code (define (top-tags index n)
(define (tag-cloud index) (let ((hash (assq-ref index 'tags)))
(if hash
(dsu-sort
(take-max
(dsu-sort
(hash-fold (lambda (k v seed) (acons k (length v) seed))
'() hash)
cdr >) n)
car string<?)
'())))
(define (tag-cloud tags)
(define (determine-sizes counts) (define (determine-sizes counts)
(let ((maxcount (apply max counts))) (let ((maxcount (if (null? counts) '() (apply max counts))))
(map (lambda (x) (map (lambda (x)
(floor (+ 80 (* 120 (/ x maxcount))))) (floor (+ 80 (* 120 (/ x maxcount)))))
counts))) counts)))
(let* ((hash (assq-ref index 'tags)) (list-intersperse
(cats (if hash
(hash-fold (lambda (k v seed) (acons k (length v) seed))
'() hash)
'()))
(top-20 (dsu-sort (take-max (dsu-sort cats cdr >) 20)
car string<?)))
`(ul (li (@ (style "line-height: 150%"))
,@(list-intersperse
(map (lambda (name size) (map (lambda (name size)
`(a (@ (href ,(relurl "tags/" (url:encode name))) `(a (@ (href ,(relurl "tags/" (url:encode name)))
(rel "tag") (rel "tag")
(style ,(format #f "font-size: ~d%" size))) (style ,(format #f "font-size: ~d%" size)))
,name)) ,name))
(map car top-20) (map car tags)
(determine-sizes (map cdr top-20))) (determine-sizes (map cdr tags)))
" ")) " "))
)))
(define (main-sidebar request index) (define (main-sidebar request index)
(sidebar-ul (sidebar-ul
`((li (h2 (a (@ (href ,(relurl "feed/atom"))) `((li (h2 (a (@ (href ,(relurl "feed/atom")))
"subscribe " "subscribe "
(img (@ (src ,(relurl "wp-content/feed-icon-14x14.png")) (img (@ (src ,(relurl "wp-content/feed-icon-14x14.png"))
(alt "subscribe to this feed"))) (alt "[feed]")))
))) )))
(li (h2 "tags " ,(rellink "tags/" ">>")) (li (h2 "tags " ,(rellink "tags/" ">>"))
,(tag-cloud index))))) (ul (li (@ (style "line-height: 150%"))
,@(tag-cloud (top-tags index 30))))))))
(define (with-authentication request thunk) (define (with-authentication request thunk)
(if (request-authenticated? request) (if (request-authenticated? request)

3
tekuti/util.scm
View file

@ -44,8 +44,9 @@
x x
#f)) #f))
;; hacky #fragment interpreting...
(define (urlish? x) (define (urlish? x)
(match-bind "^https?://([a-zA-Z0-9-]+\\.)+[a-zA-Z]+(/[a-zA-Z0-9$_.+!*'(),;/?:@&=-]*)?$" (match-bind "^https?://([a-zA-Z0-9-]+\\.)+[a-zA-Z]+(/[a-zA-Z0-9$_.+!*'(),;/?:#@&=-]*)?$"
x (_ . args) x (_ . args)
x x
#f)) #f))