[Lisppaste-cvs] CVS update: lisppaste2/lisppaste.asd lisppaste2/lisppaste.lisp lisppaste2/persistent-pastes.lisp lisppaste2/web-server.lisp
Brian Mastenbrook
bmastenbrook at common-lisp.net
Sun Mar 7 18:16:27 UTC 2004
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)
, at 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*)
More information about the Lisppaste-cvs
mailing list