March 2004 - lisppaste-cvs@lists.common-lisp.net

[Lisppaste-cvs] CVS update: lisppaste2/encode-for-pre.lisp lisppaste2/web-server.lisp
by Brian Mastenbrook 07 Mar '04

07 Mar '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv16513 Modified Files: encode-for-pre.lisp web-server.lisp Log Message: make RSS not one big long line Date: Sun Mar 7 15:40:20 2004 Author: bmastenbrook Index: lisppaste2/encode-for-pre.lisp diff -u lisppaste2/encode-for-pre.lisp:1.10 lisppaste2/encode-for-pre.lisp:1.11 --- lisppaste2/encode-for-pre.lisp:1.10 Sun Mar 7 09:18:26 2004 +++ lisppaste2/encode-for-pre.lisp Sun Mar 7 15:40:20 2004 @@ -1,4 +1,4 @@ -;;;; $Id: encode-for-pre.lisp,v 1.10 2004/03/07 14:18:26 bmastenbrook Exp $ +;;;; $Id: encode-for-pre.lisp,v 1.11 2004/03/07 20:40:20 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -42,3 +42,6 @@ (defun encode-for-tt (str) (replace-in-string-1 (replace-in-string str '(#\& #\< #\> #\newline #\return #\linefeed #\tab) '("&" "<" ">" "<br>" "" "" "    ")) #\space " " t)) + +(defun encode-for-http (str) + (replace-in-string-1 str #\> (format nil ">~%") nil)) Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.40 lisppaste2/web-server.lisp:1.41 --- lisppaste2/web-server.lisp:1.40 Sun Mar 7 15:09:19 2004 +++ lisppaste2/web-server.lisp Sun Mar 7 15:40:20 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.40 2004/03/07 20:09:19 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.41 2004/03/07 20:40:20 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -190,13 +190,14 @@ (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))))) + (encode-for-http + (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)))) #\Return #\Linefeed)) (if discriminate-channel

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Brian Mastenbrook 07 Mar '04

07 Mar '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv12410 Modified Files: web-server.lisp Log Message: argh Date: Sun Mar 7 15:09:20 2004 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.39 lisppaste2/web-server.lisp:1.40 --- lisppaste2/web-server.lisp:1.39 Sun Mar 7 15:07:48 2004 +++ lisppaste2/web-server.lisp Sun Mar 7 15:09:19 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.39 2004/03/07 20:07:48 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.40 2004/03/07 20:09:19 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -202,7 +202,8 @@ (if discriminate-channel (remove discriminate-channel *pastes* :test-not #'string-equal :key #'paste-channel) - *pastes*))))))) + *pastes*)) + #\Return #\Linefeed))))) (defmethod araneida:handle-request-response ((handler rss-handler) method request) (handle-rss-request request))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Brian Mastenbrook 07 Mar '04

07 Mar '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv22817 Modified Files: web-server.lisp Log Message: small RSS fix I think Date: Sun Mar 7 15:07:48 2004 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.38 lisppaste2/web-server.lisp:1.39 --- lisppaste2/web-server.lisp:1.38 Sun Mar 7 14:55:53 2004 +++ lisppaste2/web-server.lisp Sun Mar 7 15:07:48 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.38 2004/03/07 19:55:53 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.39 2004/03/07 20:07:48 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -164,7 +164,7 @@ (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\"?>~%") + (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) :test #'char=)))) @@ -172,12 +172,12 @@ (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>~%" + "<channel><title>Lisppaste pastes~A</title><link>~A</link><description>Pastes in this pastebot~A</description>~{~A~}</channel>~C~C" (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>~%" + (format nil "<item><link>~A</link><pubDate>~A</pubDate><title>\"~A\" by ~A</title><description>~A</description></item>~C~C" (concatenate 'string (araneida:urlstring (araneida:merge-url *display-paste-url* @@ -197,7 +197,8 @@ #'(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)))))) + (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)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Brian Mastenbrook 07 Mar '04

