[cl-blog-cvs] CVS update: cl-blog/cl-blog.lisp

Brian Mastenbrook bmastenbrook at common-lisp.net
Fri Oct 29 14:16:58 UTC 2004


Update of /project/cl-blog/cvsroot/cl-blog
In directory common-lisp.net:/tmp/cvs-serv20126

Modified Files:
	cl-blog.lisp 
Log Message:
change trackback into a div, fix editing entries, conditionalize SBCL banner

Date: Fri Oct 29 16:16:57 2004
Author: bmastenbrook

Index: cl-blog/cl-blog.lisp
diff -u cl-blog/cl-blog.lisp:1.11 cl-blog/cl-blog.lisp:1.12
--- cl-blog/cl-blog.lisp:1.11	Fri Oct 22 03:13:47 2004
+++ cl-blog/cl-blog.lisp	Fri Oct 29 16:16:55 2004
@@ -141,6 +141,8 @@
                                ((a :href ,(archives-url :category i :rss t))
                                 "(RSS)")
                                )))
+	   #+sbcl
+	   ; who says reader macros in HTML generation are useless?
            ((p :align "center")
               ((a :href "http://www.sbcl.org/" :border "0")
                ((img :src "http://www.sbcl.org/sbclbutton.png" :alt "(get 'sbcl)" :border "0"))))
@@ -651,34 +653,35 @@
                      (number "number")
                      (preview "preview"))
     request
-    (let ((entry (copy-entry (find-entry (parse-integer number)))))
-      (setf (blog-entry-contents entry) contents)
-      (setf (blog-entry-category entry) category)
-      (setf (blog-entry-title entry) title)
+    (let ((entry (find-entry (parse-integer number))))
       (request-send-headers request :expires 0
                             :content-type "text/html; charset=iso-8859-1")
       (send-doctype request)
       (html-stream
        (request-stream request)
        (if (equalp preview "Preview")
-           (blog-wrap-page "Preview edit"
-                           (list
-			    (format-entry entry :display-actions nil)
-                            '(p)
-                            (blog-entry-form
-                             (urlstring
-                              (merge-url
-                               *edit-entry-url*
-                               (request-unhandled-part request)))
-                             :number (prin1-to-string (blog-entry-number entry))
-                             :title title
-                             :category category
-                             :contents contents
-                             :submit-button-text "Edit entry")))
-           (if (not (find 0 (list title category contents) :key #'length))
-               (progn
-                 (change-blog-entry entry :title title :category category :contents contents)
-                 (blog-wrap-page "Changed"
+	   (let ((entry (copy-entry entry)))
+	     (setf (blog-entry-contents entry) contents)
+	     (setf (blog-entry-category entry) category)
+	     (setf (blog-entry-title entry) title)
+	     (blog-wrap-page "Preview edit"
+			     (list
+			      (format-entry entry :display-actions nil)
+			      '(p)
+			      (blog-entry-form
+			       (urlstring
+				(merge-url
+				 *edit-entry-url*
+				 (request-unhandled-part request)))
+			       :number (prin1-to-string (blog-entry-number entry))
+			       :title title
+			       :category category
+			       :contents contents
+			       :submit-button-text "Edit entry"))))
+	   (if (not (find 0 (list title category contents) :key #'length))
+	       (progn
+		 (change-blog-entry entry :title title :category category :contents contents)
+		 (blog-wrap-page "Changed"
                                  '(((div :id "entry-form")
                                     (h2 "Your entry has been modified.")))))
                (blog-wrap-page "Not changed"
@@ -803,12 +806,13 @@
                    (blog-wrap-page "Posted"
                                    `(((div :id "entry-form")
                                       (h2 "Your new entry has been posted.")
-                                      ,@(when urls-pinged
-                                              `("Trackback pings have been sent to the following URLs:"
-                                                (ul
-                                                 ,@(mapcar #'(lambda (url)
-                                                               `(li ((a :href ,url) ,url)))
-                                                           urls-pinged))))
+				      ((div :class "trackback")
+				       ,@(when urls-pinged
+					   `("Trackback pings have been sent to the following URLs:"
+					     (ul
+					      ,@(mapcar #'(lambda (url)
+							    `(li ((a :href ,url) ,url)))
+							urls-pinged)))))
                                               ))))
 	       (blog-wrap-page "Not posted"
 			       '(((div :id "entry-form")
@@ -863,7 +867,7 @@
                              *blog-short-name*
                              (blog-entry-title entry))
                      (list* (format-entry entry)
-                            `(p "Trackback pings for this entry are listed below. The URL to ping for this entry is: " (b ,(entry-trackback entry)))
+                            `((div :class "trackback") "Trackback pings for this entry are listed below. The URL to ping for this entry is: " (b ,(entry-trackback entry)))
                             (mapcar #'format-trackback (blog-entry-trackbacks entry)))))))
 
 (defclass email-redirect-handler (handler) ())





More information about the Cl-blog-cvs mailing list