[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
Brian Mastenbrook
bmastenbrook at common-lisp.net
Mon Apr 26 16:45:14 UTC 2004
Update of /project/lisppaste/cvsroot/lisppaste2
In directory common-lisp.net:/home/bmastenbrook/lisppaste2
Modified Files:
web-server.lisp
Log Message:
Commit whatever's lying around on disk
Date: Mon Apr 26 12:45:08 2004
Author: bmastenbrook
Index: lisppaste2/web-server.lisp
diff -u lisppaste2/web-server.lisp:1.44 lisppaste2/web-server.lisp:1.45
--- lisppaste2/web-server.lisp:1.44 Wed Mar 31 16:33:07 2004
+++ lisppaste2/web-server.lisp Mon Apr 26 12:45:02 2004
@@ -1,4 +1,4 @@
-;;;; $Id: web-server.lisp,v 1.44 2004/03/31 21:33:07 bmastenbrook Exp $
+;;;; $Id: web-server.lisp,v 1.45 2004/04/26 16:45:02 bmastenbrook Exp $
;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
;;;; See the LICENSE file for licensing information.
@@ -31,7 +31,6 @@
(defclass syndication-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)))
@@ -39,8 +38,32 @@
(list
(substitute #\# #\/ (araneida::request-unhandled-part request) :test #'char=)
(concatenate 'string "#"
- (araneida:request-cookie request "CHANNEL"))))))
- (new-paste-form request :annotate annotate :default-channel default-channel)))
+ (araneida:request-cookie request "CHANNEL"))
+ (and (eql method :post)
+ (araneida:body-param "channel"
+ (araneida:request-body request)))))))
+ (cond
+ ((and default-channel (find default-channel *channels* :test #'string=))
+ (araneida:request-send-headers request :expires 0 :set-cookie (format nil "CHANNEL=~A; path=/" (subseq default-channel 1)))
+ (new-paste-form request :annotate annotate :default-channel default-channel))
+ (t (araneida:request-send-headers request :expires 0)
+ (araneida:html-stream
+ (araneida:request-stream request)
+ `(html
+ (head
+ (title "Select a channel")
+ ,(rss-link-header))
+ (body
+ (h2 "Select a channel")
+ ((form :method post :action ,(araneida:urlstring *new-paste-url*))
+ "Please select a channel to lisppaste to: "
+ ((select :name "channel")
+ ((option :value ""))
+ ,@(mapcar #'(lambda (e)
+ `((option :value ,e)
+ ,(encode-for-pre e))) *channels*))
+ ((input :type submit :value "Submit")))
+ ,@(bottom-links))))))))
(defun bottom-links ()
`((hr)
@@ -205,7 +228,7 @@
,@(bottom-links))))))
(defun handle-rss-request (request &key full)
- (araneida:request-send-headers request :expires 0)
+ (araneida:request-send-headers request :expires 0 :content-type "application/rss+xml")
(format (araneida:request-stream request) "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>~C~C" #\Return #\Linefeed)
(let ((discriminate-channel (if (not (string= (araneida::request-unhandled-part request) ""))
(substitute #\# #\? (araneida::request-unhandled-part request)
@@ -242,10 +265,13 @@
(paste-annotations paste))))))
(format nil "Paste to channel ~A with ~A annotations." (encode-for-pre (paste-channel paste)) (length (paste-annotations paste))))
#\Return #\Linefeed))
- (if discriminate-channel
- (remove discriminate-channel *pastes* :test-not #'string-equal
- :key #'paste-channel)
- *pastes*))
+ (loop
+ for paste in
+ (if discriminate-channel
+ (remove discriminate-channel *pastes* :test-not #'string-equal
+ :key #'paste-channel)
+ *pastes*) for j from 1 to 20
+ collect paste))
#\Return #\Linefeed)))))
(defmethod araneida:handle-request-response ((handler rss-handler) method request)
@@ -278,10 +304,11 @@
`((tr
(th "Select a channel:")
(td ((select :name "channel")
- ,@(mapcar #'(lambda (e)
- `((option :value ,e ,@(if (string-equal e default-channel)
- '(:selected)))
- ,(encode-for-pre e))) *channels*))))))
+ (option :value "")
+ ,@(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"))))
@@ -302,10 +329,13 @@
(text (araneida:body-param "text" (araneida:request-body request)))
(annotate (araneida:body-param "annotate" (araneida:request-body request)))
(channel (araneida:body-param "channel" (araneida:request-body request))))
- (araneida:request-send-headers request :expires 0
- :set-cookie (format nil "CHANNEL=~A; path=/" (subseq channel 1)))
-
+ (if (> (length channel) 1)
+ (araneida:request-send-headers request :expires 0
+ :set-cookie (format nil "CHANNEL=~A; path=/" (subseq channel 1)))
+ (araneida:request-send-headers request :expires 0))
(cond
+ ((zerop (length channel))
+ (new-paste-form request :message "Please select a channel." :default-channel channel))
((zerop (length username))
(new-paste-form request :message "Please enter your username." :default-channel channel))
((zerop (length title))
@@ -315,7 +345,7 @@
((and annotate (not (parse-integer annotate :junk-allowed t)))
(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." :default channel))
+ (new-paste-form request :message "Whatever channel that is, I don't know about it." :default-channel 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)))
More information about the Lisppaste-cvs
mailing list