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 ,@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)))))))))