Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv16166
Modified Files: lisppaste.asd lisppaste.lisp persistent-pastes.lisp web-server.lisp Log Message: better persistent pastes, big diff in web-server due to M-x untabify
Date: Sun Mar 7 13:16:27 2004 Author: bmastenbrook
Index: lisppaste2/lisppaste.asd diff -u lisppaste2/lisppaste.asd:1.6 lisppaste2/lisppaste.asd:1.7 --- lisppaste2/lisppaste.asd:1.6 Sat Mar 6 23:44:56 2004 +++ lisppaste2/lisppaste.asd Sun Mar 7 13:16:27 2004 @@ -1,5 +1,5 @@ ;;;; Silly emacs, this is -*- Lisp -*- -;;;; $Id: lisppaste.asd,v 1.6 2004/03/07 04:44:56 bmastenbrook Exp $ +;;;; $Id: lisppaste.asd,v 1.7 2004/03/07 18:16:27 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.asd,v $
;;;; See the LICENSE file for licensing information. @@ -27,9 +27,9 @@ :depends-on ("package")) (:file "encode-for-pre" :depends-on ("variable")) - (:file "web-server" - :depends-on ("encode-for-pre")) (:file "lisppaste" - :depends-on ("web-server")) + :depends-on ("variable")) + (:file "web-server" + :depends-on ("encode-for-pre" "web-server")) (:file "persistent-pastes" :depends-on ("web-server"))))
Index: lisppaste2/lisppaste.lisp diff -u lisppaste2/lisppaste.lisp:1.11 lisppaste2/lisppaste.lisp:1.12 --- lisppaste2/lisppaste.lisp:1.11 Sun Mar 7 01:39:56 2004 +++ lisppaste2/lisppaste.lisp Sun Mar 7 13:16:27 2004 @@ -1,4 +1,4 @@ -;;;; $Id: lisppaste.lisp,v 1.11 2004/03/07 06:39:56 bmastenbrook Exp $ +;;;; $Id: lisppaste.lisp,v 1.12 2004/03/07 18:16:27 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.lisp,v $
;;;; See the LICENSE file for licensing information. @@ -61,4 +61,4 @@ (push ,paste-name ,annotate-list) (push ,paste-name ,paste-list)) `(push ,paste-name ,paste-list)) - (save-pastes-to-file *paste-file*)))) + (serialize-transaction "pastes.lisp-expr" ,paste-name (if ,annotate ,real-number)))))
Index: lisppaste2/persistent-pastes.lisp diff -u lisppaste2/persistent-pastes.lisp:1.6 lisppaste2/persistent-pastes.lisp:1.7 --- lisppaste2/persistent-pastes.lisp:1.6 Tue Feb 3 21:41:12 2004 +++ lisppaste2/persistent-pastes.lisp Sun Mar 7 13:16:27 2004 @@ -7,37 +7,64 @@ (cons 'title (paste-title paste)) (cons 'contents (paste-contents paste)) (cons 'universal-time (paste-universal-time paste)) - (cons 'channel (paste-channel paste)) - (cons 'annotations (mapcar #'paste-alist (paste-annotations paste))) - (cons 'log-link (paste-log-link paste)))) + (cons 'channel (paste-channel paste)))) + +(defun serialized-initial-paste (paste) + (cons 'make-paste (paste-alist paste))) + +(defun serialized-annotation (of paste) + (list* 'annotate-paste of (paste-alist paste))) + +(defun paste-list-alist (paste) + (list* + (serialized-initial-paste paste) + (nreverse + (mapcar #'(lambda (e) + (serialized-annotation (paste-number paste) e)) (paste-annotations paste)))))
(defun save-pastes-to-file (file-name) (let ((*package* (find-package :lisppaste))) (with-open-file (file file-name :direction :output :if-exists :supersede) (let ((*print-readably* t)) - (format file "~A~%" (prin1-to-string - (mapcar #'paste-alist *pastes*))))))) + (format file "~{~S~%~}" (mapcan #'paste-list-alist (reverse *pastes*))))))) + +(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) + (let ((*print-readably* t)) + (if annotate-number + (format file "~S~%" (serialized-annotation annotate-number paste)) + (format file "~S~%" (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) ,@body))
-(defun make-paste-from-alist (e &optional annotation) - (with-assoc-vals (number user title contents universal-time annotations channel log-link) e - (unless annotation (setf *paste-counter* (max *paste-counter* number))) +(defun make-paste-from-alist (e &optional annotate) + (with-assoc-vals (number user title contents universal-time channel) e + (if annotate + (setf (paste-annotation-counter annotate) (max (paste-annotation-counter annotate) number)) + (setf *paste-counter* (max *paste-counter* number))) (make-paste :number number :user user :title title :contents contents :universal-time universal-time - :channel (if (not channel) (car *channels*) channel) - :annotations (mapcar #'(lambda (e) (make-paste-from-alist e)) annotations) - :log-link (if (not log-link) "" log-link)))) + :channel channel + :annotations nil))) + +(defun deserialize (expr) + (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))))))
(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 - (let ((paste-alist (read file nil))) - (setf *pastes* (mapcar #'make-paste-from-alist paste-alist))))))) + (loop (let ((paste (read file nil))) + (if paste + (deserialize paste) + (return-from read-pastes-from-file t))))))))
Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.35 lisppaste2/web-server.lisp:1.36 --- lisppaste2/web-server.lisp:1.35 Sun Mar 7 01:39:56 2004 +++ lisppaste2/web-server.lisp Sun Mar 7 13:16:27 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.35 2004/03/07 06:39:56 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.36 2004/03/07 18:16:27 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
;;;; See the LICENSE file for licensing information. @@ -14,8 +14,7 @@ (is-annotation nil :type boolean) (annotations nil :type list) (annotation-counter 0 :type integer) - (channel "" :type string) - (log-link "" :type string)) + (channel "" :type string))
(defclass new-paste-handler (araneida:handler) ())
@@ -30,8 +29,8 @@ (defmethod araneida:handle-request-response ((handler new-paste-handler) method request) (araneida:request-send-headers request :expires 0) (let* ((annotate-string (araneida:body-param "annotate" (araneida:request-body request))) - (annotate-number (if annotate-string (parse-integer annotate-string :junk-allowed t))) - (annotate (if annotate-number (find annotate-number *pastes* :key #'paste-number)))) + (annotate-number (if annotate-string (parse-integer annotate-string :junk-allowed t))) + (annotate (if annotate-number (find annotate-number *pastes* :key #'paste-number)))) (new-paste-form request :annotate annotate)))
(defun bottom-links () @@ -53,35 +52,35 @@
(defun irc-log-link (utime channel) (format nil "http://meme.b9.com/now?utime=~A&channel=~A" - utime - (string-left-trim "#" channel))) + utime + (string-left-trim "#" channel)))
(defun first-<-mod (n &rest nums) (some #'(lambda (n2) - (if (< n2 n) (mod n n2) nil)) nums)) + (if (< n2 n) (mod n n2) nil)) nums))
(defun time-delta-primitive (delta &optional (level 2)) (let* ((seconds 60) - (minutes (* seconds 60)) - (hours (* minutes 24)) - (days (* hours 7)) - (weeks (* days 487/16)) - (months (* weeks 12)) - (years (* hours (+ 365 1/4)))) + (minutes (* seconds 60)) + (hours (* minutes 24)) + (days (* hours 7)) + (weeks (* days 487/16)) + (months (* weeks 12)) + (years (* hours (+ 365 1/4)))) (let ((primitive - (cond - ((< delta seconds) (format nil "~D second~:P" delta)) - ((< delta minutes) (format nil "~D minute~:P" (floor delta seconds))) - ((< delta hours) (format nil "~D hour~:P" (floor delta minutes))) - ((< delta days) (format nil "~D day~:P" (floor delta hours))) - ((< delta weeks) (format nil "~D week~:P" (floor delta days))) - ((< delta months) (format nil "~D month~:P" (floor delta weeks))) - (t (format nil "~D years" (floor delta years)))))) + (cond + ((< delta seconds) (format nil "~D second~:P" delta)) + ((< delta minutes) (format nil "~D minute~:P" (floor delta seconds))) + ((< delta hours) (format nil "~D hour~:P" (floor delta minutes))) + ((< delta days) (format nil "~D day~:P" (floor delta hours))) + ((< delta weeks) (format nil "~D week~:P" (floor delta days))) + ((< delta months) (format nil "~D month~:P" (floor delta weeks))) + (t (format nil "~D years" (floor delta years)))))) (if (eql level 1) primitive - (format nil "~A, ~A" primitive - (time-delta-primitive - (first-<-mod delta years months weeks days hours minutes seconds) - (1- level))))))) + (format nil "~A, ~A" primitive + (time-delta-primitive + (first-<-mod delta years months weeks days hours minutes seconds) + (1- level)))))))
(defun rss-link-header () `((link :rel "alternate" :type "application/rss+xml" :title "Lisppaste RSS" :href ,(araneida:urlstring *rss-url*)))) @@ -98,20 +97,20 @@ (araneida:request-stream request) `(html (head (title "All pastes") - ,(rss-link-header)) + ,(rss-link-header)) (body (center (h2 "All pastes in system")) ((table :width "100%" :cellpadding 2) (tr (td) (td "By") (td "Where") (td "When") (td "Titled") (td "Ann.")) ,@(reverse (mapcar #'(lambda (paste) - `(tr ((td :nowrap "nowrap") ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number paste))))) - ,(concatenate 'string "#" (prin1-to-string (paste-number paste))))) - ((td :nowrap "nowrap") ,(encode-for-pre (max-length (paste-user paste) 12))) + `(tr ((td :nowrap "nowrap") ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number paste))))) + ,(concatenate 'string "#" (prin1-to-string (paste-number paste))))) + ((td :nowrap "nowrap") ,(encode-for-pre (max-length (paste-user paste) 12))) ((td :nowrap "nowrap") ,(encode-for-pre (paste-channel paste))) - ((td :nowrap "nowrap") ,(time-delta (paste-universal-time paste) :level 1 :ago-p nil)) - ((td :width "100%" :bgcolor "#F4F4F4" :nowrap "nowrap") ,(encode-for-pre (max-length (paste-title paste) 50))) - ((td :nowrap "nowrap") ,(length (paste-annotations paste))))) - *pastes*))) + ((td :nowrap "nowrap") ,(time-delta (paste-universal-time paste) :level 1 :ago-p nil)) + ((td :width "100%" :bgcolor "#F4F4F4" :nowrap "nowrap") ,(encode-for-pre (max-length (paste-title paste) 50))) + ((td :nowrap "nowrap") ,(length (paste-annotations paste))))) + *pastes*))) ,@(bottom-links)))))
(defmethod araneida:handle-request-response ((handler rss-handler) method request) @@ -149,9 +148,9 @@ (p "Enter a username, title, and paste contents into the fields below. The paste will be announced on the selected channel @ " ,(irc:server-name *connection*) ".") ,@(if annotate - `((p "This paste will be used to annotate " - ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number annotate))))) ,(concatenate 'string (paste-title annotate) "."))) - ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number annotate)))) + `((p "This paste will be used to annotate " + ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number annotate))))) ,(concatenate 'string (paste-title annotate) "."))) + ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number annotate)))) ((input :type hidden :name "channel" :value ,(paste-channel annotate))))) (hr) (table @@ -169,7 +168,7 @@ ((th :valign top) "Enter your paste:") (td ((textarea :rows 24 :cols 80 :name "text")))) (tr - ((th) "Submit your paste:") + ((th) "Submit your paste:") ((td) ((input :type submit :value "Submit paste")) " " ((input :type reset :value "Clear paste")))))) ,@(bottom-links)))))
@@ -177,7 +176,7 @@ (let ((username (araneida:body-param "username" (araneida:request-body request))) (title (araneida:body-param "title" (araneida:request-body request))) (text (araneida:body-param "text" (araneida:request-body request))) - (annotate (araneida:body-param "annotate" (araneida:request-body request))) + (annotate (araneida:body-param "annotate" (araneida:request-body request))) (channel (araneida:body-param "channel" (araneida:request-body request)))) (araneida:request-send-headers request)
@@ -194,15 +193,15 @@ (new-paste-form request :message "Whatever channel that is, I don't know about it.")) (t (let* ((paste-number (if annotate (parse-integer annotate :junk-allowed t) (incf *paste-counter*))) - (paste-to-annotate (if annotate (find paste-number *pastes* :key #'paste-number))) - (annotation-number (if annotate (incf (paste-annotation-counter paste-to-annotate))))) - (let ((url (araneida:urlstring - (araneida:merge-url *display-paste-url* - (if annotate - (concatenate 'string (prin1-to-string paste-number) - "#" - (prin1-to-string annotation-number)) - (prin1-to-string paste-number)))))) + (paste-to-annotate (if annotate (find paste-number *pastes* :key #'paste-number))) + (annotation-number (if annotate (incf (paste-annotation-counter paste-to-annotate))))) + (let ((url (araneida:urlstring + (araneida:merge-url *display-paste-url* + (if annotate + (concatenate 'string (prin1-to-string paste-number) + "#" + (prin1-to-string annotation-number)) + (prin1-to-string paste-number)))))) (make-new-paste *pastes* (annotate paste-number (paste-annotations paste-to-annotate)) @@ -213,21 +212,21 @@ :contents text :universal-time (get-universal-time) :channel channel) - (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") - (araneida:html-stream - (araneida:request-stream request) - `(html - (head (title "Paste number " ,*paste-counter*) + (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") + (araneida:html-stream + (araneida:request-stream request) + `(html + (head (title "Paste number " ,*paste-counter*) ,(rss-link-header)) - (body - (h1 "Pasted!") - (p ,(if annotate "Your annotation should be available at " "Your paste should be available at ") ((a :href ,url) ,url) ", and was also sent to " ,channel " @ " ,(irc:server-name *connection*)) - (p "If you wish to paste a correction or addendum to this paste, you can annotate the paste using the submission button on the " ((a :href ,url) "paste's page.")) - ,@(bottom-links)))))))))) + (body + (h1 "Pasted!") + (p ,(if annotate "Your annotation should be available at " "Your paste should be available at ") ((a :href ,url) ,url) ", and was also sent to " ,channel " @ " ,(irc:server-name *connection*)) + (p "If you wish to paste a correction or addendum to this paste, you can annotate the paste using the submission button on the " ((a :href ,url) "paste's page.")) + ,@(bottom-links))))))))))
(defun ends-with (str end) (let ((l1 (length str)) - (l2 (length end))) + (l2 (length end))) (if (< l1 l2) nil (string= (subseq str (- l1 l2) l1) end))))
@@ -257,37 +256,37 @@ (let* ((paste-number (parse-integer (araneida::request-unhandled-part request) :junk-allowed t)) - (raw (ends-with (araneida::request-unhandled-part request) "/raw")) + (raw (ends-with (araneida::request-unhandled-part request) "/raw")) (paste (some #'(lambda (element) (and (eql paste-number (paste-number element)) element)) *pastes*))) (if paste - (if raw - (let ((p (position #, (araneida::request-unhandled-part request) :test #'char=))) - (if p (let ((ann (parse-integer (araneida::request-unhandled-part request) :start (1+ p) :junk-allowed t))) - (let ((theann (car (member ann (paste-annotations paste) :key #'paste-number :test #'=)))) - (if theann - (progn - (araneida:request-send-headers request :expires 0 :content-type "text/plain") - (write-string (remove #\Return - (paste-contents theann) - :test #'char=) (araneida:request-stream request)))))) - (progn - (araneida:request-send-headers request :expires 0 :content-type "text/plain") - (write-string (remove #\return - (paste-contents paste) - :test #'char=)(araneida:request-stream request))))) - (progn - (araneida:request-send-headers request :expires 0) - (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") - (araneida:html-stream - (araneida:request-stream request) - `(html - (head - (title "Paste number " ,paste-number) - ,(rss-link-header)) - (body - ,(format-paste paste (araneida:urlstring (araneida:request-url request)) paste-number) + (if raw + (let ((p (position #, (araneida::request-unhandled-part request) :test #'char=))) + (if p (let ((ann (parse-integer (araneida::request-unhandled-part request) :start (1+ p) :junk-allowed t))) + (let ((theann (car (member ann (paste-annotations paste) :key #'paste-number :test #'=)))) + (if theann + (progn + (araneida:request-send-headers request :expires 0 :content-type "text/plain") + (write-string (remove #\Return + (paste-contents theann) + :test #'char=) (araneida:request-stream request)))))) + (progn + (araneida:request-send-headers request :expires 0 :content-type "text/plain") + (write-string (remove #\return + (paste-contents paste) + :test #'char=)(araneida:request-stream request))))) + (progn + (araneida:request-send-headers request :expires 0) + (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") + (araneida:html-stream + (araneida:request-stream request) + `(html + (head + (title "Paste number " ,paste-number) + ,(rss-link-header)) + (body + ,(format-paste paste (araneida:urlstring (araneida:request-url request)) paste-number) ,(if (paste-annotations paste) `(p "Annotations for this paste: " @@ -299,14 +298,14 @@ (araneida:urlstring (araneida:request-url request)) (paste-number a)) (paste-number a) t))) (reverse (paste-annotations paste))))) - `(p "This paste has no annotations.")) - ((form :method post :action ,(araneida:urlstring *new-paste-url*)) - ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number paste)))) - (center ((input :type submit :value "Annotate this paste")))) - ,@(bottom-links)))))) + `(p "This paste has no annotations.")) + ((form :method post :action ,(araneida:urlstring *new-paste-url*)) + ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number paste)))) + (center ((input :type submit :value "Annotate this paste")))) + ,@(bottom-links)))))) (progn - (araneida:request-send-headers request :expires 0) - (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") + (araneida:request-send-headers request :expires 0) + (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") (araneida:html-stream (araneida:request-stream request) `(html @@ -315,7 +314,7 @@ ,(rss-link-header)) (body (h3 "No paste numbered " ,paste-number " could be found.") - ,@(bottom-links)))))))) + ,@(bottom-links))))))))
(araneida:install-handler (araneida:http-listener-handler *paste-listener*)