more cleanups

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)))
+  `(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))))
+           (comment-raw-content comment)))))
 
 (define (comment-timestamp comment-alist)
   (or (assq-ref comment-alist 'timestamp) #f))

tekuti/page-helpers.scm

@@ -42,8 +42,8 @@
             show-post
             atom-header atom-entry))
 
-(define (relurl path)
+(define (relurl . paths)
-  (string-append *public-url-base* path))
+  (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/"
+  (rellink (string-append "admin/posts/" (url:encode (post-key post)))
-                         (url:encode (post-key post)))
+           (post-title 'title)))
-           (assq-ref post 'title)))
 
-(define (post-link post)
+(define (post-url post . tail)
-  (rellink (string-append "archives/" (url:decode (post-key post)))
+  (apply relurl "archives/" (url:decode (post-key post)) tail))
-           (assq-ref post 'title)))
+
+(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? '()
+         ,@(if comments?
-               (list (post-sxml-n-comments post))))
+               '()
+               `((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
+                       `(a (@ (href ,(relurl "tags/" (url:encode name)))
-                                      *public-url-base* "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 "
+     (li (h2 "tags " ,(rellink "tags/" ">>"))
-             (a (@ (href ,(string-append *public-url-base* "tags/")))
-                ">>"))
          ,(tag-cloud index)))))
 
 (define (atom-header server-name last-modified)

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 '())

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-comments-open? post-comments
-            post-sxml-comments post-title
+            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)))

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