diff --git a/tekuti/page-helpers.scm b/tekuti/page-helpers.scm index b82f0ad..3b73922 100644 --- a/tekuti/page-helpers.scm +++ b/tekuti/page-helpers.scm @@ -183,41 +183,44 @@ (define (admin-post-redirect request post) (redirect request (admin-post-url post))) -;; fixme: borks in the no-tags case; ugly code -(define (tag-cloud index) +(define (top-tags index n) + (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) 20) - car string>")) - ,(tag-cloud index))))) + (ul (li (@ (style "line-height: 150%")) + ,@(tag-cloud (top-tags index 30)))))))) (define (with-authentication request thunk) (if (request-authenticated? request) diff --git a/tekuti/util.scm b/tekuti/util.scm index dcef7a2..7130a83 100644 --- a/tekuti/util.scm +++ b/tekuti/util.scm @@ -44,8 +44,9 @@ x #f)) +;; hacky #fragment interpreting... (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 #f))