diff --git a/tekuti/comment.scm b/tekuti/comment.scm index 60d9a2c..b72f6c6 100644 --- a/tekuti/comment.scm +++ b/tekuti/comment.scm @@ -20,7 +20,7 @@ ;;; Commentary: ;; -;; This is the main script that will launch tekuti. +;; Comments -- pulling them out of the database, and making new ones. ;; ;;; Code: @@ -63,11 +63,21 @@ (assq-ref comment 'raw-content)) (define (comment-sxml-content comment) - (let ((format (or (assq-ref comment 'format) 'wordpress))) - ((case format - ((wordpress) wordpress->sxml) - (else (lambda (text) `(pre ,text)))) - (comment-raw-content comment)))) + `(li (@ (class "alt") (id ,(assq-ref comment 'key))) + (cite ,(let ((url (assq-ref comment 'author_url)) + (name (assq-ref comment 'author))) + (if (and url (not (string-null? url))) + `(a (@ (href ,url) (rel "external nofollow")) ,name) + name))) + " says:" (br) + (small (@ (class "commentmetadata")) + (a (@ (href ,(string-append "#" (assq-ref comment 'key)))) + ,(comment-readable-date comment))) + ,(let ((format (or (assq-ref comment 'format) 'wordpress))) + ((case format + ((wordpress) wordpress->sxml) + (else (lambda (text) `(pre ,text)))) + (comment-raw-content comment))))) (define (comment-timestamp comment-alist) (or (assq-ref comment-alist 'timestamp) #f)) diff --git a/tekuti/page-helpers.scm b/tekuti/page-helpers.scm index 57cabec..aee43ac 100644 --- a/tekuti/page-helpers.scm +++ b/tekuti/page-helpers.scm @@ -42,8 +42,8 @@ show-post atom-header atom-entry)) -(define (relurl path) - (string-append *public-url-base* path)) +(define (relurl . paths) + (apply string-append *public-url-base* paths)) (define (rellink path . body) `(a (@ (href ,(relurl path))) @@ -59,7 +59,7 @@ `(form (@ (method "POST") (action ,(relurl (if post (string-append "admin/modify-post/" - (url:encode (assq-ref post 'key))) + (url:encode (post-key post))) "admin/new-post")))) (p "title: " (input (@ (name "title") (type "text") @@ -75,13 +75,58 @@ ;; double-encoding is a hack to trick apache (define (admin-post-link post) - (rellink (string-append "admin/posts/" - (url:encode (post-key post))) - (assq-ref post 'title))) + (rellink (string-append "admin/posts/" (url:encode (post-key post))) + (post-title 'title))) -(define (post-link post) - (rellink (string-append "archives/" (url:decode (post-key post))) - (assq-ref post 'title))) +(define (post-url post . tail) + (apply relurl "archives/" (url:decode (post-key post)) tail)) + +(define (post-link post . tail) + `(a (@ (href ,(apply post-url post tail))) ,(post-title post))) + +(define (comment-form post author email url comment) + `(form + (@ (action ,(post-url post)) (method "POST")) + (p (input (@ (type "text") (name "author") (value ,author) + (size "22") (tabindex "1"))) + " " (label (@ (for "author")) (small "Name"))) + (p (input (@ (type "text") (name "email") (value ,email) + (size "22") (tabindex "2"))) + " " (label (@ (for "email")) (small "Mail (will not be published)"))) + (p (input (@ (type "text") (name "url") (value ,url) + (size "22") (tabindex "3"))) + " " (label (@ (for "url")) (small "Website"))) + ;(p (small "allowed tags: ")) + (p (textarea (@ (name "comment") (id "comment") (cols "65") + (rows "10") (tabindex "4")) + ,comment)) + (p (input (@ (name "submit") (type "submit") (id "submit") (tabindex "5") + (value "Submit Comment")))))) + +(define (post-sxml-comments post) + (let ((comments (post-comments post)) + (comments-open? (post-comments-open? post))) + (define (n-comments-header) + (and (or (not (null? comments)) comments-open?) + `(h3 (@ (id "comments")) + ,(let ((len (length comments))) + (case len + ((0) "No responses") + ((1) "One response") + (else (format #f "~d responses" len))))))) + `(div + ,@(or (and=> (n-comments-header) list) '()) + ,@(let ((l (map comment-sxml-content comments))) + (if (null? l) l + `((ol (@ (class "commentlist")) ,@l)))) + ,(if (not comments-open?) + `(p (@ (id "nocomments")) "Comments are closed.") + `(div (h3 "Leave a Reply") + ,(comment-form post "" "" "" "")))))) + +(define (tag-link tagname) + (rellink (string-append "tags/" (url:encode tagname)) + tagname)) (define (show-post post comments?) `((h2 (@ (class "storytitle")) @@ -89,18 +134,22 @@ (div (@ (class "post")) (h3 (@ (class "meta")) ,(post-readable-date post) - " (" ,@(list-intersperse (post-tag-links post) - " | ") + " (" ,@(list-intersperse + (map tag-link (post-tags post)) + " | ") ")") (div (@ (class "storycontent")) ,(post-sxml-content post)) - ,@(if comments? '() - (list (post-sxml-n-comments post)))) + ,@(if comments? + '() + `((div (@ (class "feedback")) + (a (@ (href ,(post-url post "#comments"))) + "(" ,(post-n-comments post) ")"))))) ,@(if comments? (list (post-sxml-comments post)) '()))) -;; fixme: borks in the no-tags case +;; fixme: borks in the no-tags case; ugly code (define (tag-cloud index) (define (determine-sizes counts) (let ((maxcount (apply max counts))) @@ -117,9 +166,7 @@ `(ul (li (@ (style "line-height: 150%")) ,@(list-intersperse (map (lambda (name size) - `(a (@ (href ,(string-append - *public-url-base* "tags/" - (url:encode name))) + `(a (@ (href ,(relurl "tags/" (url:encode name))) (rel "tag") (style ,(format #f "font-size: ~d%" size))) ,name)) @@ -135,9 +182,7 @@ (img (@ (src ,(relurl "wp-content/feed-icon-14x14.png")) (alt "subscribe to this feed"))) ))) - (li (h2 "tags " - (a (@ (href ,(string-append *public-url-base* "tags/"))) - ">>")) + (li (h2 "tags " ,(rellink "tags/" ">>")) ,(tag-cloud index))))) (define (atom-header server-name last-modified) diff --git a/tekuti/page.scm b/tekuti/page.scm index cc6456b..394ed30 100644 --- a/tekuti/page.scm +++ b/tekuti/page.scm @@ -233,7 +233,7 @@ (define (page-feed-atom request index) (let ((last-modified (let ((posts (published-posts index 1))) (and (pair? posts) - (assq-ref (car posts) 'timestamp)))) + (post-timestamp (car posts))))) (server-name (request-server-name request))) (cond ((let ((since (assoc-ref (rref request 'headers '()) diff --git a/tekuti/post.scm b/tekuti/post.scm index 7e2e72f..cf926ee 100644 --- a/tekuti/post.scm +++ b/tekuti/post.scm @@ -20,7 +20,7 @@ ;;; Commentary: ;; -;; This is the main script that will launch tekuti. +;; Posts -- pulling them out of git, and, later, putting them in. ;; ;;; Code: @@ -38,8 +38,9 @@ #:export (post-from-tree post-from-key post-tags post-timestamp post-key post-published? - post-sxml-content post-raw-content post-readable-date post-tag-links post-sxml-n-comments - post-sxml-comments post-title + post-comments-open? post-comments + post-sxml-content post-readable-date post-n-comments + post-title all-published-posts @@ -94,6 +95,9 @@ (define (post-title post) (assq-ref post 'title)) +(define (post-comments-open? post) + (equal? (assq-ref post 'comment_status) "open")) + (define (post-raw-content post) (git "show" (string-append (assq-ref post 'sha1) ":content"))) @@ -106,18 +110,9 @@ (define (post-readable-date post) (let ((date (time-utc->date - (make-time time-utc 0 (assq-ref post 'timestamp))))) + (make-time time-utc 0 (post-timestamp post))))) (date->string date "~e ~B ~Y ~l:~M ~p"))) -;; hack :-/ -(define (tag-link tagname) - `(a (@ (href ,(string-append *public-url-base* "tags/" - (url:encode tagname)))) - ,tagname)) - -(define (post-tag-links post) - (map tag-link (post-tags post))) - (define (post-comments post) (dsu-sort (map (lambda (pair) @@ -126,70 +121,9 @@ comment-timestamp <)) -(define (comment-form post author email url comment) - `(form - (@ (action ,(string-append *public-url-base* "archives/" - (url:decode (assq-ref post 'key)))) - (method "POST")) - (p (input (@ (type "text") (name "author") (value ,author) - (size "22") (tabindex "1"))) - " " (label (@ (for "author")) (small "Name"))) - (p (input (@ (type "text") (name "email") (value ,email) - (size "22") (tabindex "2"))) - " " (label (@ (for "email")) (small "Mail (will not be published)"))) - (p (input (@ (type "text") (name "url") (value ,url) - (size "22") (tabindex "3"))) - " " (label (@ (for "url")) (small "Website"))) - ;(p (small "allowed tags: ")) - (p (textarea (@ (name "comment") (id "comment") (cols "65") - (rows "10") (tabindex "4")) - ,comment)) - (p (input (@ (name "submit") (type "submit") (id "submit") (tabindex "5") - (value "Submit Comment")))))) - -(define (post-sxml-comments post) - (let ((comments (post-comments post)) - (comment-status (assq-ref post 'comment_status))) - (define (n-comments-header) - (and (or (not (null? comments)) (equal? comment-status "open")) - `(h3 (@ (id "comments")) - ,(let ((len (length comments))) - (case len - ((0) "No responses") - ((1) "One response") - (else (format #f "~d responses" len))))))) - (define (show-comment comment) - `(li (@ (class "alt") (id ,(assq-ref comment 'key))) - (cite ,(let ((url (assq-ref comment 'author_url)) - (name (assq-ref comment 'author))) - (if (and url (not (string-null? url))) - `(a (@ (href ,url) (rel "external nofollow")) ,name) - name))) - " says:" (br) - (small (@ (class "commentmetadata")) - (a (@ (href ,(string-append "#" (assq-ref comment 'key)))) - ,(comment-readable-date comment))) - ,(comment-sxml-content comment))) - `(div - ,@(or (and=> (n-comments-header) list) '()) - ,@(let ((l (map show-comment comments))) - (if (null? l) l - `((ol (@ (class "commentlist")) ,@l)))) - ,(if (equal? comment-status "closed") - `(p (@ (id "nocomments")) "Comments are closed.") - `(div (h3 "Leave a Reply") - ,(comment-form post "" "" "" "")))))) - (define (post-n-comments post) (length (git-ls-tree (string-append (assq-ref post 'sha1) ":comments") #f))) -(define (post-sxml-n-comments post) - `(div (@ (class "feedback")) - (a (@ (href ,(string-append *public-url-base* "archives/" - (url:decode (assq-ref post 'key)) - "#comments"))) - "(" ,(post-n-comments post) ")"))) - (define (all-posts master) (map (lambda (pair) (post-from-tree (car pair) (cdr pair))) diff --git a/wordpress-to-dir.py b/wordpress-to-dir.py index 239c80a..5197106 100644 --- a/wordpress-to-dir.py +++ b/wordpress-to-dir.py @@ -77,7 +77,7 @@ def write_post(post, categories, comments): for k, v in post.items(): if k not in ('content', 'content_filtered'): out += '%s: %s\n' % (k, v) - out += 'categories: %s\n' % ', '.join(categories) + out += 'tags: %s\n' % ', '.join(categories) out += 'timestamp: %s\n' % int(time.mktime(post['date'].timetuple())) return out