[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
Brian Mastenbrook
bmastenbrook at common-lisp.net
Mon Feb 23 19:56:50 UTC 2004
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)
More information about the Lisppaste-cvs
mailing list