From bmastenbrook at common-lisp.net Wed Mar 3 03:43:05 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Tue, 02 Mar 2004 22:43:05 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/lisppaste.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: lisppaste.lisp Log Message: msg for help Date: Tue Mar 2 22:43:05 2004 Author: bmastenbrook Index: lisppaste2/lisppaste.lisp diff -u lisppaste2/lisppaste.lisp:1.8 lisppaste2/lisppaste.lisp:1.9 --- lisppaste2/lisppaste.lisp:1.8 Tue Feb 10 11:17:52 2004 +++ lisppaste2/lisppaste.lisp Tue Mar 2 22:43:04 2004 @@ -1,10 +1,21 @@ -;;;; $Id: lisppaste.lisp,v 1.8 2004/02/10 16:17:52 bmastenbrook Exp $ +;;;; $Id: lisppaste.lisp,v 1.9 2004/03/03 03:43:04 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.lisp,v $ ;;;; See the LICENSE file for licensing information. (in-package :lisppaste) +(defun make-msg-hook (nick) + (lambda (message) + (if (string= (first (irc:arguments message)) nick) + (irc:privmsg *connection* + (irc:source message) + (format nil "To use the lisppaste bot, visit ~A and enter your paste. Be sure to select the right channel!" (araneida:urlstring *new-paste-url*)))))) + +(defun add-hook (nick) + (irc:remove-hooks *connection* 'irc:irc-privmsg-message) + (irc:add-hook *connection* 'irc:irc-privmsg-message (make-msg-hook nick))) + (defun start-lisppaste (&key (channels (list *default-channel*)) (nickname *default-nickname*) (server *default-irc-server*) @@ -20,6 +31,7 @@ (read-pastes-from-file *paste-file*) (mapcar #'(lambda (channel) (irc:join connection channel)) channels) (araneida:start-listening *paste-listener*) + (add-hook nickname) (irc:read-message-loop connection))) (defun join-new-channel (channel) @@ -33,4 +45,5 @@ :server server :port *default-irc-server-port*)) (mapcar #'(lambda (channel) (irc:join *connection* channel)) *channels*) + (add-hook nickname) (irc:read-message-loop *connection*)) From bmastenbrook at common-lisp.net Sun Mar 7 02:05:51 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Sat, 06 Mar 2004 21:05:51 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: web-server.lisp Log Message: no more CR in raw source Date: Sat Mar 6 21:05:51 2004 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.29 lisppaste2/web-server.lisp:1.30 --- lisppaste2/web-server.lisp:1.29 Mon Feb 23 14:56:49 2004 +++ lisppaste2/web-server.lisp Sat Mar 6 21:05:51 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.29 2004/02/23 19:56:49 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.30 2004/03/07 02:05:51 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -253,10 +253,14 @@ (if theann (progn (araneida:request-send-headers request :expires 0 :content-type "text/plain") - (write-string (paste-contents theann) (araneida:request-stream request)))))) + (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 (paste-contents paste) (araneida:request-stream request))))) + (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) "") From bmastenbrook at common-lisp.net Sun Mar 7 04:44:56 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Sat, 06 Mar 2004 23:44:56 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/lisppaste.asd lisppaste2/lisppaste.lisp lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv32064 Modified Files: lisppaste.asd lisppaste.lisp web-server.lisp Log Message: Code cleanup Date: Sat Mar 6 23:44:56 2004 Author: bmastenbrook Index: lisppaste2/lisppaste.asd diff -u lisppaste2/lisppaste.asd:1.5 lisppaste2/lisppaste.asd:1.6 --- lisppaste2/lisppaste.asd:1.5 Tue Feb 17 18:57:19 2004 +++ lisppaste2/lisppaste.asd Sat Mar 6 23:44:56 2004 @@ -1,5 +1,5 @@ ;;;; Silly emacs, this is -*- Lisp -*- -;;;; $Id: lisppaste.asd,v 1.5 2004/02/17 23:57:19 bmastenbrook Exp $ +;;;; $Id: lisppaste.asd,v 1.6 2004/03/07 04:44:56 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -28,7 +28,7 @@ (:file "encode-for-pre" :depends-on ("variable")) (:file "web-server" - :depends-on ("encode-for-pre" "irc-log-link")) + :depends-on ("encode-for-pre")) (:file "lisppaste" :depends-on ("web-server")) (:file "persistent-pastes" Index: lisppaste2/lisppaste.lisp diff -u lisppaste2/lisppaste.lisp:1.9 lisppaste2/lisppaste.lisp:1.10 --- lisppaste2/lisppaste.lisp:1.9 Tue Mar 2 22:43:04 2004 +++ lisppaste2/lisppaste.lisp Sat Mar 6 23:44:56 2004 @@ -1,4 +1,4 @@ -;;;; $Id: lisppaste.lisp,v 1.9 2004/03/03 03:43:04 bmastenbrook Exp $ +;;;; $Id: lisppaste.lisp,v 1.10 2004/03/07 04:44:56 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -32,7 +32,7 @@ (mapcar #'(lambda (channel) (irc:join connection channel)) channels) (araneida:start-listening *paste-listener*) (add-hook nickname) - (irc:read-message-loop connection))) + (irc:start-background-message-handler connection))) (defun join-new-channel (channel) (setf *channels* (nconc *channels* (list channel))) @@ -46,4 +46,19 @@ :port *default-irc-server-port*)) (mapcar #'(lambda (channel) (irc:join *connection* channel)) *channels*) (add-hook nickname) - (irc:read-message-loop *connection*)) \ No newline at end of file + (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) + (let ((paste-name (gensym))) + `(let ((,paste-name (make-paste , at keys))) + (irc:privmsg *connection* ,channel + (if ,annotate + (format nil "~A annotated #~A with \"~A\" at ~A" ,user ,number ,title ,url) + (format nil "~A pasted \"~A\" at ~A" ,user ,title ,url))) + ,(if annotate + `(if ,annotate + (push ,paste-name ,annotate-list) + (push ,paste-name ,paste-list)) + `(push ,paste-name ,paste-list)) + (save-pastes-to-file *paste-file*)))) Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.30 lisppaste2/web-server.lisp:1.31 --- lisppaste2/web-server.lisp:1.30 Sat Mar 6 21:05:51 2004 +++ lisppaste2/web-server.lisp Sat Mar 6 23:44:56 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.30 2004/03/07 02:05:51 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.31 2004/03/07 04:44:56 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -202,22 +202,17 @@ (concatenate 'string (prin1-to-string paste-number) "#" (prin1-to-string annotation-number)) - (prin1-to-string paste-number))))) - (paste (make-paste :number (if annotate annotation-number paste-number) - :user username - :title title - :contents text - :universal-time (get-universal-time) - :channel channel - ))) - (irc:privmsg *connection* channel - (if annotate - (format nil "~A annotated #~A with \"~A\" at ~A" username paste-number title url) - (format nil "~A pasted \"~A\" at ~A" username title url))) - (if annotate - (push paste (paste-annotations paste-to-annotate)) - (push paste *pastes*)) - (save-pastes-to-file *paste-file*) + (prin1-to-string paste-number)))))) + (make-new-paste + *pastes* + (annotate (paste-annotations paste-to-annotate)) + url + :number (if annotate annotation-number paste-number) + :user username + :title title + :contents text + :universal-time (get-universal-time) + :channel channel) (format (araneida:request-stream request) "") (araneida:html-stream (araneida:request-stream request) From bmastenbrook at common-lisp.net Sun Mar 7 04:45:16 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Sat, 06 Mar 2004 23:45:16 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/xml-paste.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv5416 Added Files: xml-paste.lisp Log Message: MORE BUZZWORDS Date: Sat Mar 6 23:45:16 2004 Author: bmastenbrook From bmastenbrook at common-lisp.net Sun Mar 7 05:11:08 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Sun, 07 Mar 2004 00:11:08 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv21802 Modified Files: web-server.lisp Log Message: cleanup, formatting change per Xach Date: Sun Mar 7 00:11:08 2004 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.31 lisppaste2/web-server.lisp:1.32 --- lisppaste2/web-server.lisp:1.31 Sat Mar 6 23:44:56 2004 +++ lisppaste2/web-server.lisp Sun Mar 7 00:11:08 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.31 2004/03/07 04:44:56 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.32 2004/03/07 05:11:08 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -231,6 +231,27 @@ (if (< l1 l2) nil (string= (subseq str (- l1 l2) l1) end)))) +(defun format-paste (paste this-url paste-number &optional annotation) + `((table :width "100%" :cellpadding 2) + (tr ((td :align "left" :width "0%" :nowrap "nowrap") + ,(if annotation + "Annotation number " + "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)))) + ,@(if (not annotation) + `((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 this-url "/raw")) "(raw source)"))) + (tr (td (p))) + (tr ((td :bgcolor "#F4F4F4" :colspan 2 :width "100%") (tt ,(encode-for-tt (paste-contents paste))))))) + (defmethod araneida:handle-request-response ((handler display-paste-handler) method request) ; XXX request-unhandled-part will be exported in 0.81 (let* ((paste-number (parse-integer @@ -266,48 +287,16 @@ (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 ((td :align "left" :colspan 2 :nowrap "nowrap") "This paste has no annotations."))))) - (p) + ,(format-paste paste (araneida:urlstring (araneida:request-url request)) paste-number) + ,(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)))) + `(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")))) From bmastenbrook at common-lisp.net Sun Mar 7 05:15:04 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Sun, 07 Mar 2004 00:15:04 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: 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)))) From bmastenbrook at common-lisp.net Sun Mar 7 05:16:24 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Sun, 07 Mar 2004 00:16:24 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: 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*)) From bmastenbrook at common-lisp.net Sun Mar 7 06:39:56 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Sun, 07 Mar 2004 01:39:56 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/lisppaste.lisp lisppaste2/web-server.lisp lisppaste2/xml-paste.lisp Message-ID: 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 , at 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))))))) From bmastenbrook at common-lisp.net Sun Mar 7 14:18:26 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Sun, 07 Mar 2004 09:18:26 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/encode-for-pre.lisp Message-ID: 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) '("&" "<" ">" "" "
" "" "    ")) #\space " " t)) + (replace-in-string-1 (replace-in-string str '(#\& #\< #\> #\newline #\return #\linefeed #\tab) '("&" "<" ">" "
" "" "" "    ")) #\space " " t)) From bmastenbrook at common-lisp.net Sun Mar 7 18:16:27 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Sun, 07 Mar 2004 13:16:27 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/lisppaste.asd lisppaste2/lisppaste.lisp lisppaste2/persistent-pastes.lisp lisppaste2/web-server.lisp Message-ID: 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) , at 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) "") - (araneida:html-stream - (araneida:request-stream request) - `(html - (head (title "Paste number " ,*paste-counter*) + (format (araneida:request-stream request) "") + (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) "") - (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) "") + (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) "") + (araneida:request-send-headers request :expires 0) + (format (araneida:request-stream request) "") (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*) From bmastenbrook at common-lisp.net Sun Mar 7 19:52:57 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Sun, 07 Mar 2004 14:52:57 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/variable.lisp lisppaste2/web-server.lisp Message-ID: 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) "") - (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) "~%") - (araneida:html-stream - (araneida:request-stream request) - `((|rss| :|version| "2.0") - ,(format nil - "Lisppaste pastes~APastes in this pastebot~{~A~}~%" - (araneida:urlstring *list-paste-url*) - (mapcar #'(lambda (paste) - (format nil "~A~A\"~A\" by ~A~A~%" - (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 + "Lisppaste pastes~A~APastes in this pastebot~A~{~A~}~%" + (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 "~A~A\"~A\" by ~A~A~%" + (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) "") (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) From bmastenbrook at common-lisp.net Sun Mar 7 19:55:54 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Sun, 07 Mar 2004 14:55:54 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: 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) From bmastenbrook at common-lisp.net Sun Mar 7 20:07:48 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Sun, 07 Mar 2004 15:07:48 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: 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) "~%") + (format (araneida:request-stream request) "~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 - "Lisppaste pastes~A~APastes in this pastebot~A~{~A~}~%" + "Lisppaste pastes~A~APastes in this pastebot~A~{~A~}~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 "~A~A\"~A\" by ~A~A~%" + (format nil "~A~A\"~A\" by ~A~A~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) From bmastenbrook at common-lisp.net Sun Mar 7 20:09:20 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Sun, 07 Mar 2004 15:09:20 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: 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)) From bmastenbrook at common-lisp.net Sun Mar 7 20:40:21 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Sun, 07 Mar 2004 15:40:21 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/encode-for-pre.lisp lisppaste2/web-server.lisp Message-ID: 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) '("&" "<" ">" "
" "" "" "    ")) #\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 From bmastenbrook at common-lisp.net Tue Mar 9 06:35:32 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Tue, 09 Mar 2004 01:35:32 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/xml-rpc-sbcl.patch Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv3554 Added Files: xml-rpc-sbcl.patch Log Message: temporary xml-rpc patch Date: Tue Mar 9 01:35:32 2004 Author: bmastenbrook From bmastenbrook at common-lisp.net Tue Mar 9 06:39:22 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Tue, 09 Mar 2004 01:39:22 -0500 Subject: [Lisppaste-cvs] CVS update: public_html/xml-rpc.html public_html/index.html Message-ID: Update of /project/lisppaste/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv4000 Modified Files: index.html Added Files: xml-rpc.html Log Message: RELEASE! RELEASE! Date: Tue Mar 9 01:39:22 2004 Author: bmastenbrook Index: public_html/index.html diff -u public_html/index.html:1.6 public_html/index.html:1.7 --- public_html/index.html:1.6 Mon Feb 23 09:56:32 2004 +++ public_html/index.html Tue Mar 9 01:39:22 2004 @@ -1,4 +1,4 @@ - + Lisppaste, a paste bot in CL @@ -7,21 +7,32 @@

Lisppaste, a paste bot in CL

-

For those of you who frequent #lisp, you should be well aware - of 'lisppaste' - you'll find the sources for that program here. - 'lisppaste' is a small CL program that listens for connection - through HTTP (users pasting text) and prints a link to the paste - on IRC. 'lisppaste' on #lisp is available through common-lisp.net - here. - -

Compared to the perl version - a lot of people use, lisppaste features paste annotations, useful - paste timestamps, and a listing page for all pastes in the system. +

For those of you who frequent #lisp (and many other channels on + freenode), you should be well aware of 'lisppaste' - you'll find + the sources for that program here. 'lisppaste' is a small CL + program that listens for connection through HTTP (users pasting + text) and prints a link to the paste on IRC. 'lisppaste' on #lisp + is available through common-lisp.net here. + +

Lisppaste is the buzzword-enabled pastebot. Compared to the + generic perl + version, Lisppaste offers basic amenities like paste + annotations (to group multiple pastes on a topic), a list of all + pastes in the system, and persistent pastes between runs of the + bot. But lisppaste offers more than basic pastebot functionality - + it truly is buzzword-enabled, offering RSS and XML-RPC support, + and direct linking to meme + logs. In this sense Lisppaste has grown to be more of a community + collaboration tool, as corny as that sounds.

Lisppaste 2 can be downloaded from here: lisppaste2-latest.tar.gz. The - latest version is 2.1.3, released February 23, 2004. + latest version is 2.2, released March 9, 2004. + +

New in lisppaste 2.2 is greater RSS flexibility, + channel-specific URLs for new pastes and paste listing, much + faster paste serialization, and XML-RPC support.

New in lisppaste 2.1 is support for RSS and linking to IRC log context at meme.b9.com. @@ -31,7 +42,7 @@ need araneida and SBCL. If you do install it, read the README.lisp + href="/cgi-bin/viewcvs.cgi/lisppaste2/README.lisp?rev=HEAD&cvsroot=lisppaste&content-type=text/vnd.viewcvs-markup">README.lisp file which contains all the information you need to run a lisppaste on your own. @@ -52,7 +63,7 @@

Brian Mastenbrook
-Last modified: Mon Feb 23 09:56:16 EST 2004 +Last modified: Tue Mar 9 01:37:24 2004 EST From bmastenbrook at common-lisp.net Tue Mar 9 06:45:52 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Tue, 09 Mar 2004 01:45:52 -0500 Subject: [Lisppaste-cvs] CVS update: public_html/lisppaste.el public_html/xml-rpc.html Message-ID: Update of /project/lisppaste/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv18434 Modified Files: xml-rpc.html Added Files: lisppaste.el Log Message: note emacs lisp Date: Tue Mar 9 01:45:52 2004 Author: bmastenbrook Index: public_html/xml-rpc.html diff -u public_html/xml-rpc.html:1.1 public_html/xml-rpc.html:1.2 --- public_html/xml-rpc.html:1.1 Tue Mar 9 01:39:22 2004 +++ public_html/xml-rpc.html Tue Mar 9 01:45:52 2004 @@ -18,7 +18,9 @@

The irc.freenode.net pastebot serves XML-RPC on port 8185 of common-lisp.net. + href="http://www.common-lisp.net/">common-lisp.net. There is a + snippet of elisp that enables + lisppasting directly from emacs.

The following methods are implemented: From bmastenbrook at common-lisp.net Tue Mar 9 06:48:14 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Tue, 09 Mar 2004 01:48:14 -0500 Subject: [Lisppaste-cvs] CVS update: public_html/index.html Message-ID: Update of /project/lisppaste/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv2190 Modified Files: index.html Log Message: MORE FIXES Date: Tue Mar 9 01:48:14 2004 Author: bmastenbrook Index: public_html/index.html diff -u public_html/index.html:1.7 public_html/index.html:1.8 --- public_html/index.html:1.7 Tue Mar 9 01:39:22 2004 +++ public_html/index.html Tue Mar 9 01:48:14 2004 @@ -21,10 +21,11 @@ annotations (to group multiple pastes on a topic), a list of all pastes in the system, and persistent pastes between runs of the bot. But lisppaste offers more than basic pastebot functionality - - it truly is buzzword-enabled, offering RSS and XML-RPC support, - and direct linking to meme - logs. In this sense Lisppaste has grown to be more of a community - collaboration tool, as corny as that sounds. + it truly is buzzword-enabled, offering RSS and XML-RPC support, and direct linking to meme logs. In this sense Lisppaste + has grown to be more of a community collaboration tool, as corny + as that sounds.

Lisppaste 2 can be downloaded from here: lisppaste2-latest.tar.gz. The @@ -63,7 +64,7 @@

Brian Mastenbrook
-Last modified: Tue Mar 9 01:37:24 2004 EST +Last modified: Tue Mar 9 01:48:05 2004 EST From bmastenbrook at common-lisp.net Tue Mar 9 06:50:36 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Tue, 09 Mar 2004 01:50:36 -0500 Subject: [Lisppaste-cvs] CVS update: public_html/xml-rpc.html Message-ID: Update of /project/lisppaste/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv21161 Modified Files: xml-rpc.html Log Message: EVEN MORE FIXES Date: Tue Mar 9 01:50:36 2004 Author: bmastenbrook Index: public_html/xml-rpc.html diff -u public_html/xml-rpc.html:1.2 public_html/xml-rpc.html:1.3 --- public_html/xml-rpc.html:1.2 Tue Mar 9 01:45:52 2004 +++ public_html/xml-rpc.html Tue Mar 9 01:50:36 2004 @@ -7,17 +7,9 @@

Lisppaste XML-RPC support

- As of version 2.2, Lisppaste now supports XML-RPC. You will need - Sven Van Caekenberghe's XML-RPC - package installed server-side; there is a xml-rpc-sbcl.patch file - in the Lisppaste 2.2 distribution which allows it to run on - SBCL. To enable XML-RPC, start the pastebot as normal and then - load the xml-paste.lisp file, and start your XML-RPC server on - your choice of port.

- -

The irc.freenode.net - pastebot serves XML-RPC on port 8185 of irc.freenode.net pastebot + serves XML-RPC on port 8185 of common-lisp.net. There is a snippet of elisp that enables lisppasting directly from emacs. @@ -41,12 +33,21 @@ contents of the paste with number number, or of the annotation with supplied number of that paste. +

If you are planning on running a lisppaste with XML-RPC + support, you will need Sven Van Caekenberghe's XML-RPC + package installed server-side; there is a xml-rpc-sbcl.patch file + in the Lisppaste 2.2 distribution which allows it to run on + SBCL. To enable XML-RPC, start the pastebot as normal and then + load the xml-paste.lisp file, and start your XML-RPC server on + your choice of port.

+

Erik Enge
Brian Mastenbrook
-Last modified: Tue Mar 9 01:23:36 2004 EST +Last modified: Tue Mar 9 01:49:48 2004 EST From bmastenbrook at common-lisp.net Tue Mar 9 06:52:27 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Tue, 09 Mar 2004 01:52:27 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv2592 Modified Files: web-server.lisp Log Message: argh, the post-initial-release change Date: Tue Mar 9 01:52:27 2004 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.41 lisppaste2/web-server.lisp:1.42 --- lisppaste2/web-server.lisp:1.41 Sun Mar 7 15:40:20 2004 +++ lisppaste2/web-server.lisp Tue Mar 9 01:52:27 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.41 2004/03/07 20:40:20 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.42 2004/03/09 06:52:27 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -45,6 +45,8 @@ ((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/xml-rpc.html") "XML-RPC") " | " ((a :href "http://common-lisp.net/project/lisppaste") "lisppaste home page"))) From bmastenbrook at common-lisp.net Tue Mar 9 14:16:22 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Tue, 09 Mar 2004 09:16:22 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/lisppaste.asd Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv16480 Modified Files: lisppaste.asd Log Message: gah, stupid dependencies Date: Tue Mar 9 09:16:22 2004 Author: bmastenbrook Index: lisppaste2/lisppaste.asd diff -u lisppaste2/lisppaste.asd:1.7 lisppaste2/lisppaste.asd:1.8 --- lisppaste2/lisppaste.asd:1.7 Sun Mar 7 13:16:27 2004 +++ lisppaste2/lisppaste.asd Tue Mar 9 09:16:21 2004 @@ -1,5 +1,5 @@ ;;;; Silly emacs, this is -*- Lisp -*- -;;;; $Id: lisppaste.asd,v 1.7 2004/03/07 18:16:27 bmastenbrook Exp $ +;;;; $Id: lisppaste.asd,v 1.8 2004/03/09 14:16:21 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -30,6 +30,6 @@ (:file "lisppaste" :depends-on ("variable")) (:file "web-server" - :depends-on ("encode-for-pre" "web-server")) + :depends-on ("encode-for-pre" "lisppaste")) (:file "persistent-pastes" :depends-on ("web-server")))) From bmastenbrook at common-lisp.net Thu Mar 11 14:21:34 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Thu, 11 Mar 2004 09:21:34 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/lisppaste.lisp lisppaste2/variable.lisp lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv23876 Modified Files: lisppaste.lisp variable.lisp web-server.lisp Log Message: uptime, syndication options Date: Thu Mar 11 09:21:34 2004 Author: bmastenbrook Index: lisppaste2/lisppaste.lisp diff -u lisppaste2/lisppaste.lisp:1.12 lisppaste2/lisppaste.lisp:1.13 --- lisppaste2/lisppaste.lisp:1.12 Sun Mar 7 13:16:27 2004 +++ lisppaste2/lisppaste.lisp Thu Mar 11 09:21:33 2004 @@ -1,4 +1,4 @@ -;;;; $Id: lisppaste.lisp,v 1.12 2004/03/07 18:16:27 bmastenbrook Exp $ +;;;; $Id: lisppaste.lisp,v 1.13 2004/03/11 14:21:33 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -32,6 +32,7 @@ (mapcar #'(lambda (channel) (irc:join connection channel)) channels) (araneida:start-listening *paste-listener*) (add-hook nickname) + (setf *boot-time* (get-universal-time)) (irc:start-background-message-handler connection))) (defun join-new-channel (channel) Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.12 lisppaste2/variable.lisp:1.13 --- lisppaste2/variable.lisp:1.12 Sun Mar 7 14:52:57 2004 +++ lisppaste2/variable.lisp Thu Mar 11 09:21:34 2004 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.12 2004/03/07 19:52:57 bmastenbrook Exp $ +;;;; $Id: variable.lisp,v 1.13 2004/03/11 14:21:34 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -48,6 +48,9 @@ (defparameter *rss-full-url* (araneida:merge-url *paste-external-url* "list-full.rss")) +(defparameter *syndication-url* + (araneida:merge-url *paste-external-url* "syndication")) + (defvar *paste-listener* (let ((fwd-url (araneida:copy-url *paste-url*))) (setf (araneida:url-port fwd-url) *internal-http-port*) @@ -69,3 +72,5 @@ (defvar *channels* nil) (defvar *paste-file* "pastes.lisp-expr") + +(defvar *boot-time* 0) Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.42 lisppaste2/web-server.lisp:1.43 --- lisppaste2/web-server.lisp:1.42 Tue Mar 9 01:52:27 2004 +++ lisppaste2/web-server.lisp Thu Mar 11 09:21:34 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.42 2004/03/09 06:52:27 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.43 2004/03/11 14:21:34 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -28,6 +28,8 @@ (defclass rss-full-handler (araneida:handler) ()) +(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))) @@ -42,13 +44,13 @@ " | " ((a :href ,(araneida:urlstring *list-paste-url*)) "List all pastes") " | " - ((a :href ,(araneida:urlstring *rss-url*)) "Syndicate (Basic RSS)") - " | " - ((a :href ,(araneida:urlstring *rss-full-url*)) "Syndicate (Full RSS)") + ((a :href ,(araneida:urlstring *syndication-url*)) "Syndication") " | " ((a :href "http://common-lisp.net/project/lisppaste/xml-rpc.html") "XML-RPC") " | " - ((a :href "http://common-lisp.net/project/lisppaste") "lisppaste home page"))) + ((a :href "http://common-lisp.net/project/lisppaste") "lisppaste home page") + " | " + "Uptime: " ,(time-delta *boot-time* :ago-p nil))) (defun time-delta (time &key (level 2) (ago-p t)) (let ((delta (- (get-universal-time) time))) @@ -97,6 +99,40 @@ (concatenate 'string (subseq str 0 (1- n)) "...") str)) +(defmethod araneida:handle-request-response ((handler syndication-handler) method request) + (araneida:request-send-headers request :expires 0) + (format (araneida:request-stream request) "") + (araneida:html-stream + (araneida:request-stream request) + `(html + (head (title "Syndication options") + ,(rss-link-header)) + (body + (h2 "Syndication options") + "Lisppaste can be syndicated in a variety of RSS formats for use +with your favorite RSS reader." + (p) + (table + (tr + ((th :align left) "All channels") + ((td :width 30)) + (td ((a :href ,(araneida:urlstring *rss-url*)) "Basic")) + ((td :width 10)) + (td ((a :href ,(araneida:urlstring *rss-full-url*)) "Full"))) + ,@(mapcar #'(lambda (channel) + `(tr + ((th :align left) ,channel) + ((td :width 30)) + (td ((a :href ,(concatenate 'string + (araneida:urlstring *rss-url*) + (substitute #\? #\# channel))) "Basic")) + ((td :width 10)) + (td ((a :href ,(concatenate 'string + (araneida:urlstring *rss-full-url*) + (substitute #\? #\# channel))) "Full")))) + *channels*)) + ,@(bottom-links))))) + (defmethod araneida:handle-request-response ((handler list-paste-handler) method request) (araneida:request-send-headers request :expires 0) (format (araneida:request-stream request) "") @@ -222,7 +258,7 @@ (head (title ,(if annotate "Annotate" "Paste")) ,(rss-link-header)) (body - (h1 ,(if annotate "Enter your annotation" "Enter your paste")) + (h2 ,(if annotate "Enter your annotation" "Enter your paste")) ((font :color red) (h2 ,message)) ((form :method post :action ,(araneida:urlstring *submit-paste-url*)) (p "Enter a username, title, and paste contents into the fields below. The @@ -303,7 +339,7 @@ (head (title "Paste number " ,*paste-counter*) ,(rss-link-header)) (body - (h1 "Pasted!") + (h2 "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)))))))))) @@ -433,3 +469,8 @@ (araneida:http-listener-handler *paste-listener*) (make-instance 'rss-full-handler) (araneida:urlstring *rss-full-url*) nil) + +(araneida:install-handler + (araneida:http-listener-handler *paste-listener*) + (make-instance 'syndication-handler) + (araneida:urlstring *syndication-url*) nil) From bmastenbrook at common-lisp.net Wed Mar 31 21:25:15 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Wed, 31 Mar 2004 16:25:15 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/encode-for-pre.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: encode-for-pre.lisp Log Message: aaaaargh! the bug from hell is still not fixed! Date: Wed Mar 31 16:25:14 2004 Author: bmastenbrook Index: lisppaste2/encode-for-pre.lisp diff -u lisppaste2/encode-for-pre.lisp:1.11 lisppaste2/encode-for-pre.lisp:1.12 --- lisppaste2/encode-for-pre.lisp:1.11 Sun Mar 7 15:40:20 2004 +++ lisppaste2/encode-for-pre.lisp Wed Mar 31 16:25:14 2004 @@ -1,4 +1,4 @@ -;;;; $Id: encode-for-pre.lisp,v 1.11 2004/03/07 20:40:20 bmastenbrook Exp $ +;;;; $Id: encode-for-pre.lisp,v 1.12 2004/03/31 21:25:14 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -10,16 +10,17 @@ summing (if (not only-in-dup) (if (char= (elt str i) char) (length repstr) 1) - (if (< i (1- (length str))) - (if (and (char= (elt str i) char) - (char= (elt str (1+ i)) char)) + (if (> i 1) + (if (and (member (elt str (1- i)) only-in-dup :test #'char=) + (char= (elt str i) char)) (length repstr) 1) 1)))) (new-array (make-array `(,new-length) :element-type 'character))) (loop for i from 0 to (1- (length str)) with j = 0 do (if (if only-in-dup - (and (< i (1- (length str))) (and (char= (elt str i) char) - (char= (elt str (1+ i)) char))) + (and (> i 1) (char= (elt str i) char) + (member (elt str (1- i)) + only-in-dup :test #'char=)) (char= (elt str i) char)) (progn (loop for k from 0 to (1- (length repstr)) @@ -40,8 +41,13 @@ (defun encode-for-pre (str) (replace-in-string str '(#\& #\< #\>) '("&" "<" ">"))) +(defun replace-first-space (str) + (if (char= (elt str 0) #\space) + (concatenate 'string " " (subseq str 1)) + str)) + (defun encode-for-tt (str) - (replace-in-string-1 (replace-in-string str '(#\& #\< #\> #\newline #\return #\linefeed #\tab) '("&" "<" ">" "
" "" "" "    ")) #\space " " t)) + (replace-in-string-1 (replace-in-string str '(#\& #\< #\> #\newline #\return #\linefeed #\tab) '("&" "<" ">" "
" "" "" "    ")) #\space " " '(#\space #\>))) (defun encode-for-http (str) (replace-in-string-1 str #\> (format nil ">~%") nil)) From bmastenbrook at common-lisp.net Wed Mar 31 21:33:07 2004 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Wed, 31 Mar 2004 16:33:07 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp lisppaste2/encode-for-pre.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: web-server.lisp encode-for-pre.lisp Log Message: recent fixes and new features Date: Wed Mar 31 16:33:07 2004 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.43 lisppaste2/web-server.lisp:1.44 --- lisppaste2/web-server.lisp:1.43 Thu Mar 11 09:21:34 2004 +++ lisppaste2/web-server.lisp Wed Mar 31 16:33:07 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.43 2004/03/11 14:21:34 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.44 2004/03/31 21:33:07 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -35,7 +35,11 @@ (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 (substitute #\# #\/ (araneida::request-unhandled-part request) :test #'char=))) + (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")))))) (new-paste-form request :annotate annotate :default-channel default-channel))) (defun bottom-links () @@ -298,7 +302,8 @@ (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) + (araneida:request-send-headers request :expires 0 + :set-cookie (format nil "CHANNEL=~A; path=/" (subseq channel 1))) (cond ((zerop (length username)) @@ -336,12 +341,15 @@ (araneida:html-stream (araneida:request-stream request) `(html - (head (title "Paste number " ,*paste-counter*) + (head (title "Paste number " ,paste-number) ,(rss-link-header)) (body (h2 "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.")) + (h3 "Don't paste more junk; annotate!") + ((form :method post :action ,(araneida:urlstring *new-paste-url*)) + ((input :type hidden :name "annotate" :value ,(prin1-to-string paste-number))) + (center ((input :type submit :value "Annotate this paste")))) ,@(bottom-links)))))))))) (defun ends-with (str end) @@ -354,7 +362,7 @@ `((table :width "100%" :cellpadding 2) (tr ((td :align "left" :width "0%" :nowrap "nowrap") ,(if annotation - "Annotation number " + `((a :name ,(prin1-to-string paste-number)) "Annotation number ") "Paste number ") ,paste-number ": ") ((td :align "left" :width "100%") (b ,(encode-for-pre (paste-title paste))))) (tr ((td :align "left" :nowrap "nowrap") "Pasted by: ") Index: lisppaste2/encode-for-pre.lisp diff -u lisppaste2/encode-for-pre.lisp:1.12 lisppaste2/encode-for-pre.lisp:1.13 --- lisppaste2/encode-for-pre.lisp:1.12 Wed Mar 31 16:25:14 2004 +++ lisppaste2/encode-for-pre.lisp Wed Mar 31 16:33:07 2004 @@ -1,4 +1,4 @@ -;;;; $Id: encode-for-pre.lisp,v 1.12 2004/03/31 21:25:14 bmastenbrook Exp $ +;;;; $Id: encode-for-pre.lisp,v 1.13 2004/03/31 21:33:07 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -10,7 +10,7 @@ summing (if (not only-in-dup) (if (char= (elt str i) char) (length repstr) 1) - (if (> i 1) + (if (> i 0) (if (and (member (elt str (1- i)) only-in-dup :test #'char=) (char= (elt str i) char)) (length repstr) 1) 1)))) @@ -18,7 +18,7 @@ (loop for i from 0 to (1- (length str)) with j = 0 do (if (if only-in-dup - (and (> i 1) (char= (elt str i) char) + (and (> i 0) (char= (elt str i) char) (member (elt str (1- i)) only-in-dup :test #'char=)) (char= (elt str i) char)) @@ -47,7 +47,7 @@ str)) (defun encode-for-tt (str) - (replace-in-string-1 (replace-in-string str '(#\& #\< #\> #\newline #\return #\linefeed #\tab) '("&" "<" ">" "
" "" "" "    ")) #\space " " '(#\space #\>))) + (replace-first-space (replace-in-string-1 (replace-in-string str '(#\& #\< #\> #\newline #\return #\linefeed #\tab) '("&" "<" ">" "
" "" "" "    ")) #\space " " '(#\space #\>)))) (defun encode-for-http (str) (replace-in-string-1 str #\> (format nil ">~%") nil))