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