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

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

06 Mar '04

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"))))

1 0

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

06 Mar '04

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

1 0

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

06 Mar '04

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 ,@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) "<!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)

1 0

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

06 Mar '04

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) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">")

1 0

[Lisppaste-cvs] CVS update: lisppaste2/lisppaste.lisp
by Brian Mastenbrook 02 Mar '04

02 Mar '04

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*))

1 0