[Lisppaste-cvs] CVS update: lisppaste2/lisppaste.lisp lisppaste2/persistent-pastes.lisp
Brian Mastenbrook
bmastenbrook at common-lisp.net
Tue Jun 8 15:21:30 UTC 2004
Update of /project/lisppaste/cvsroot/lisppaste2
In directory common-lisp.net:/home/bmastenbrook/lisppaste2
Modified Files:
lisppaste.lisp persistent-pastes.lisp
Log Message:
no-channel pastes; kill-paste command
Date: Tue Jun 8 08:21:30 2004
Author: bmastenbrook
Index: lisppaste2/lisppaste.lisp
diff -u lisppaste2/lisppaste.lisp:1.18 lisppaste2/lisppaste.lisp:1.19
--- lisppaste2/lisppaste.lisp:1.18 Fri Jun 4 17:14:31 2004
+++ lisppaste2/lisppaste.lisp Tue Jun 8 08:21:30 2004
@@ -1,4 +1,4 @@
-;;;; $Id: lisppaste.lisp,v 1.18 2004/06/05 00:14:31 bmastenbrook Exp $
+;;;; $Id: lisppaste.lisp,v 1.19 2004/06/08 15:21:30 bmastenbrook Exp $
;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.lisp,v $
;;;; See the LICENSE file for licensing information.
@@ -81,19 +81,36 @@
&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 ,real-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))
- (serialize-transaction "pastes.lisp-expr" ,paste-name (if ,annotate ,real-number)))))
+ (if (not (string-equal channel "None"))
+ (irc:privmsg *connection* ,channel
+ (if ,annotate
+ (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
+ (push ,paste-name ,annotate-list)
+ (push ,paste-name ,paste-list))
+ `(push ,paste-name ,paste-list))
+ (serialize-transaction *paste-file* ,paste-name (if ,annotate ,real-number)))))
(defun shut-up ()
(setf (irc:client-stream *connection*) (make-broadcast-stream)))
(defun un-shut-up ()
(setf (irc:client-stream *connection*) *trace-output*))
+
+(defun kill-paste (number)
+ (setf *pastes*
+ (remove number *pastes* :key #'paste-number))
+ (serialize-to-file *paste-file* `(kill-paste ,number)))
+
+(defun kill-paste-annotations (number)
+ (setf (paste-annotations (find number *pastes* :key #'paste-number))
+ nil)
+ (serialize-to-file *paste-file* `(kill-paste-annotations ,number)))
+
+(defun kill-paste-annotation (number ann)
+ (let ((paste (find number *pastes* :key #'paste-number)))
+ (setf (paste-annotations paste)
+ (remove ann (paste-annotations paste) :key #'paste-number))
+ (serialize-to-file *paste-file* `(kill-paste-annotation ,number ,ann))))
Index: lisppaste2/persistent-pastes.lisp
diff -u lisppaste2/persistent-pastes.lisp:1.9 lisppaste2/persistent-pastes.lisp:1.10
--- lisppaste2/persistent-pastes.lisp:1.9 Fri May 21 12:30:45 2004
+++ lisppaste2/persistent-pastes.lisp Tue Jun 8 08:21:30 2004
@@ -1,5 +1,7 @@
(in-package :lisppaste)
+(defvar *in-operation* nil)
+
(defun paste-alist (paste)
(list
(cons 'number (paste-number paste))
@@ -7,7 +9,8 @@
(cons 'title (paste-title paste))
(cons 'contents (paste-contents paste))
(cons 'universal-time (paste-universal-time paste))
- (cons 'channel (paste-channel paste))))
+ (cons 'channel (paste-channel paste))
+ (cons 'colorization-mode (paste-colorization-mode paste))))
(defun serialized-initial-paste (paste)
(cons 'make-paste (paste-alist paste)))
@@ -29,14 +32,19 @@
(let ((*print-readably* t))
(format file "~{~S~%~}" (mapcan #'paste-list-alist (reverse *pastes*)))))))
+(defun serialize-to-file (file-name operation)
+ (unless *in-operation*
+ (let ((*package* (find-package :lisppaste)))
+ (with-open-file (file file-name :direction :output :if-exists :append
+ :if-does-not-exist :create)
+ (let ((*print-readably* t))
+ (format file "~S~%" operation))))))
+
(defun serialize-transaction (file-name paste &optional annotate-number)
- (let ((*package* (find-package :lisppaste)))
- (with-open-file (file file-name :direction :output :if-exists :append
- :if-does-not-exist :create)
- (let ((*print-readably* t))
- (if annotate-number
- (format file "~S~%" (serialized-annotation annotate-number paste))
- (format file "~S~%" (serialized-initial-paste paste)))))))
+ (serialize-to-file file-name
+ (if annotate-number
+ (serialized-annotation annotate-number paste)
+ (serialized-initial-paste paste))))
(defmacro with-assoc-vals (entry-list alist &body body)
`(let ,(mapcar #'(lambda (e) (list e `(cdr (assoc ',e ,alist)))) entry-list)
@@ -59,14 +67,18 @@
(ecase (car expr)
(make-paste (push (make-paste-from-alist (cdr expr)) *pastes*))
(annotate-paste (let ((paste (find (second expr) *pastes* :key #'paste-number)))
- (push (make-paste-from-alist (cddr expr) paste) (paste-annotations paste))))))
+ (push (make-paste-from-alist (cddr expr) paste) (paste-annotations paste))))
+ (kill-paste (kill-paste (second expr)))
+ (kill-paste-annotations (kill-paste-annotations (second expr)))
+ (kill-paste-annotation (kill-paste-annotation (second expr) (third expr)))))
(defun read-pastes-from-file (file-name)
- (setf *pastes* nil)
- (let ((*package* (find-package :lisppaste)))
- (with-open-file (file file-name :direction :input :if-does-not-exist nil)
- (if file
- (loop (let ((paste (read file nil)))
- (if paste
- (deserialize paste)
- (return-from read-pastes-from-file t))))))))
+ (let ((*in-operation* t))
+ (setf *pastes* nil)
+ (let ((*package* (find-package :lisppaste)))
+ (with-open-file (file file-name :direction :input :if-does-not-exist nil)
+ (if file
+ (loop (let ((paste (read file nil)))
+ (if paste
+ (deserialize paste)
+ (return-from read-pastes-from-file t)))))))))
More information about the Lisppaste-cvs
mailing list