[Lisppaste-cvs] CVS update: lisppaste2/lisppaste.asd lisppaste2/lisppaste.lisp lisppaste2/web-server.lisp

[Brian Mastenbrook]

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