summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xjournal.lisp82
-rw-r--r--main.lisp2
2 files changed, 78 insertions, 6 deletions
diff --git a/journal.lisp b/journal.lisp
index a7d7ae7..8fdc894 100755
--- a/journal.lisp
+++ b/journal.lisp
@@ -1,5 +1,5 @@
;;;; -*- coding: utf-8; mode: lisp -*-
-;;;; Copyright 2007, Matthias Andreas Benkard.
+;;;; Copyright 2007-2009, Matthias Andreas Benkard.
;;;------------------------------------------------------------------------
;;; This file is part of The Mulkblog Project.
@@ -23,7 +23,7 @@
(in-package #:mulk.journal)
-(defun link-to (action &key post-id (absolute nil))
+(defun link-to (action &key comment-id post-id (absolute nil))
(with-output-to-string (out)
(format out "~A" (if absolute
"http://matthias.benkard.de/journal"
@@ -39,15 +39,83 @@
(:index "")
(:full-index "/?full")
(:view-atom-feed (values "/feed"))
- (:view (if post-id
- (values "/~D" post-id)
- "/"))
+ (:view-comment-feed (values "/comment-feed"))
+ (:view (cond (comment-id (values "/~D#comment-~D" post-id comment-id))
+ (post-id (values "/~D" post-id))
+ (t "/")))
((:edit :preview) (values "/~D/preview" post-id))
(:post-comment (values "/~D" post-id))
(:save (values "/~D/save" post-id))
(:css "/../journal.css")))))
+(defun show-comment-feed ()
+ #.(locally-enable-sql-reader-syntax)
+ (http-add-header "Last-Modified" (http-timestamp (compute-journal-last-modified-date)))
+ (http-add-header "Content-Language" "de")
+ (http-send-headers "application/atom+xml; charset=UTF-8")
+
+ (flet ((atom-time (time)
+ (format-date nil
+ "%4yr-%2mon-%2dayT%2hr:%2min:%2secZ"
+ time
+ 0)))
+ (with-xml-output (*standard-output* :encoding "utf-8")
+ (with-tag ("feed" '(("xmlns" "http://www.w3.org/2005/Atom")))
+ (emit-simple-tags :title "Kommentare — Kompottkins Weisheiten"
+ :updated (atom-time
+ (max (or (single-object
+ (select [max [slot-value 'journal-entry 'date]]
+ :from [journal-entry]
+ :flatp t))
+ 0)
+ (or (single-object
+ (select [max [slot-value 'journal-entry 'last-modification]]
+ :from [journal-entry]
+ :flatp t))
+ 0)))
+ :id "urn:uuid:9cd7a24c-10a6-4895-a97b-8df6b426e4a0")
+ (with-tag ("subtitle")
+ (xml-as-is "Geschwafel zum Geschwafel eines libertärsozialistischen Geeks"))
+ (with-tag ("author")
+ (emit-simple-tags :name "Various"))
+ (with-tag ("link" `(("rel" "alternate")
+ ("type" "text/html")
+ ("href" ,(link-to :index :absolute t)))))
+ (with-tag ("link" `(("rel" "self")
+ ("type" "application/atom+xml")
+ ("href" ,(link-to :view-comment-feed :absolute t)))))
+
+ (let ((number 0))
+ (dolist (journal-comment (select 'journal-comment
+ :order-by '(([date] :desc))
+ :flatp t))
+ (with-slots (entry uuid date body author website spam-p id)
+ journal-comment
+ (unless spam-p
+ (incf number)
+ (with-tag ("entry")
+ (emit-simple-tags :title (format nil "Kommentar zu: ~A" (title-of entry))
+ :id (format nil "urn:uuid:~(~A~)" uuid)
+ :updated (atom-time date)
+ :published (atom-time date))
+ (with-tag ("link" `(("rel" "alternate")
+ ("type" "text/html")
+ ("href" ,(link-to :view
+ :comment-id id
+ :post-id (id-of entry)
+ :absolute t)))))
+ (when (<= number 8)
+ ;; We only include the body for the most recent
+ ;; posts in order to save bandwidth.
+ (with-tag ("content" `(("type" "xhtml")
+ ("xml:lang" "de")
+ ("xml:base" ,(link-to :index :absolute t))))
+ (with-tag ("div" '(("xmlns" "http://www.w3.org/1999/xhtml")))
+ (xml-as-is (journal-markup->html (body-of journal-comment))))))))))))))
+ #.(restore-sql-reader-syntax-state))
+
+
(defun show-atom-feed ()
#.(locally-enable-sql-reader-syntax)
(http-add-header "Last-Modified" (http-timestamp (compute-journal-last-modified-date)))
@@ -113,7 +181,8 @@
("xml:lang" "de")
("xml:base" ,(link-to :index :absolute t))))
(with-tag ("div" '(("xmlns" "http://www.w3.org/1999/xhtml")))
- (xml-as-is (journal-markup->html (body-of journal-entry)))))))))))))
+ (xml-as-is (with-yaclml-output-to-string
+ (render-comment-body (body-of journal-entry))))))))))))))
#.(restore-sql-reader-syntax-state))
@@ -202,6 +271,7 @@
(with-slots (author body date id email website)
comment
(<:div :class :journal-comment
+ :id (format nil "comment-~D" id)
(<:div :class :journal-comment-header
(<:as-html (format nil "(~A) "
(format-date nil "%day.%mon.%yr, %hr:%min" date)))
diff --git a/main.lisp b/main.lisp
index 463106c..0c17fbe 100644
--- a/main.lisp
+++ b/main.lisp
@@ -47,6 +47,7 @@
:junk-allowed t #|| :radix 12 ||#))
(*action* (or (keywordify (getf *query* :action))
(cond ((string= "feed" (first *subpath*)) :view-atom-feed)
+ ((string= "comment-feed" (first *subpath*)) :view-comment-feed)
((string= "debug" (first *subpath*)) :view-debugging-page)
((string= "preview" (car (last *subpath*))) :preview-entry)
((string= "save" (car (last *subpath*))) :save-entry)
@@ -165,6 +166,7 @@
(mail-comment *notification-email* comment entry))))
(show-web-journal))
(:view-atom-feed (show-atom-feed))
+ (:view-comment-feed (show-comment-feed))
(:view-debugging-page (show-debugging-page))
(otherwise (show-web-journal))))