(in-package :lisppaste) (defun simple-serialize-with-type (obj)   (etypecase obj     (string `(:|string| ,obj))     (keyword `(:|keyword| ,(symbol-name obj)))     (integer `(:|integer| ,(prin1-to-string obj)))     (null :|null|))) (defun simple-deserialize-with-type (form)   (if (eq form :|null|)       nil       (if (eq form :|string|)           ""           (ecase (car form)             (:|string| (second form))             (:|keyword| (intern (second form) :keyword))             (:|integer| (parse-integer (second form))))))) (defun serialize-object-slots (object slots &key root)   (list* (or root              (intern (string-downcase (symbol-name (class-name (class-of object)))) :keyword))          (mapcar #'(lambda (slot)                      (list (intern (string-downcase (symbol-name slot)) :keyword)                            (simple-serialize-with-type (slot-value object slot))))                  slots))) (defun deserialize-object-slots (list class slots)   (let ((object (make-instance class)))     (mapc #'(lambda (slot)               (setf (slot-value object slot)                     (simple-deserialize-with-type                      (or (second (assoc (string-downcase (symbol-name slot)) (cdr list)                                      :test #'string= :key #'symbol-name))                          :|null|))))           slots)     object)) (defparameter *paste-serialization-slots*   '(number user title contents     universal-time channel colorization-mode     maybe-spam is-unicode)) (defun paste-lxml (paste &key root)   (serialize-object-slots paste *paste-serialization-slots*                           :root root)) (defun lxml-paste (lxml)   (deserialize-object-slots lxml 'paste *paste-serialization-slots*)) (defun paste-xml-file (paste)   (merge-pathnames (make-pathname :name (prin1-to-string (paste-number paste))                                   :type "xml")                    *paste-path*)) (defun paste-write-xml* (paste stream)   (write-string "<?xml version=\"1.0\"?>" stream)   (write-string (s-xml:print-xml-string (paste-lxml paste) :pretty t) stream)   (mapc #'(lambda (ann)             (write-string (s-xml:print-xml-string (paste-lxml ann :root :|annotation|) :pretty t)                           stream))         (paste-annotations paste))) (defun paste-write-xml (paste stream)   (write-string "<?xml version=\"1.0\"?>" stream)   (write-string (s-xml:print-xml-string (list* :|paste-with-annotations| (paste-lxml paste)                                                (mapcar (lambda (ann)                                                          (paste-lxml ann :root :|annotation|))                                                        (paste-annotations paste))) :pretty t) stream)) (defun paste-write-xml-to-file (paste)   (ensure-directories-exist *paste-path*)   (with-open-file (s (paste-xml-file paste) :direction :output :if-exists :supersede)     (paste-write-xml* paste s))) (defun disable-paste (paste)   (rename-file (paste-xml-file paste)                (make-pathname :defaults (paste-xml-file paste)                               :type "disabled"))) (defun write-new-annotation (paste ann)   (with-open-file (s (paste-xml-file paste) :direction :output :if-exists :append)     (write-string (s-xml:print-xml-string (paste-lxml ann :root :|annotation|) :pretty t)                   s))) (defun read-paste-xml-from-file (file)   (with-open-file (s file :direction :input)     (let ((paste (lxml-paste (s-xml:parse-xml-dom s :lxml))))       (if (paste-number paste)           (progn             (push paste *pastes*)             (setf *paste-counter* (max (paste-number paste) *paste-counter*))             (setf (paste-annotation-counter paste) 0)             (loop for ann-lxml = (s-xml:parse-xml-dom s :lxml)                   while ann-lxml                   do (let ((ann (lxml-paste ann-lxml)))                        (push ann (paste-annotations paste))                        (setf (paste-annotation-counter paste)                              (max (paste-annotation-counter paste)                                   (paste-number ann))))))           (progn             (warn "Paste file ~A is malformed." file)))))) (defun read-xml-pastes ()   (setf *pastes* nil)   (setf *paste-counter* 0)   (mapc #'read-paste-xml-from-file         (sort (directory (make-pathname :name :wild                                         :type "xml"                                         :defaults *paste-path*))               #'< :key #'(lambda (e)                            (parse-integer (pathname-name e) :junk-allowed t))))) (defun write-all-xml-pastes ()   (mapc #'paste-write-xml-to-file *pastes*)) (defun serialize-transaction (paste &optional annotate-number)   (if annotate-number       (write-new-annotation (find-paste annotate-number) paste)       (paste-write-xml-to-file paste)))