[Lisppaste-cvs] CVS update: lisppaste2/variable.lisp lisppaste2/web-server.lisp
Brian Mastenbrook
bmastenbrook at common-lisp.net
Sun Mar 7 19:52:57 UTC 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)
More information about the Lisppaste-cvs
mailing list