[Lisppaste-cvs] CVS update: lisppaste2/lisppaste.lisp lisppaste2/web-server.lisp lisppaste2/xml-paste.lisp
Brian Mastenbrook
bmastenbrook at common-lisp.net
Sun Mar 7 06:39:56 UTC 2004
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)))))))
More information about the Lisppaste-cvs
mailing list