[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp

Brian Mastenbrook bmastenbrook at common-lisp.net
Tue Feb 10 16:18:18 UTC 2004


Update of /project/lisppaste/cvsroot/lisppaste2
In directory common-lisp.net:/home/bmastenbrook/lisppaste2

Modified Files:
	web-server.lisp 
Log Message:
HTML 4.01 Transitional!

Date: Tue Feb 10 11:18:18 2004
Author: bmastenbrook

Index: lisppaste2/web-server.lisp
diff -u lisppaste2/web-server.lisp:1.26 lisppaste2/web-server.lisp:1.27
--- lisppaste2/web-server.lisp:1.26	Wed Feb  4 08:07:27 2004
+++ lisppaste2/web-server.lisp	Tue Feb 10 11:18:17 2004
@@ -1,4 +1,4 @@
-;;;; $Id: web-server.lisp,v 1.26 2004/02/04 13:07:27 bmastenbrook Exp $
+;;;; $Id: web-server.lisp,v 1.27 2004/02/10 16:18:17 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -51,6 +51,11 @@
      ((< delta (* 60 60)) (format nil "~A ago" (time-delta-primitive delta 1)))
      (t (format nil "~A ago" (time-delta-primitive delta level))))))
 
+(defun irc-log-link (utime channel)
+  (format nil "http://meme.b9.com/now?utime=~A&channel=~A"
+	  utime
+	  (string-left-trim "#" channel)))
+
 (defun first-<-mod (n &rest nums)
   (some #'(lambda (n2)
 	    (if (< n2 n) (mod n n2) nil)) nums))