07 Mar '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv22912 Modified Files: web-server.lisp Log Message: Reverse paste list Date: Sun Mar 7 14:55:54 2004 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.37 lisppaste2/web-server.lisp:1.38 --- lisppaste2/web-server.lisp:1.37 Sun Mar 7 14:52:57 2004 +++ lisppaste2/web-server.lisp Sun Mar 7 14:55:53 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.37 2004/03/07 19:52:57 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.38 2004/03/07 19:55:53 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -148,7 +148,7 @@ (p) ((table :width "100%" :cellpadding 2) (tr (td) (td "By") (td "Where") (td "When") (td "Titled") (td "Ann.")) - ,@(reverse (mapcar #'(lambda (paste) + ,@(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))) @@ -159,7 +159,7 @@ (if discriminate-channel (remove discriminate-channel *pastes* :test-not #'string-equal :key #'paste-channel) - *pastes*)))) + *pastes*))) ,@(bottom-links)))))) (defun handle-rss-request (request &key full)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/variable.lisp lisppaste2/web-server.lisp
by Brian Mastenbrook 07 Mar '04

07 Mar '04

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)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/lisppaste.asd lisppaste2/lisppaste.lisp lisppaste2/persistent-pastes.lisp lisppaste2/web-server.lisp
by Brian Mastenbrook 07 Mar '04

07 Mar '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv16166 Modified Files: lisppaste.asd lisppaste.lisp persistent-pastes.lisp web-server.lisp Log Message: better persistent pastes, big diff in web-server due to M-x untabify Date: Sun Mar 7 13:16:27 2004 Author: bmastenbrook Index: lisppaste2/lisppaste.asd diff -u lisppaste2/lisppaste.asd:1.6 lisppaste2/lisppaste.asd:1.7 --- lisppaste2/lisppaste.asd:1.6 Sat Mar 6 23:44:56 2004 +++ lisppaste2/lisppaste.asd Sun Mar 7 13:16:27 2004 @@ -1,5 +1,5 @@ ;;;; Silly emacs, this is -*- Lisp -*- -;;;; $Id: lisppaste.asd,v 1.6 2004/03/07 04:44:56 bmastenbrook Exp $ +;;;; $Id: lisppaste.asd,v 1.7 2004/03/07 18:16:27 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -27,9 +27,9 @@ :depends-on ("package")) (:file "encode-for-pre" :depends-on ("variable")) - (:file "web-server" - :depends-on ("encode-for-pre")) (:file "lisppaste" - :depends-on ("web-server")) + :depends-on ("variable")) + (:file "web-server" + :depends-on ("encode-for-pre" "web-server")) (:file "persistent-pastes" :depends-on ("web-server")))) Index: lisppaste2/lisppaste.lisp diff -u lisppaste2/lisppaste.lisp:1.11 lisppaste2/lisppaste.lisp:1.12 --- lisppaste2/lisppaste.lisp:1.11 Sun Mar 7 01:39:56 2004 +++ lisppaste2/lisppaste.lisp Sun Mar 7 13:16:27 2004 @@ -1,4 +1,4 @@ -;;;; $Id: lisppaste.lisp,v 1.11 2004/03/07 06:39:56 bmastenbrook Exp $ +;;;; $Id: lisppaste.lisp,v 1.12 2004/03/07 18:16:27 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -61,4 +61,4 @@ (push ,paste-name ,annotate-list) (push ,paste-name ,paste-list)) `(push ,paste-name ,paste-list)) - (save-pastes-to-file *paste-file*)))) + (serialize-transaction "pastes.lisp-expr" ,paste-name (if ,annotate ,real-number))))) Index: lisppaste2/persistent-pastes.lisp diff -u lisppaste2/persistent-pastes.lisp:1.6 lisppaste2/persistent-pastes.lisp:1.7 --- lisppaste2/persistent-pastes.lisp:1.6 Tue Feb 3 21:41:12 2004 +++ lisppaste2/persistent-pastes.lisp Sun Mar 7 13:16:27 2004 @@ -7,37 +7,64 @@ (cons 'title (paste-title paste)) (cons 'contents (paste-contents paste)) (cons 'universal-time (paste-universal-time paste)) - (cons 'channel (paste-channel paste)) - (cons 'annotations (mapcar #'paste-alist (paste-annotations paste))) - (cons 'log-link (paste-log-link paste)))) + (cons 'channel (paste-channel paste)))) + +(defun serialized-initial-paste (paste) + (cons 'make-paste (paste-alist paste))) + +(defun serialized-annotation (of paste) + (list* 'annotate-paste of (paste-alist paste))) + +(defun paste-list-alist (paste) + (list* + (serialized-initial-paste paste) + (nreverse + (mapcar #'(lambda (e) + (serialized-annotation (paste-number paste) e)) (paste-annotations paste))))) (defun save-pastes-to-file (file-name) (let ((*package* (find-package :lisppaste))) (with-open-file (file file-name :direction :output :if-exists :supersede) (let ((*print-readably* t)) - (format file "~A~%" (prin1-to-string - (mapcar #'paste-alist *pastes*))))))) + (format file "~{~S~%~}" (mapcan #'paste-list-alist (reverse *pastes*))))))) + +(defun serialize-transaction (file-name paste &optional annotate-number) + (let ((*package* (find-package :lisppaste))) + (with-open-file (file file-name :direction :output :if-exists :append) + (let ((*print-readably* t)) + (if annotate-number + (format file "~S~%" (serialized-annotation annotate-number paste)) + (format file "~S~%" (serialized-initial-paste paste))))))) (defmacro with-assoc-vals (entry-list alist &body body) `(let ,(mapcar #'(lambda (e) (list e `(cdr (assoc ',e ,alist)))) entry-list) ,@body)) -(defun make-paste-from-alist (e &optional annotation) - (with-assoc-vals (number user title contents universal-time annotations channel log-link) e - (unless annotation (setf *paste-counter* (max *paste-counter* number))) +(defun make-paste-from-alist (e &optional annotate) + (with-assoc-vals (number user title contents universal-time channel) e + (if annotate + (setf (paste-annotation-counter annotate) (max (paste-annotation-counter annotate) number)) + (setf *paste-counter* (max *paste-counter* number))) (make-paste :number number :user user :title title :contents contents :universal-time universal-time - :channel (if (not channel) (car *channels*) channel) - :annotations (mapcar #'(lambda (e) (make-paste-from-alist e)) annotations) - :log-link (if (not log-link) "" log-link)))) + :channel channel + :annotations nil))) + +(defun deserialize (expr) + (ecase (car expr) + (make-paste (push (make-paste-from-alist (cdr expr)) *pastes*)) + (annotate-paste (let ((paste (find (second expr) *pastes* :key #'paste-number))) + (push (make-paste-from-alist (cddr expr) paste) (paste-annotations paste)))))) (defun read-pastes-from-file (file-name) (setf *pastes* nil) (let ((*package* (find-package :lisppaste))) (with-open-file (file file-name :direction :input :if-does-not-exist nil) (if file - (let ((paste-alist (read file nil))) - (setf *pastes* (mapcar #'make-paste-from-alist paste-alist))))))) + (loop (let ((paste (read file nil))) + (if paste + (deserialize paste) + (return-from read-pastes-from-file t)))))))) Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.35 lisppaste2/web-server.lisp:1.36 --- lisppaste2/web-server.lisp:1.35 Sun Mar 7 01:39:56 2004 +++ lisppaste2/web-server.lisp Sun Mar 7 13:16:27 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.35 2004/03/07 06:39:56 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.36 2004/03/07 18:16:27 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -14,8 +14,7 @@ (is-annotation nil :type boolean) (annotations nil :type list) (annotation-counter 0 :type integer) - (channel "" :type string) - (log-link "" :type string)) + (channel "" :type string)) (defclass new-paste-handler (araneida:handler) ()) @@ -30,8 +29,8 @@ (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)))) + (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))) (defun bottom-links () @@ -53,35 +52,35 @@ (defun irc-log-link (utime channel) (format nil "http://meme.b9.com/now?utime=~A&channel=~A" - utime - (string-left-trim "#" channel))) + utime + (string-left-trim "#" channel))) (defun first-<-mod (n &rest nums) (some #'(lambda (n2) - (if (< n2 n) (mod n n2) nil)) nums)) + (if (< n2 n) (mod n n2) nil)) nums)) (defun time-delta-primitive (delta &optional (level 2)) (let* ((seconds 60) - (minutes (* seconds 60)) - (hours (* minutes 24)) - (days (* hours 7)) - (weeks (* days 487/16)) - (months (* weeks 12)) - (years (* hours (+ 365 1/4)))) + (minutes (* seconds 60)) + (hours (* minutes 24)) + (days (* hours 7)) + (weeks (* days 487/16)) + (months (* weeks 12)) + (years (* hours (+ 365 1/4)))) (let ((primitive - (cond - ((< delta seconds) (format nil "~D second~:P" delta)) - ((< delta minutes) (format nil "~D minute~:P" (floor delta seconds))) - ((< delta hours) (format nil "~D hour~:P" (floor delta minutes))) - ((< delta days) (format nil "~D day~:P" (floor delta hours))) - ((< delta weeks) (format nil "~D week~:P" (floor delta days))) - ((< delta months) (format nil "~D month~:P" (floor delta weeks))) - (t (format nil "~D years" (floor delta years)))))) + (cond + ((< delta seconds) (format nil "~D second~:P" delta)) + ((< delta minutes) (format nil "~D minute~:P" (floor delta seconds))) + ((< delta hours) (format nil "~D hour~:P" (floor delta minutes))) + ((< delta days) (format nil "~D day~:P" (floor delta hours))) + ((< delta weeks) (format nil "~D week~:P" (floor delta days))) + ((< delta months) (format nil "~D month~:P" (floor delta weeks))) + (t (format nil "~D years" (floor delta years)))))) (if (eql level 1) primitive - (format nil "~A, ~A" primitive - (time-delta-primitive - (first-<-mod delta years months weeks days hours minutes seconds) - (1- level))))))) + (format nil "~A, ~A" primitive + (time-delta-primitive + (first-<-mod delta years months weeks days hours minutes seconds) + (1- level))))))) (defun rss-link-header () `((link :rel "alternate" :type "application/rss+xml" :title "Lisppaste RSS" :href ,(araneida:urlstring *rss-url*)))) @@ -98,20 +97,20 @@ (araneida:request-stream request) `(html (head (title "All pastes") - ,(rss-link-header)) + ,(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))) + `(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*))) + ((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))))) (defmethod araneida:handle-request-response ((handler rss-handler) method request) @@ -149,9 +148,9 @@ (p "Enter a username, title, and paste contents into the fields below. The paste will be announced on the selected channel @ " ,(irc:server-name *connection*) ".") ,@(if annotate - `((p "This paste will be used to annotate " - ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number annotate))))) ,(concatenate 'string (paste-title annotate) "."))) - ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number annotate)))) + `((p "This paste will be used to annotate " + ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number annotate))))) ,(concatenate 'string (paste-title annotate) "."))) + ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number annotate)))) ((input :type hidden :name "channel" :value ,(paste-channel annotate))))) (hr) (table @@ -169,7 +168,7 @@ ((th :valign top) "Enter your paste:") (td ((textarea :rows 24 :cols 80 :name "text")))) (tr - ((th) "Submit your paste:") + ((th) "Submit your paste:") ((td) ((input :type submit :value "Submit paste")) " " ((input :type reset :value "Clear paste")))))) ,@(bottom-links))))) @@ -177,7 +176,7 @@ (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 (araneida:body-param "annotate" (araneida:request-body request))) (channel (araneida:body-param "channel" (araneida:request-body request)))) (araneida:request-send-headers request) @@ -194,15 +193,15 @@ (new-paste-form request :message "Whatever channel that is, I don't know about it.")) (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))) - (annotation-number (if annotate (incf (paste-annotation-counter paste-to-annotate))))) - (let ((url (araneida:urlstring - (araneida:merge-url *display-paste-url* - (if annotate - (concatenate 'string (prin1-to-string paste-number) - "#" - (prin1-to-string annotation-number)) - (prin1-to-string paste-number)))))) + (paste-to-annotate (if annotate (find paste-number *pastes* :key #'paste-number))) + (annotation-number (if annotate (incf (paste-annotation-counter paste-to-annotate))))) + (let ((url (araneida:urlstring + (araneida:merge-url *display-paste-url* + (if annotate + (concatenate 'string (prin1-to-string paste-number) + "#" + (prin1-to-string annotation-number)) + (prin1-to-string paste-number)))))) (make-new-paste *pastes* (annotate paste-number (paste-annotations paste-to-annotate)) @@ -213,21 +212,21 @@ :contents text :universal-time (get-universal-time) :channel 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) - `(html - (head (title "Paste number " ,*paste-counter*) + (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-counter*) ,(rss-link-header)) - (body - (h1 "Pasted!") - (p ,(if annotate "Your annotation should be available at " "Your paste should be available at ") ((a :href ,url) ,url) ", and was also sent to " ,channel " @ " ,(irc:server-name *connection*)) - (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)))))))))) + (body + (h1 "Pasted!") + (p ,(if annotate "Your annotation should be available at " "Your paste should be available at ") ((a :href ,url) ,url) ", and was also sent to " ,channel " @ " ,(irc:server-name *connection*)) + (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))) + (l2 (length end))) (if (< l1 l2) nil (string= (subseq str (- l1 l2) l1) end)))) @@ -257,37 +256,37 @@ (let* ((paste-number (parse-integer (araneida::request-unhandled-part request) :junk-allowed t)) - (raw (ends-with (araneida::request-unhandled-part request) "/raw")) + (raw (ends-with (araneida::request-unhandled-part request) "/raw")) (paste (some #'(lambda (element) (and (eql paste-number (paste-number element)) element)) *pastes*))) (if 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 (remove #\Return - (paste-contents theann) - :test #'char=) (araneida:request-stream request)))))) - (progn - (araneida:request-send-headers request :expires 0 :content-type "text/plain") - (write-string (remove #\return - (paste-contents paste) - :test #'char=)(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 - ,(format-paste paste (araneida:urlstring (araneida:request-url request)) paste-number) + (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 (remove #\Return + (paste-contents theann) + :test #'char=) (araneida:request-stream request)))))) + (progn + (araneida:request-send-headers request :expires 0 :content-type "text/plain") + (write-string (remove #\return + (paste-contents paste) + :test #'char=)(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 + ,(format-paste paste (araneida:urlstring (araneida:request-url request)) paste-number) ,(if (paste-annotations paste) `(p "Annotations for this paste: " @@ -299,14 +298,14 @@ (araneida:urlstring (araneida:request-url request)) (paste-number a)) (paste-number a) t))) (reverse (paste-annotations paste))))) - `(p "This paste has no annotations.")) - ((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)))))) + `(p "This paste has no annotations.")) + ((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: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 @@ -315,7 +314,7 @@ ,(rss-link-header)) (body (h3 "No paste numbered " ,paste-number " could be found.") - ,@(bottom-links)))))))) + ,@(bottom-links)))))))) (araneida:install-handler (araneida:http-listener-handler *paste-listener*)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/encode-for-pre.lisp
by Brian Mastenbrook 07 Mar '04

07 Mar '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv18011 Modified Files: encode-for-pre.lisp Log Message: argh, fix xml-rpc multiline pastes Date: Sun Mar 7 09:18:26 2004 Author: bmastenbrook Index: lisppaste2/encode-for-pre.lisp diff -u lisppaste2/encode-for-pre.lisp:1.9 lisppaste2/encode-for-pre.lisp:1.10 --- lisppaste2/encode-for-pre.lisp:1.9 Tue Feb 3 21:54:24 2004 +++ lisppaste2/encode-for-pre.lisp Sun Mar 7 09:18:26 2004 @@ -1,4 +1,4 @@ -;;;; $Id: encode-for-pre.lisp,v 1.9 2004/02/04 02:54:24 bmastenbrook Exp $ +;;;; $Id: encode-for-pre.lisp,v 1.10 2004/03/07 14:18:26 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -41,4 +41,4 @@ (replace-in-string str '(#\& #\< #\>) '("&" "<" ">"))) (defun encode-for-tt (str) - (replace-in-string-1 (replace-in-string str '(#\& #\< #\> #\newline #\return #\linefeed #\tab) '("&" "<" ">" "" "<br>" "" "    ")) #\space " " t)) + (replace-in-string-1 (replace-in-string str '(#\& #\< #\> #\newline #\return #\linefeed #\tab) '("&" "<" ">" "<br>" "" "" "    ")) #\space " " t))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/lisppaste.lisp lisppaste2/web-server.lisp lisppaste2/xml-paste.lisp
by Brian Mastenbrook 07 Mar '04

07 Mar '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv26305 Modified Files: lisppaste.lisp web-server.lisp xml-paste.lisp Log Message: small changes Date: Sun Mar 7 01:39:56 2004 Author: bmastenbrook Index: lisppaste2/lisppaste.lisp diff -u lisppaste2/lisppaste.lisp:1.10 lisppaste2/lisppaste.lisp:1.11 --- lisppaste2/lisppaste.lisp:1.10 Sat Mar 6 23:44:56 2004 +++ lisppaste2/lisppaste.lisp Sun Mar 7 01:39:56 2004 @@ -1,4 +1,4 @@ -;;;; $Id: lisppaste.lisp,v 1.10 2004/03/07 04:44:56 bmastenbrook Exp $ +;;;; $Id: lisppaste.lisp,v 1.11 2004/03/07 06:39:56 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -48,13 +48,13 @@ (add-hook nickname) (irc:read-message-loop *connection*)) -(defmacro make-new-paste (paste-list (&optional annotate annotate-list) url &rest keys - &key channel user number title &allow-other-keys) +(defmacro make-new-paste (paste-list (&optional annotate real-number annotate-list) url &rest keys + &key channel user title &allow-other-keys) (let ((paste-name (gensym))) `(let ((,paste-name (make-paste ,@keys))) (irc:privmsg *connection* ,channel (if ,annotate - (format nil "~A annotated #~A with \"~A\" at ~A" ,user ,number ,title ,url) + (format nil "~A annotated #~A with \"~A\" at ~A" ,user ,real-number ,title ,url) (format nil "~A pasted \"~A\" at ~A" ,user ,title ,url))) ,(if annotate `(if ,annotate Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.34 lisppaste2/web-server.lisp:1.35 --- lisppaste2/web-server.lisp:1.34 Sun Mar 7 00:16:24 2004 +++ lisppaste2/web-server.lisp Sun Mar 7 01:39:56 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.34 2004/03/07 05:16:24 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.35 2004/03/07 06:39:56 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -205,7 +205,7 @@ (prin1-to-string paste-number)))))) (make-new-paste *pastes* - (annotate (paste-annotations paste-to-annotate)) + (annotate paste-number (paste-annotations paste-to-annotate)) url :number (if annotate annotation-number paste-number) :user username Index: lisppaste2/xml-paste.lisp diff -u lisppaste2/xml-paste.lisp:1.1 lisppaste2/xml-paste.lisp:1.2 --- lisppaste2/xml-paste.lisp:1.1 Sat Mar 6 23:45:16 2004 +++ lisppaste2/xml-paste.lisp Sun Mar 7 01:39:56 2004 @@ -8,25 +8,56 @@ (format nil "Error encountered: ~S" c))))) (cond ((string-equal method-name "newpaste") (destructuring-bind - (paste-channel paste-user paste-title paste-contents) args - (if (not (every #'stringp args)) + (paste-channel paste-user paste-title paste-contents &optional annotate) args + (if (not (every #'stringp (list paste-channel paste-user paste-title paste-contents))) "Error: all arguments must be strings." - (if (not (every (lambda (s) (> (length s) 0)) args)) + (if (not (every (lambda (s) (> (length s) 0)) (list paste-channel paste-user paste-title paste-contents))) "Error: all arguments must be non-empty strings." - (if (not (member paste-channel *channels* :test #'string-equal)) - (format nil "Error: invalid channel ~S." paste-channel) - (let* ((number (incf *paste-counter*)) - (url (araneida:urlstring - (araneida:merge-url *display-paste-url* - (prin1-to-string number))))) - (make-new-paste *pastes* nil - url - :number number - :user paste-user - :title paste-title - :contents paste-contents - :universal-time (get-universal-time) - :channel paste-channel) - (format nil "Your paste has been announced to ~A and is available at ~A ." - paste-channel url))))))) + (let ((annotate-this (if annotate (find annotate *pastes* :key #'paste-number)))) + (if (if annotate + (not (string-equal paste-channel (paste-channel annotate-this))) + (not (member paste-channel *channels* :test #'string-equal))) + (format nil "Error: invalid channel ~S." paste-channel) + (let* ((number (if annotate + (incf (paste-annotation-counter annotate-this)) + (incf *paste-counter*))) + (url (araneida:urlstring + (araneida:merge-url *display-paste-url* + (if annotate + (format nil "~A#~A" + (paste-number annotate-this) + number) + (prin1-to-string number)))))) + (make-new-paste *pastes* (annotate + (paste-number annotate-this) + (paste-annotations annotate-this)) + url + :number number + :user paste-user + :title paste-title + :contents paste-contents + :universal-time (get-universal-time) + :channel paste-channel) + (format nil "Your paste has been announced to ~A and is available at ~A ." + paste-channel url)))))))) + ((string-equal method-name "pasteheaders") + (nreverse + (mapcar #'(lambda (paste) + (list (paste-number paste) + (xml-rpc:xml-rpc-time (paste-universal-time paste)) + (paste-user paste) + (paste-channel paste) + (paste-title paste) + (length (paste-annotations paste)))) + (if args (paste-annotations (find (car args) *pastes* :key #'paste-number :test #'eql)) + *pastes*)))) + ((string-equal method-name "pastecontents") + (if (eql (length args) 1) + (paste-contents (find (car args) *pastes* :key #'paste-number :test #'eql)) + (if (eql (length args) 2) + (paste-contents + (find (second args) + (paste-annotations (find (car args) *pastes* :key #'paste-number :test #'eql)) + :key #'paste-number :test #'eql)) + "Error: Invalid number of arguments."))) (t (format nil "Error: unimplemented method ~S." method-name)))))))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Brian Mastenbrook 07 Mar '04

07 Mar '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv19200 Modified Files: web-server.lisp Log Message: cvs: the poor man's scp Date: Sun Mar 7 00:16:24 2004 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.33 lisppaste2/web-server.lisp:1.34 --- lisppaste2/web-server.lisp:1.33 Sun Mar 7 00:15:03 2004 +++ lisppaste2/web-server.lisp Sun Mar 7 00:16:24 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.33 2004/03/07 05:15:03 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.34 2004/03/07 05:16:24 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -290,14 +290,14 @@ ,(format-paste paste (araneida:urlstring (araneida:request-url request)) paste-number) ,(if (paste-annotations paste) `(p - "Annotations for this paste: " (hr) + "Annotations for this paste: " ,@(reduce #'append (mapcar #'(lambda (a) - `(,(format-paste a + `((hr) + ,(format-paste a (format nil "~A,~A" (araneida:urlstring (araneida:request-url request)) - (paste-number a)) (paste-number a) t) - (p))) + (paste-number a)) (paste-number a) t))) (reverse (paste-annotations paste))))) `(p "This paste has no annotations.")) ((form :method post :action ,(araneida:urlstring *new-paste-url*))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Brian Mastenbrook 07 Mar '04

07 Mar '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv8288 Modified Files: web-server.lisp Log Message: more formatting fixups Date: Sun Mar 7 00:15:03 2004 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.32 lisppaste2/web-server.lisp:1.33 --- lisppaste2/web-server.lisp:1.32 Sun Mar 7 00:11:08 2004 +++ lisppaste2/web-server.lisp Sun Mar 7 00:15:03 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.32 2004/03/07 05:11:08 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.33 2004/03/07 05:15:03 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -291,11 +291,14 @@ ,(if (paste-annotations paste) `(p "Annotations for this paste: " (hr) - ,@(nreverse - (mapcar #'(lambda (a) - (format-paste a - (format nil "~A,~A" (araneida:urlstring (araneida:request-url request)) (paste-number a)) (paste-number a) t)) - (paste-annotations paste)))) + ,@(reduce #'append + (mapcar #'(lambda (a) + `(,(format-paste a + (format nil "~A,~A" + (araneida:urlstring (araneida:request-url request)) + (paste-number a)) (paste-number a) t) + (p))) + (reverse (paste-annotations paste))))) `(p "This paste has no annotations.")) ((form :method post :action ,(araneida:urlstring *new-paste-url*)) ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number paste))))

1 0