;;;; $Id: lisppaste.lisp,v 1.28 2007/01/17 14:08:28 lisppaste Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.lisp,v $ ;;;; See the LICENSE file for licensing information. (in-package :lisppaste) (defun start-lisppaste ()   "Start accepting web requests."   (if *no-channel-pastes*       (pushnew "None" *channels* :test #'string-equal))   (read-xml-pastes)   (format t "Populating lookup table...~%")   (clhs-lookup:populate-table)   (r5rs-lookup:populate-table)   (elisp-lookup:populate-table)   (format t "Done!~%")   (setf *boot-time* (get-universal-time))   (araneida:start-listening *paste-listener*)) (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)))       (if (not (string-equal ,channel "None"))           (irc-notify ,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-name (if ,annotate ,real-number))))) (defun kill-paste (number)   (let ((paste (if (typep number 'paste)                    number                    (find-paste number))))     (when paste       (setf *pastes*             (remove paste *pastes*))       (disable-paste paste)))) (defun kill-paste-annotations (number)   (setf (paste-annotations (find-paste number))         nil)   (paste-write-xml-to-file (find-paste 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))     (paste-write-xml-to-file paste))) (defun logging-date ()   (multiple-value-bind (second minute hour date month year)       (get-decoded-time)     (format nil "~2,'0D/~2,'0D/~4,'0D ~2,'0D:~2,'0D:~2,'0D "              month date year hour minute second))) (defun log-event (text &key (log-file *event-log-file*))   (with-open-file (s log-file :direction :output :if-exists :append                      :if-does-not-exist :create)     (write-string (logging-date) *trace-output*)     (write-string (subseq text 0 50) *trace-output*)     (fresh-line *trace-output*)     (write-string (logging-date) s)     (write-string text s)     (finish-output s)))