@@ -83,6 +88,7 @@
 
 (defmethod araneida:handle-request-response ((handler list-paste-handler) method request)
   (araneida:request-send-headers request :expires 0)
+  (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">")
   (araneida:html-stream
    (araneida:request-stream request)
    `(html
@@ -93,13 +99,13 @@
       ((table :width "100%" :cellpadding 2)
        (tr (td) (td "By") (td "Where") (td "When") (td "Titled") (td "Ann."))
        ,@(reverse (mapcar #'(lambda (paste)
-			      `(tr ((td :nowrap) ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number paste)))))
+			      `(tr ((td :nowrap "nowrap") ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number paste)))))
 						  ,(concatenate 'string "#" (prin1-to-string (paste-number paste)))))
-				   ((td :nowrap) ,(encode-for-pre (paste-user paste)))
-                                   ((td :nowrap) ,(encode-for-pre (paste-channel paste)))
-				   ((td :nowrap) ,(time-delta (paste-universal-time paste) 1))
-				   ((td :width "100%" :bgcolor "#F4F4F4" :nowrap) ,(encode-for-pre (paste-title paste)))
-				   ((td :nowrap) ,(length (paste-annotations paste)))))
+				   ((td :nowrap "nowrap") ,(encode-for-pre (paste-user paste)))
+                                   ((td :nowrap "nowrap") ,(encode-for-pre (paste-channel paste)))
+				   ((td :nowrap "nowrap") ,(time-delta (paste-universal-time paste) 1))
+				   ((td :width "100%" :bgcolor "#F4F4F4" :nowrap "nowrap") ,(encode-for-pre (paste-title paste)))
+				   ((td :nowrap "nowrap") ,(length (paste-annotations paste)))))
 			  *pastes*)))
       ,@(bottom-links)))))
 
@@ -113,7 +119,7 @@
               "<channel><title>Lisppaste pastes</title><link>~A</link><description>Pastes in this pastebot</description>~{~A~}</channel>~%"
               (araneida:urlstring *list-paste-url*)
               (mapcar #'(lambda (paste)
-                                   (format nil "<item><link>~A</link><pubDate>~A</pubDate><title>\"~A\" by ~A</title><description>~A</description></item>"
+                                   (format nil "<item><link>~A</link><pubDate>~A</pubDate><title>\"~A\" by ~A</title><description>~A</description></item>~%"
                                            (concatenate 'string
                                                         (araneida:urlstring
                                                          (araneida:merge-url *display-paste-url*
@@ -125,6 +131,7 @@
                                *pastes*)))))
 
 (defun new-paste-form (request &key (message "") (annotate nil))
+  (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">")
   (araneida:html-stream
    (araneida:request-stream request)
    `(html
@@ -183,8 +190,7 @@
      (t
       (let* ((paste-number (if annotate (parse-integer annotate :junk-allowed t) (incf *paste-counter*)))
 	     (paste-to-annotate (if annotate (find paste-number *pastes* :key #'paste-number)))
-	     (annotation-number (if annotate (incf (paste-annotation-counter paste-to-annotate))))
-             (log-link (irc-log-link channel)))
+	     (annotation-number (if annotate (incf (paste-annotation-counter paste-to-annotate)))))
 	(let ((url (araneida:urlstring
 		    (araneida:merge-url *display-paste-url*
 					(if annotate
@@ -198,7 +204,7 @@
 				 :contents text
 				 :universal-time (get-universal-time)
                                  :channel channel
-                                 :log-link log-link)))
+                                 )))
 	  (irc:privmsg *connection* channel
 		       (if annotate
 			   (format nil "~A annotated #~A with \"~A\" at ~A" username paste-number title url)
@@ -207,6 +213,7 @@
 	      (push paste (paste-annotations paste-to-annotate))
 	    (push paste *pastes*))
           (save-pastes-to-file *paste-file*)
+	  (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">")
 	  (araneida:html-stream
 	   (araneida:request-stream request)
 	   `(html
@@ -228,58 +235,60 @@
                           (and (eql paste-number (paste-number element))
                                element)) *pastes*)))
     (if paste
-        (araneida:html-stream
-         (araneida:request-stream request)
-         `(html
-           (head
-            (title "Paste number " ,paste-number)
-            ,(rss-link-header))
-           (body
-            ((table :width "100%" :cellpadding 2)
-	     (tr ((td :align "left" :width "0%" :nowrap) "Paste number " ,paste-number ": ")
-		 ((td :align "left" :width "100%") (b ,(encode-for-pre (paste-title paste)))))
-	     (tr ((td :align "left" :nowrap) "Pasted by: ")
-		 ((td :align "left" :width "100%") ,(encode-for-pre (paste-user paste))))
-	     (tr (td)
-		 ((td :align "left" :width "100%") ,(time-delta (paste-universal-time paste))))
-             (tr (td)
-		 ((td :align "left" :width "100%") ,(encode-for-pre (paste-channel paste))
-                  ,@(if (not (string= (paste-log-link paste) ""))
-                        `(" | "
-                          ((a :href ,(paste-log-link paste)) "Context in IRC logs")))))
-	     (tr ((td :align "left" :valign "top" :nowrap) "Paste contents:")
-		 ((td :width "100%")))
-	     (tr (td (p)))
-	     (tr ((td :bgcolor "#F4F4F4" :colspan 2 :width "100%") (tt ,(encode-for-tt (paste-contents paste)))))
-	    ,@(if (paste-annotations paste)
-		  `((tr (td (p)) (td))
-		    (tr ((th :align "left" :colspan 2) "Annotations for this paste: "))
-		    ,@(reduce #'append (nreverse
-			      (mapcar #'(lambda (a)
-					  `((tr (td (p)) (td))
-					    (tr
-					     (td ((a :name ,(prin1-to-string (paste-number a))) "Title:"))
-					     ((td :align "left") ,(encode-for-pre (paste-title a))
-					      ,@(if (not (string= (paste-log-link a) ""))
-						  `(" | "
-						    ((a :href ,(paste-log-link a)) "Context in IRC logs")))))
-					    (tr
-					     (td "By:")
-					     ((td :align "left") ,(encode-for-pre (paste-user a))))
-					    (tr
-					     (td)
-					     ((td :align "left") ,(time-delta (paste-universal-time a))))
-					    (tr
-					     ((td :valign "top" :nowrap) "Contents:")
-					     ((td :bgcolor "#F4F4F4" :width "100%") (tt ,(encode-for-tt (paste-contents a)))))))
-				      (paste-annotations paste)))))
-		`((tr (td (p)) (td))
-		  (tr ((td :align "left" :colspan 2 :nowrap) "This paste has no annotations.")))))
-	    (p)
-	    ((form :method post :action ,(araneida:urlstring *new-paste-url*))
-	     ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number paste))))
-	     (center ((input :type submit :value "Annotate this paste"))))
-	    ,@(bottom-links))))
+	(progn
+	  (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">")
+	  (araneida:html-stream
+	   (araneida:request-stream request)
+	   `(html
+	     (head
+	      (title "Paste number " ,paste-number)
+	      ,(rss-link-header))
+	     (body
+	      ((table :width "100%" :cellpadding 2)
+	       (tr ((td :align "left" :width "0%" :nowrap "nowrap") "Paste number " ,paste-number ": ")
+		   ((td :align "left" :width "100%") (b ,(encode-for-pre (paste-title paste)))))
+	       (tr ((td :align "left" :nowrap "nowrap") "Pasted by: ")
+		   ((td :align "left" :width "100%") ,(encode-for-pre (paste-user paste))))
+	       (tr (td)
+		   ((td :align "left" :width "100%") ,(time-delta (paste-universal-time paste))))
+	       (tr (td)
+		   ((td :align "left" :width "100%") ,(encode-for-pre (paste-channel paste))
+		    " | "
+		    ((a :href ,(irc-log-link (paste-universal-time paste) (paste-channel paste))) "Context in IRC logs")))
+	       (tr ((td :align "left" :valign "top" :nowrap "nowrap") "Paste contents:")
+		   ((td :width "100%")))
+	       (tr (td (p)))
+	       (tr ((td :bgcolor "#F4F4F4" :colspan 2 :width "100%") (tt ,(encode-for-tt (paste-contents paste)))))
+	       ,@(if (paste-annotations paste)
+		     `((tr (td (p)) (td))
+		       (tr ((th :align "left" :colspan 2) "Annotations for this paste: "))
+		       ,@(reduce #'append (nreverse
+					   (mapcar #'(lambda (a)
+						       `((tr (td (p)) (td))
+							 (tr
+							  (td ((a :name ,(prin1-to-string (paste-number a))) "Title:"))
+							  ((td :align "left") ,(encode-for-pre (paste-title a))
+							   " | "
+							   ((a :href ,(irc-log-link (paste-universal-time paste) (paste-channel paste))) "Context in IRC logs")))
+							 (tr
+							  (td "By:")
+							  ((td :align "left") ,(encode-for-pre (paste-user a))))
+							 (tr
+							  (td)
+							  ((td :align "left") ,(time-delta (paste-universal-time a))))
+							 (tr
+							  ((td :valign "top" :nowrap "nowrap") "Contents:")
+							  ((td :bgcolor "#F4F4F4" :width "100%") (tt ,(encode-for-tt (paste-contents a)))))))
+						   (paste-annotations paste)))))
+		   `((tr (td (p)) (td))
+		     (tr ((td :align "left" :colspan 2 :nowrap "nowrap") "This paste has no annotations.")))))
+	      (p)
+	      ((form :method post :action ,(araneida:urlstring *new-paste-url*))
+	       ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number paste))))
+	       (center ((input :type submit :value "Annotate this paste"))))
+	    ,@(bottom-links)))))
+      (progn
+	(format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">")
         (araneida:html-stream
          (araneida:request-stream request)
          `(html
@@ -288,7 +297,7 @@
             ,(rss-link-header))
            (body
             (h3 "No paste numbered " ,paste-number " could be found.")
-	    ,@(bottom-links)))))))
+	    ,@(bottom-links))))))))
 
 (araneida:install-handler
  (araneida:http-listener-handler *paste-listener*)





More information about the Lisppaste-cvs mailing list