[Lisppaste-cvs] CVS update: lisppaste2/xml-paste.lisp lisppaste2/persistent-pastes.lisp

[Brian Mastenbrook]

Update of /project/lisppaste/cvsroot/lisppaste2
In directory common-lisp.net:/home/bmastenbrook/lisppaste2

Modified Files:
	xml-paste.lisp persistent-pastes.lisp 
Log Message:
Remove evil ^Ms

Date: Tue Apr 27 17:47:33 2004
Author: bmastenbrook

Index: lisppaste2/xml-paste.lisp
diff -u lisppaste2/xml-paste.lisp:1.3 lisppaste2/xml-paste.lisp:1.4
--- lisppaste2/xml-paste.lisp:1.3	Tue Apr 27 17:03:21 2004
+++ lisppaste2/xml-paste.lisp	Tue Apr 27 17:47:32 2004
@@ -1,7 +1,7 @@
 (in-package :lisppaste)
 
 (defun paste-xml-list (paste &optional contents)
-  (format t "collecting paste number ~A~%" (paste-number paste))
+;  (format t "collecting paste number ~A~%" (paste-number paste))
   (list* (paste-number paste)
 	 (xml-rpc:xml-rpc-time (paste-universal-time paste))
 	 (paste-user paste)
@@ -9,10 +9,11 @@
 	 (paste-title paste)
 	 (length (paste-annotations paste))
 	 (if contents
-	     (list (paste-contents paste)))))
+	     (list (remove #\return (paste-contents paste))))))
 
 (setf xml-rpc:*xml-rpc-call-hook*
       (lambda (method-name &rest args)
+	(format t "Handling XML-RPC request for ~S ~{~S~^ ~}~%" method-name args)
         (block hook
           (handler-bind
               ((condition #'(lambda (c) (return-from hook
@@ -24,7 +25,8 @@
                          "Error: all arguments must be strings."
                          (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."
-                             (let ((annotate-this (if annotate (find annotate *pastes* :key #'paste-number))))
+                             (let ((annotate-this (if annotate (find annotate *pastes* :key #'paste-number)))
+				   (paste-contents (remove #\return paste-contents)))
                                (if (if annotate
                                        (not (string-equal paste-channel (paste-channel annotate-this)))
                                        (not (member paste-channel *channels* :test #'string-equal)))
@@ -53,36 +55,34 @@
                                              paste-channel url))))))))
 		  ((string-equal method-name "pasteheaders")
 		   (destructuring-bind
-		    (length &optional (start (paste-number (car *pastes*)))) args
-		    (format t "args is ~A~%" args)
-		    (mapcar #'paste-xml-list
-			    (loop for i from 1 to length
-				  for j in (member start *pastes* :key #'paste-number)
-				  collect j))))
+		    (length &optional supplied-start) args
+		    (let ((start (or supplied-start (paste-number (car *pastes*)))))
+		      (mapcar #'paste-xml-list
+			      (loop for i from 1 to length
+				    for j in (member start *pastes* :key #'paste-number)
+				    collect j)))))
 		  ((string-equal method-name "pasteheadersbychannel")
 		   (destructuring-bind
 		    (channel length &optional supplied-start) args
 		    (let* ((*pastes* (remove channel *pastes* :test-not #'string-equal :key #'paste-channel))
 			   (start (or supplied-start (paste-number (car *pastes*)))))
-		      (format t "args is ~A~%" args)
 		      (mapcar #'paste-xml-list
 			      (loop for i from 1 to length
 				    for j in (member start *pastes* :key #'paste-number)
 				    collect j)))))
                   ((string-equal method-name "pasteannotationheaders")
-		   (format t "args is ~A~%" args)
                    (nreverse
                     (mapcar #'paste-xml-list
-                            (if args
-				(paste-annotations (find (car args) *pastes* :key #'paste-number :test #'eql))
-			      *pastes*))))
+			    (paste-annotations (find (car args) *pastes* :key #'paste-number :test #'eql)))))
                   ((string-equal method-name "pastedetails")
-                   (if (eql (length args) 1)
-                       (paste-xml-list (find (car args) *pastes* :key #'paste-number :test #'eql) t)
-		     (if (eql (length args) 2)
-			 (paste-xml-list
-			  (find (second args)
-				(paste-annotations (find (car args) *pastes* :key #'paste-number :test #'eql))
-				:key #'paste-number :test #'eql) t)
-		       "Error: Invalid number of arguments.")))
+		   (destructuring-bind
+		    (paste &optional annotation) args
+		    (if (not annotation)
+			(paste-xml-list (find paste *pastes* :key #'paste-number :test #'eql) t)
+		      (paste-xml-list
+		       (find annotation
+			     (paste-annotations (find paste *pastes* :key #'paste-number :test #'eql))
+			     :key #'paste-number :test #'eql) t))))
+		  ((string-equal method-name "listchannels")
+		   *channels*)
                   (t (format nil "Error: unimplemented method ~S." method-name)))))))


Index: lisppaste2/persistent-pastes.lisp
diff -u lisppaste2/persistent-pastes.lisp:1.7 lisppaste2/persistent-pastes.lisp:1.8
--- lisppaste2/persistent-pastes.lisp:1.7	Sun Mar  7 13:16:27 2004
+++ lisppaste2/persistent-pastes.lisp	Tue Apr 27 17:47:32 2004
@@ -48,7 +48,7 @@
                    (make-paste :number number
                                :user user
                                :title title
-                               :contents contents
+                               :contents (remove #\return contents)
                                :universal-time universal-time
                                :channel channel
                                :annotations nil)))