Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2
Modified Files: web-server.lisp Log Message: MORE RAW SOURCE
Date: Mon Feb 23 14:56:50 2004 Author: bmastenbrook
Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.28 lisppaste2/web-server.lisp:1.29 --- lisppaste2/web-server.lisp:1.28 Tue Feb 17 18:56:41 2004 +++ lisppaste2/web-server.lisp Mon Feb 23 14:56:49 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.28 2004/02/17 23:56:41 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.29 2004/02/23 19:56:49 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
;;;; See the LICENSE file for licensing information. @@ -230,69 +230,91 @@ (p "If you wish to paste a correction or addendum to this paste, you can annotate the paste using the submission button on the " ((a :href ,url) "paste's page.")) ,@(bottom-links))))))))))
+(defun ends-with (str end) + (let ((l1 (length str)) + (l2 (length end))) + (if (< l1 l2) nil + (string= (subseq str (- l1 l2) l1) end)))) + (defmethod araneida:handle-request-response ((handler display-paste-handler) method request) - (araneida:request-send-headers request :expires 0) ; XXX request-unhandled-part will be exported in 0.81 (let* ((paste-number (parse-integer (araneida::request-unhandled-part request) :junk-allowed t)) + (raw (ends-with (araneida::request-unhandled-part request) "/raw")) (paste (some #'(lambda (element) (and (eql paste-number (paste-number element)) element)) *pastes*))) (if paste - (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) + (if raw + (let ((p (position #, (araneida::request-unhandled-part request) :test #'char=))) + (if p (let ((ann (parse-integer (araneida::request-unhandled-part request) :start (1+ p) :junk-allowed t))) + (let ((theann (car (member ann (paste-annotations paste) :key #'paste-number :test #'=)))) + (if theann + (progn + (araneida:request-send-headers request :expires 0 :content-type "text/plain") + (write-string (paste-contents theann) (araneida:request-stream request)))))) + (progn + (araneida:request-send-headers request :expires 0 :content-type "text/plain") + (write-string (paste-contents paste) (araneida:request-stream request))))) + (progn + (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 "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%") ((a :href ,(concatenate 'string (araneida:urlstring (araneida:request-url request)) "/raw")) "(raw source)"))) + (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) + ((td :align "left") ((a :href ,(format nil "~A,~A/raw" (araneida:urlstring (araneida:request-url request)) (paste-number a))) "(raw source)"))) + (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 ((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))))) + (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 + (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)