[Lisppaste-cvs] CVS update: lisppaste2/variable.lisp lisppaste2/web-server.lisp - lisppaste-cvs@common-lisp.net - mailman3.common-lisp.net

7 Mar 2004

Update of /project/lisppaste/cvsroot/lisppaste2
In directory common-lisp.net:/tmp/cvs-serv2497
Modified Files:
    variable.lisp web-server.lisp 
Log Message:
Many RSS improvements
Date: Sun Mar  7 14:52:57 2004
Author: bmastenbrook
Index: lisppaste2/variable.lisp
diff -u lisppaste2/variable.lisp:1.11 lisppaste2/variable.lisp:1.12

--- lisppaste2/variable.lisp:1.11	Wed Feb  4 08:23:52 2004
+++ lisppaste2/variable.lisp	Sun Mar  7 14:52:57 2004
@@ -1,4 +1,4 @@
-;;;; $Id: variable.lisp,v 1.11 2004/02/04 13:23:52 bmastenbrook Exp $
+;;;; $Id: variable.lisp,v 1.12 2004/03/07 19:52:57 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $
;;;; See the LICENSE file for licensing information.
@@ -44,6 +44,9 @@
(defparameter *rss-url*
   (araneida:merge-url *paste-external-url* "list.rss"))
+
+(defparameter *rss-full-url*
+  (araneida:merge-url *paste-external-url* "list-full.rss"))
(defvar *paste-listener*
   (let ((fwd-url (araneida:copy-url *paste-url*)))
Index: lisppaste2/web-server.lisp
diff -u lisppaste2/web-server.lisp:1.36 lisppaste2/web-server.lisp:1.37
--- lisppaste2/web-server.lisp:1.36	Sun Mar  7 13:16:27 2004
+++ lisppaste2/web-server.lisp	Sun Mar  7 14:52:57 2004
@@ -1,4 +1,4 @@
-;;;; $Id: web-server.lisp,v 1.36 2004/03/07 18:16:27 bmastenbrook Exp $
+;;;; $Id: web-server.lisp,v 1.37 2004/03/07 19:52:57 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
;;;; See the LICENSE file for licensing information.
@@ -26,12 +26,15 @@
(defclass rss-handler (araneida:handler) ())
+(defclass rss-full-handler (araneida:handler) ())
+
 (defmethod araneida:handle-request-response ((handler new-paste-handler) method request)
   (araneida:request-send-headers request :expires 0)
   (let* ((annotate-string (araneida:body-param "annotate" (araneida:request-body request)))
          (annotate-number (if annotate-string (parse-integer annotate-string :junk-allowed t)))
-         (annotate (if annotate-number (find annotate-number *pastes* :key #'paste-number))))
-    (new-paste-form request :annotate annotate)))
+         (annotate (if annotate-number (find annotate-number *pastes* :key #'paste-number)))
+         (default-channel (substitute ## #/ (araneida::request-unhandled-part request) :test #'char=)))
+    (new-paste-form request :annotate annotate :default-channel default-channel)))
(defun bottom-links ()
   `((hr)
@@ -39,7 +42,9 @@
     " | "
     ((a :href ,(araneida:urlstring *list-paste-url*)) "List all pastes")
     " | "
-    ((a :href ,(araneida:urlstring *rss-url*)) "Syndicate (RSS)")
+    ((a :href ,(araneida:urlstring *rss-url*)) "Syndicate (Basic RSS)")
+    " | "
+    ((a :href ,(araneida:urlstring *rss-full-url*)) "Syndicate (Full RSS)")
     " | "
     ((a :href "http://common-lisp.net/project/lisppaste") "lisppaste home page")))
@@ -93,48 +98,118 @@
 (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
-     (head (title "All pastes")
-           ,(rss-link-header))
-     (body
-      (center (h2 "All pastes in system"))
-      ((table :width "100%" :cellpadding 2)
-       (tr (td) (td "By") (td "Where") (td "When") (td "Titled") (td "Ann."))
-       ,@(reverse (mapcar #'(lambda (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 "nowrap") ,(encode-for-pre (max-length (paste-user paste) 12)))
-                                   ((td :nowrap "nowrap") ,(encode-for-pre (paste-channel paste)))
-                                   ((td :nowrap "nowrap") ,(time-delta (paste-universal-time paste) :level 1 :ago-p nil))
-                                   ((td :width "100%" :bgcolor "#F4F4F4" :nowrap "nowrap") ,(encode-for-pre (max-length (paste-title paste) 50)))
-                                   ((td :nowrap "nowrap") ,(length (paste-annotations paste)))))
-                          *pastes*)))
-      ,@(bottom-links)))))
+  (let ((discriminate-channel (or
+                               (araneida:body-param "channel" (araneida:request-body request))
+                               (if (not (string= (araneida::request-unhandled-part request) ""))
+                                   (substitute ## #/ (araneida::request-unhandled-part request)
+                                               :test #'char=)))))
+    (if (string-equal discriminate-channel "allchannels")
+        (setf discriminate-channel nil))
+    (araneida:html-stream
+     (araneida:request-stream request)
+     `(html
+       (head (title "All pastes")
+             ,(rss-link-header))
+       (body
+        (center (h2 ,(if discriminate-channel
+                         (format nil "All pastes in channel ~A" discriminate-channel)
+                         "All pastes in system")))
+        ,@(if discriminate-channel
+              (if (not (member discriminate-channel *channels* :test #'string-equal))
+                  `(((h2) ((font :color "red") ,(format nil "Warning: no channel named ~A found!"
+                                                        discriminate-channel))))))
+        (center
+         ((form :method post :action ,(araneida:urlstring *list-paste-url*))
+          (table
+           (tr ((td :align left) "View only: ")
+               ((td :valign top)
+                ((select :name "channel")
+                 ((option :value "allchannels") "All channels")
+                 ,@(mapcar #'(lambda (e)
+                               `((option :value ,e ,@(if (and discriminate-channel
+                                                              (string-equal e discriminate-channel))
+                                                         '(:selected)))
+                                 ,(encode-for-pre e))) *channels*)))
+               ((td :valign top)
+                ((input :type submit :value "Submit"))))
+           (tr ((td :align left)
+                ,(if discriminate-channel "Syndicate this channel: " "Syndicate all channels: "))
+               ((td :align center)
+                ((a :href ,(concatenate 'string
+                                        (araneida:urlstring *rss-url*)
+                                        (if discriminate-channel
+                                            (substitute #? ## discriminate-channel) ""))) "Basic")
+                " | "
+                ((a :href ,(concatenate 'string
+                                        (araneida:urlstring *rss-full-url*)
+                                        (if discriminate-channel
+                                            (substitute #? ## discriminate-channel) ""))) "Full"))
+               (td)))))
+        (p)
+        ((table :width "100%" :cellpadding 2)
+         (tr (td) (td "By") (td "Where") (td "When") (td "Titled") (td "Ann."))
+         ,@(reverse (mapcar #'(lambda (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 "nowrap") ,(encode-for-pre (max-length (paste-user paste) 12)))
+                                     ((td :nowrap "nowrap") ,(encode-for-pre (paste-channel paste)))
+                                     ((td :nowrap "nowrap") ,(time-delta (paste-universal-time paste) :level 1 :ago-p nil))
+                                     ((td :width "100%" :bgcolor "#F4F4F4" :nowrap "nowrap") ,(encode-for-pre (max-length (paste-title paste) 50)))
+                                     ((td :nowrap "nowrap") ,(length (paste-annotations paste)))))
+                            (if discriminate-channel
+                                (remove discriminate-channel *pastes* :test-not #'string-equal
+                                        :key #'paste-channel)
+                                *pastes*))))
+        ,@(bottom-links))))))
-(defmethod araneida:handle-request-response ((handler rss-handler) method request)
+(defun handle-rss-request (request &key full)
   (araneida:request-send-headers request :expires 0)
   (format (araneida:request-stream request) "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>~%")
-  (araneida:html-stream
-   (araneida:request-stream request)
-   `((|rss| :|version| "2.0")
-     ,(format nil
-              "<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>~%"
-                                           (concatenate 'string
-                                                        (araneida:urlstring
-                                                         (araneida:merge-url *display-paste-url*
-                                                                             (prin1-to-string (paste-number paste)))))
-                                           (date:universal-time-to-rfc-date (paste-universal-time paste))
-                                           (encode-for-pre (paste-title paste))
-                                           (encode-for-pre (paste-user paste))
-                                           (format nil "Paste to channel ~A with ~A annotations." (encode-for-pre (paste-channel paste)) (length (paste-annotations paste)))))
-                               *pastes*)))))
+  (let ((discriminate-channel (if (not (string= (araneida::request-unhandled-part request) ""))
+                                  (substitute ## #? (araneida::request-unhandled-part request)
+                                              :test #'char=))))
+    (araneida:html-stream
+     (araneida:request-stream request)
+     `((|rss| :|version| "2.0")
+       ,(format nil
+                "<channel><title>Lisppaste pastes~A</title><link>~A</link><description>Pastes in this pastebot~A</description>~{~A~}</channel>~%"
+                (if discriminate-channel (format nil " for channel ~A" discriminate-channel) "")
+                (araneida:urlstring *list-paste-url*)
+                (if discriminate-channel (format nil " on channel ~A" discriminate-channel) "")
+                (mapcar #'(lambda (paste)
+                            (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*
+                                                                      (prin1-to-string (paste-number paste)))))
+                                    (date:universal-time-to-rfc-date
+                                     (apply #'max
+                                            (paste-universal-time paste)
+                                            (mapcar #'paste-universal-time (paste-annotations paste))))
+                                    (encode-for-pre (paste-title paste))
+                                    (encode-for-pre (paste-user paste))
+                                    (if full
+                                        (encode-for-pre
+                                         (araneida:html
+                                          `(p
+                                            ,(format-paste paste nil (paste-number paste))
+                                            ,@(mapcar
+                                               #'(lambda (a)
+                                                   (format-paste a nil (paste-number a) t))
+                                               (paste-annotations paste)))))
+                                        (format nil "Paste to channel ~A with ~A annotations." (encode-for-pre (paste-channel paste)) (length (paste-annotations paste))))))
+                        (if discriminate-channel
+                            (remove discriminate-channel *pastes* :test-not #'string-equal
+                                    :key #'paste-channel)
+                            *pastes*)))))))
+
+(defmethod araneida:handle-request-response ((handler rss-handler) method request)
+  (handle-rss-request request))
-(defun new-paste-form (request &key (message "") (annotate nil))
+(defmethod araneida:handle-request-response ((handler rss-full-handler) method request)
+  (handle-rss-request request :full t))
+
+(defun new-paste-form (request &key (message "") (annotate nil) (default-channel ""))
   (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)
@@ -157,7 +232,11 @@
         ,@(if (not annotate)
               `((tr
                  (th "Select a channel:")
-                 (td ((select :name "channel") ,@(mapcar #'(lambda (e) `((option :value ,e) ,(encode-for-pre e))) *channels*))))))
+                 (td ((select :name "channel")
+                              ,@(mapcar #'(lambda (e)
+                                            `((option :value ,e ,@(if (string-equal e default-channel)
+                                                                      '(:selected)))
+                                              ,(encode-for-pre e))) *channels*))))))
         (tr
          (th "Enter your username:")
          (td ((input :type text :name "username"))))
@@ -182,15 +261,15 @@
(cond
      ((zerop (length username))
-      (new-paste-form request :message "Please enter your username."))
+      (new-paste-form request :message "Please enter your username." :default-channel channel))
      ((zerop (length title))
-      (new-paste-form request :message "Please enter a title."))
+      (new-paste-form request :message "Please enter a title." :default-channel channel))
      ((zerop (length text))
-      (new-paste-form request :message "Please enter your paste."))
+      (new-paste-form request :message "Please enter your paste." :default-channel channel))
      ((and annotate (not (parse-integer annotate :junk-allowed t)))
-      (new-paste-form request :message "Malformed annotation request."))
+      (new-paste-form request :message "Malformed annotation request." :default-channel channel))
      ((not (member channel *channels* :test #'string-equal))
-      (new-paste-form request :message "Whatever channel that is, I don't know about it."))
+      (new-paste-form request :message "Whatever channel that is, I don't know about it." :default channel))
      (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)))
@@ -241,13 +320,17 @@
         ((td :align "left" :width "100%") ,(encode-for-pre (paste-user paste))))
     (tr (td)
         ((td :align "left" :width "100%") ,(time-delta (paste-universal-time paste))))
-    ,@(if (not annotation)
+    ,@(if (or (not annotation) *meme-links*)
           `((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")))))
+                ((td :align "left" :width "100%")
+                 ,@(if (not annotation)
+                       `((,(encode-for-pre (paste-channel paste)) ,(if *meme-links*
+                                                                       " | " ""))))
+                 ,@(if *meme-links*
+                       `(((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%") ((a :href ,(concatenate 'string this-url "/raw")) "(raw source)")))
+        ,@(if this-url
+              `(((td :width "100%") ((a :href ,(concatenate 'string this-url "/raw")) "(raw source)")))))
     (tr (td (p)))
     (tr ((td :bgcolor "#F4F4F4" :colspan 2 :width "100%") (tt ,(encode-for-tt (paste-contents paste)))))))
@@ -319,12 +402,12 @@
 (araneida:install-handler
  (araneida:http-listener-handler *paste-listener*)
  (make-instance 'new-paste-handler)
- (araneida:urlstring *new-paste-url*) t)
+ (araneida:urlstring *new-paste-url*) nil)
(araneida:install-handler
  (araneida:http-listener-handler *paste-listener*)
  (make-instance 'list-paste-handler)
- (araneida:urlstring *list-paste-url*) t)
+ (araneida:urlstring *list-paste-url*) nil)
(araneida:install-handler
  (araneida:http-listener-handler *paste-listener*)
@@ -340,3 +423,8 @@
  (araneida:http-listener-handler *paste-listener*)
  (make-instance 'rss-handler)
  (araneida:urlstring *rss-url*) nil)
+
+(araneida:install-handler
+ (araneida:http-listener-handler *paste-listener*)
+ (make-instance 'rss-full-handler)
+ (araneida:urlstring *rss-full-url*) nil)

    