Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2
Modified Files: web-server.lisp Log Message: pagination (woot!)
Date: Fri May 21 17:29:11 2004 Author: bmastenbrook
Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.46 lisppaste2/web-server.lisp:1.47 --- lisppaste2/web-server.lisp:1.46 Fri May 21 12:42:38 2004 +++ lisppaste2/web-server.lisp Fri May 21 17:29:11 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.46 2004/05/21 16:42:38 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.47 2004/05/21 21:29:11 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
;;;; See the LICENSE file for licensing information. @@ -36,16 +36,18 @@ (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))) - (default-channel (find-if #'(lambda (e) (> (length e) 1)) - (list - (substitute ## #/ (araneida::request-unhandled-part request) :test #'char=) - (concatenate 'string "#" - (araneida:request-cookie request "CHANNEL")) - (and (eql method :post) - (araneida:body-param "channel" - (araneida:request-body request))))))) + (default-channel + (or (and annotate (paste-channel annotate)) + (find-if #'(lambda (e) (> (length e) 1)) + (list + (substitute ## #/ (araneida::request-unhandled-part request) :test #'char=) + (concatenate 'string "#" + (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=)) + ((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) @@ -58,6 +60,7 @@ (body (h2 "Select a channel") ((form :method post :action ,(araneida:urlstring *new-paste-url*)) + ((input :type "hidden" :name "annotate" :value ,annotate-string)) "Please select a channel to lisppaste to: " ((select :name "channel") ((option :value "")) @@ -244,69 +247,120 @@ (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\">") - (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.")) - ,@(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)))))) + (flet ((page-url (discriminate-channel i) + (araneida:urlstring + (let ((url (araneida:copy-url *list-paste-url*))) + (if discriminate-channel + (setf (araneida:url-path url) + (concatenate 'string + (araneida:url-path url) + "/"))) + (araneida:merge-url + url + (format nil "~A?~A" + (if discriminate-channel + (subseq discriminate-channel 1) "") + i)))))) + (destructuring-bind + (channel &rest others) (split-sequence:split-sequence + #? + (araneida::request-unhandled-part request)) + (let* ((discriminate-channel (or + (araneida:body-param "channel" (araneida:request-body request)) + (if (not (string= channel "")) + (substitute ## #/ channel + :test #'char=)))) + (discriminate-channel + (if (string-equal discriminate-channel "allchannels") + nil discriminate-channel)) + (page (if others + (parse-integer (car others) :junk-allowed t) 0)) + (discriminated-pastes + (if discriminate-channel + (remove discriminate-channel *pastes* :test-not #'string-equal + :key #'paste-channel) + *pastes*)) + (highest-page (floor (/ (- (length discriminated-pastes) 1) + *pastes-per-page*))) + (page-links + `(,@(if (> page 0) + `(((a :href ,(page-url discriminate-channel (1- page))) + "Newer <") " ")) + ,@(loop for i from 0 to highest-page + appending + `(,(if (not (eql i page)) + `((a :href ,(page-url discriminate-channel i)) + ,(1+ i)) + (1+ i)) ,@(if (eql i highest-page) + nil + '(" ")))) + ,@(if (< page highest-page) + `(((a :href ,(page-url discriminate-channel (1+ page))) + "> Older")))))) + (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)) + (tr ((td :align left) + "Page: ") + ((td :align center) + ,@page-links)) + ))) + (p) + ((table :width "100%" :cellpadding 2) + (tr (td) (td "By") (td "Where") (td "When") (td "Titled") (td "Ann.")) + ,@(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))))) + (loop for i from 0 + to (- (* (1+ page) *pastes-per-page*) 1) + for j in discriminated-pastes + if (>= i (* page *pastes-per-page*)) + collect j))) + (center + "Page: " ,@page-links) + ,@(bottom-links))))))))
(defun handle-rss-request (request &key full) (araneida:request-send-headers request :expires 0 :content-type "application/rss+xml") @@ -361,7 +415,7 @@ (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 "")) +(defun new-paste-form (request &key (message "") (annotate nil) (default-channel "") (default-user "") (default-title "") (default-contents "")) (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) @@ -392,41 +446,48 @@ ,(encode-for-pre e))) *channels*)))))) (tr (th "Enter your username:") - (td ((input :type text :name "username")))) + (td ((input :type text :name "username" + :value ,(encode-for-pre default-user))))) (tr (th "Enter a title:") - (td ((input :type text :name "title")))) + (td ((input :type text :name "title" + :value ,(encode-for-pre default-title))))) (tr ((th :valign top) "Enter your paste:") - (td ((textarea :rows 24 :cols 80 :name "text")))) + (td ((textarea :rows 24 :cols 80 :name "text") + ,(encode-for-pre default-contents)))) (tr ((th) "Submit your paste:") ((td) ((input :type submit :value "Submit paste")) " " ((input :type reset :value "Clear paste")))))) ,@(bottom-links)))))
(defmethod araneida:handle-request-response ((handler submit-paste-handler) method request) - (let ((username (araneida:body-param "username" (araneida:request-body request))) - (title (araneida:body-param "title" (araneida:request-body request))) - (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)))) + (let* ((username (araneida:body-param "username" (araneida:request-body request))) + (title (araneida:body-param "title" (araneida:request-body request))) + (text (araneida:body-param "text" (araneida:request-body request))) + (annotate (araneida:body-param "annotate" (araneida:request-body request))) + (annotate-number (if annotate (parse-integer annotate :junk-allowed t))) + (annotate-paste (if annotate-number (find annotate-number *pastes* :key #'paste-number))) + (channel (araneida:body-param "channel" (araneida:request-body request)))) (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)) + (araneida:request-send-headers request :expires 0)) (cond + ((> (length text) *paste-maximum-size*) + (new-paste-form request :message "Paste too large." :default-channel channel :annotate annotate-paste :default-user username :default-title title)) ((zerop (length channel)) - (new-paste-form request :message "Please select a channel." :default-channel channel)) + (new-paste-form request :message "Please select a channel." :default-channel channel :annotate annotate-paste :default-user username :default-title title :default-contents text)) ((zerop (length username)) - (new-paste-form request :message "Please enter your username." :default-channel channel)) + (new-paste-form request :message "Please enter your username." :default-channel channel :annotate annotate-paste :default-user username :default-title title :default-contents text)) ((zerop (length title)) - (new-paste-form request :message "Please enter a title." :default-channel channel)) + (new-paste-form request :message "Please enter a title." :default-channel channel :annotate annotate-paste :default-user username :default-title title :default-contents text)) ((zerop (length text)) - (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." :default-channel channel)) + (new-paste-form request :message "Please enter your paste." :default-channel channel :annotate annotate-paste :default-user username :default-title title :default-contents text)) + ((and annotate (not annotate-paste)) + (new-paste-form request :message "Malformed annotation request." :default-channel channel :default-user username :default-title title :default-contents text)) ((not (member channel *channels* :test #'string-equal)) - (new-paste-form request :message "Whatever channel that is, I don't know about it." :default-channel channel)) + (new-paste-form request :message "Whatever channel that is, I don't know about it." :default-channel channel :annotate annotate-paste :default-user username :default-title title :default-contents text)) (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)))