November 2003 - lisppaste-cvs@common-lisp.net

[Lisppaste-cvs] CVS update: lisppaste2/encode-for-pre.lisp
by Brian Mastenbrook 30 Nov '03

30 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv19766 Modified Files: encode-for-pre.lisp Log Message: Further optimization Date: Sun Nov 30 17:32:45 2003 Author: bmastenbrook Index: lisppaste2/encode-for-pre.lisp diff -u lisppaste2/encode-for-pre.lisp:1.5 lisppaste2/encode-for-pre.lisp:1.6 --- lisppaste2/encode-for-pre.lisp:1.5 Sun Nov 30 17:16:45 2003 +++ lisppaste2/encode-for-pre.lisp Sun Nov 30 17:32:45 2003 @@ -1,23 +1,32 @@ -;;;; $Id: encode-for-pre.lisp,v 1.5 2003/11/30 22:16:45 bmastenbrook Exp $ +;;;; $Id: encode-for-pre.lisp,v 1.6 2003/11/30 22:32:45 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $ ;;;; See the LICENSE file for licensing information. (in-package :lisppaste) +(defun replace-in-string-1 (str char repstr) + (let* ((new-length (loop for i from 0 to (1- (length str)) + summing (if (char= (elt str i) char) + (length repstr) 1))) + (new-array (make-array `(,new-length) :element-type 'character))) + (loop for i from 0 to (1- (length str)) + with j = 0 + do (if (char= (elt str i) char) + (progn + (loop for k from 0 to (1- (length repstr)) + do (setf (elt new-array (+ j k)) (elt repstr k))) + (incf j (length repstr))) + (progn + (setf (elt new-array j) (elt str i)) + (incf j)))) + new-array)) + (defun replace-in-string (str chars repstrs) (declare (type string str)) (let ((stri str)) (loop for char in chars for repstr in repstrs do - (let ((startpos 0)) - (tagbody - start - (let ((pos (position char stri :test #'char= :start startpos))) - (when pos - (setf stri (concatenate 'string (subseq stri 0 pos) repstr (subseq stri (1+ pos) (length stri)))) - (setf startpos (+ pos (length repstr))) - (go start)))) - stri)) + (setf stri (replace-in-string-1 stri char repstr))) stri)) (defun encode-for-pre (str)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/encode-for-pre.lisp
by Brian Mastenbrook 30 Nov '03

30 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv13757 Modified Files: encode-for-pre.lisp Log Message: Attempt to make this a little less slow Date: Sun Nov 30 17:16:46 2003 Author: bmastenbrook Index: lisppaste2/encode-for-pre.lisp diff -u lisppaste2/encode-for-pre.lisp:1.4 lisppaste2/encode-for-pre.lisp:1.5 --- lisppaste2/encode-for-pre.lisp:1.4 Wed Nov 12 23:34:20 2003 +++ lisppaste2/encode-for-pre.lisp Sun Nov 30 17:16:45 2003 @@ -1,32 +1,27 @@ -;;;; $Id: encode-for-pre.lisp,v 1.4 2003/11/13 04:34:20 bmastenbrook Exp $ +;;;; $Id: encode-for-pre.lisp,v 1.5 2003/11/30 22:16:45 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $ ;;;; See the LICENSE file for licensing information. (in-package :lisppaste) -(defun replace-in-string (str char repstr) - (declare (type string str repstr)) - (let ((stri str) - (startpos 0)) - (tagbody - start - (let ((pos (position char stri :test #'char= :start startpos))) - (when pos - (setf stri (concatenate 'string (subseq stri 0 pos) repstr (subseq stri (1+ pos) (length stri)))) - (setf startpos (+ pos (length repstr))) - (go start)))) - stri)) +(defun replace-in-string (str chars repstrs) + (declare (type string str)) + (let ((stri str)) + (loop for char in chars for repstr in repstrs do + (let ((startpos 0)) + (tagbody + start + (let ((pos (position char stri :test #'char= :start startpos))) + (when pos + (setf stri (concatenate 'string (subseq stri 0 pos) repstr (subseq stri (1+ pos) (length stri)))) + (setf startpos (+ pos (length repstr))) + (go start)))) + stri)) + stri)) (defun encode-for-pre (str) - (replace-in-string - (replace-in-string - (replace-in-string str #\& "&") #\< "<") #\> ">")) + (replace-in-string str '(#\& #\< #\>) '("&" "<" ">"))) (defun encode-for-tt (str) - (replace-in-string - (replace-in-string - (replace-in-string - (replace-in-string - (replace-in-string (encode-for-pre str) #\newline "") #\return " ") #\linefeed "") - #\space " ") #\tab "    ")) \ No newline at end of file + (replace-in-string str '(#\& #\< #\> #\newline #\return #\linefeed #\space #\tab) '("&" "<" ">" "" " " "" " " "    "))) \ No newline at end of file

1 0

[Lisppaste-cvs] CVS update: lisppaste2/encode-for-pre.lisp
by Brian Mastenbrook 12 Nov '03

12 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv24534 Modified Files: encode-for-pre.lisp Log Message: One more fix Date: Wed Nov 12 23:34:20 2003 Author: bmastenbrook Index: lisppaste2/encode-for-pre.lisp diff -u lisppaste2/encode-for-pre.lisp:1.3 lisppaste2/encode-for-pre.lisp:1.4 --- lisppaste2/encode-for-pre.lisp:1.3 Wed Nov 12 23:30:54 2003 +++ lisppaste2/encode-for-pre.lisp Wed Nov 12 23:34:20 2003 @@ -1,4 +1,4 @@ -;;;; $Id: encode-for-pre.lisp,v 1.3 2003/11/13 04:30:54 bmastenbrook Exp $ +;;;; $Id: encode-for-pre.lisp,v 1.4 2003/11/13 04:34:20 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -28,5 +28,5 @@ (replace-in-string (replace-in-string (replace-in-string - (replace-in-string str #\newline "") #\return " ") #\linefeed "") + (replace-in-string (encode-for-pre str) #\newline "") #\return " ") #\linefeed "") #\space " ") #\tab "    "))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/encode-for-pre.lisp
by Brian Mastenbrook 12 Nov '03

12 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv22707 Modified Files: encode-for-pre.lisp Log Message: Fix for multiple spaces. Date: Wed Nov 12 23:30:55 2003 Author: bmastenbrook Index: lisppaste2/encode-for-pre.lisp diff -u lisppaste2/encode-for-pre.lisp:1.2 lisppaste2/encode-for-pre.lisp:1.3 --- lisppaste2/encode-for-pre.lisp:1.2 Wed Nov 12 00:58:56 2003 +++ lisppaste2/encode-for-pre.lisp Wed Nov 12 23:30:54 2003 @@ -1,4 +1,4 @@ -;;;; $Id: encode-for-pre.lisp,v 1.2 2003/11/12 05:58:56 bmastenbrook Exp $ +;;;; $Id: encode-for-pre.lisp,v 1.3 2003/11/13 04:30:54 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -26,4 +26,7 @@ (defun encode-for-tt (str) (replace-in-string (replace-in-string - (replace-in-string str #\newline "") #\return " ") #\linefeed "")) \ No newline at end of file + (replace-in-string + (replace-in-string + (replace-in-string str #\newline "") #\return " ") #\linefeed "") + #\space " ") #\tab "    ")) \ No newline at end of file

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Brian Mastenbrook 12 Nov '03

12 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv24766 Modified Files: web-server.lisp Log Message: Removing redundant superflous verbage. Date: Wed Nov 12 01:23:43 2003 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.15 lisppaste2/web-server.lisp:1.16 --- lisppaste2/web-server.lisp:1.15 Wed Nov 12 01:18:55 2003 +++ lisppaste2/web-server.lisp Wed Nov 12 01:23:43 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.15 2003/11/12 06:18:55 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.16 2003/11/12 06:23:43 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -207,16 +207,16 @@ (mapcar #'(lambda (a) `((tr (td (p)) (td)) (tr - (td ((a :name ,(prin1-to-string (paste-number a))) "Annotation title:")) + (td ((a :name ,(prin1-to-string (paste-number a))) "Title:")) ((td :align "left") ,(encode-for-pre (paste-title a)))) (tr - (td "Annotated by:") + (td "By:") ((td :align "left") ,(encode-for-pre (paste-user a)))) (tr (td) ((td :align "left") ,(time-delta (paste-universal-time a)))) (tr - ((td :valign "top" :nowrap) "Annotation contents:") + ((td :valign "top" :nowrap) "Contents:") ((td :bgcolor "#F4F4F4" :width "100%") (tt ,(encode-for-tt (paste-contents a))))))) (paste-annotations paste))))) `((tr (td (p)) (td))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Brian Mastenbrook 12 Nov '03

12 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv23000 Modified Files: web-server.lisp Log Message: Added a note about the annotation functionality on the post-submission page. Date: Wed Nov 12 01:18:55 2003 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.14 lisppaste2/web-server.lisp:1.15 --- lisppaste2/web-server.lisp:1.14 Wed Nov 12 01:04:14 2003 +++ lisppaste2/web-server.lisp Wed Nov 12 01:18:55 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.14 2003/11/12 06:04:14 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.15 2003/11/12 06:18:55 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -170,6 +170,7 @@ (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)))))))))) (defmethod araneida:handle-request-response ((handler display-paste-handler) method request)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Brian Mastenbrook 12 Nov '03

12 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv18295 Modified Files: web-server.lisp Log Message: Fix the order of the annotations Date: Wed Nov 12 01:04:14 2003 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.13 lisppaste2/web-server.lisp:1.14 --- lisppaste2/web-server.lisp:1.13 Wed Nov 12 00:58:56 2003 +++ lisppaste2/web-server.lisp Wed Nov 12 01:04:14 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.13 2003/11/12 05:58:56 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.14 2003/11/12 06:04:14 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -202,7 +202,7 @@ ,@(if (paste-annotations paste) `((tr (td (p)) (td)) (tr ((th :align "left" :colspan 2) "Annotations for this paste: ")) - ,@(reduce #'append + ,@(reduce #'append (nreverse (mapcar #'(lambda (a) `((tr (td (p)) (td)) (tr @@ -217,7 +217,7 @@ (tr ((td :valign "top" :nowrap) "Annotation contents:") ((td :bgcolor "#F4F4F4" :width "100%") (tt ,(encode-for-tt (paste-contents a))))))) - (paste-annotations paste)))) + (paste-annotations paste))))) `((tr (td (p)) (td)) (tr ((td :align "left" :colspan 2 :nowrap) "This paste has no annotations."))))) (p)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/encode-for-pre.lisp lisppaste2/web-server.lisp
by Brian Mastenbrook 11 Nov '03

11 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv14987 Modified Files: encode-for-pre.lisp web-server.lisp Log Message: Use encode-for-tt and <tt> Date: Wed Nov 12 00:58:56 2003 Author: bmastenbrook Index: lisppaste2/encode-for-pre.lisp diff -u lisppaste2/encode-for-pre.lisp:1.1.1.1 lisppaste2/encode-for-pre.lisp:1.2 --- lisppaste2/encode-for-pre.lisp:1.1.1.1 Mon Nov 3 12:17:53 2003 +++ lisppaste2/encode-for-pre.lisp Wed Nov 12 00:58:56 2003 @@ -1,4 +1,4 @@ -;;;; $Id: encode-for-pre.lisp,v 1.1.1.1 2003/11/03 17:17:53 eenge Exp $ +;;;; $Id: encode-for-pre.lisp,v 1.2 2003/11/12 05:58:56 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -21,4 +21,9 @@ (defun encode-for-pre (str) (replace-in-string (replace-in-string - (replace-in-string str #\& "&") #\< "<") #\> ">")) \ No newline at end of file + (replace-in-string str #\& "&") #\< "<") #\> ">")) + +(defun encode-for-tt (str) + (replace-in-string + (replace-in-string + (replace-in-string str #\newline "") #\return " ") #\linefeed "")) \ No newline at end of file Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.12 lisppaste2/web-server.lisp:1.13 --- lisppaste2/web-server.lisp:1.12 Wed Nov 12 00:43:11 2003 +++ lisppaste2/web-server.lisp Wed Nov 12 00:58:56 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.12 2003/11/12 05:43:11 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.13 2003/11/12 05:58:56 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -189,16 +189,16 @@ (title "Paste number " ,paste-number)) (body ((table :width "100%" :cellpadding 2) - (tr ((td :align "left" :nowrap) "Paste number " ,paste-number ": ") - ((td :width "100%" :align "left") (b ,(encode-for-pre (paste-title paste))))) + (tr ((td :align "left" :width "0%" :nowrap) "Paste number " ,paste-number ": ") + ((td :align "left" :width "100%") (b ,(encode-for-pre (paste-title paste))))) (tr ((td :align "left" :nowrap) "Pasted by: ") - ((td :width "100%" :align "left") ,(encode-for-pre (paste-user paste)))) + ((td :align "left" :width "100%") ,(encode-for-pre (paste-user paste)))) (tr (td) - ((td :width "100%" :align "left") ,(time-delta (paste-universal-time paste)))) + ((td :align "left" :width "100%") ,(time-delta (paste-universal-time paste)))) (tr ((td :align "left" :valign "top" :nowrap) "Paste contents:") - (td)) + ((td :width "100%"))) (tr (td (p))) - (tr ((td :bgcolor "#F4F4F4" :colspan 2 :width "100%") (pre ,(encode-for-pre (paste-contents paste))))) + (tr ((td :bgcolor "#F4F4F4" :colspan 2 :width "100%") (tt ,(encode-for-tt (paste-contents paste))))) ,@(if (paste-annotations paste) `((tr (td (p)) (td)) (tr ((th :align "left" :colspan 2) "Annotations for this paste: ")) @@ -216,7 +216,7 @@ ((td :align "left") ,(time-delta (paste-universal-time a)))) (tr ((td :valign "top" :nowrap) "Annotation contents:") - ((td :bgcolor "#F4F4F4" :width "100%") (pre ,(encode-for-pre (paste-contents a))))))) + ((td :bgcolor "#F4F4F4" :width "100%") (tt ,(encode-for-tt (paste-contents a))))))) (paste-annotations paste)))) `((tr (td (p)) (td)) (tr ((td :align "left" :colspan 2 :nowrap) "This paste has no annotations.")))))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Brian Mastenbrook 11 Nov '03

11 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv9265 Modified Files: web-server.lisp Log Message: Minor changes Date: Wed Nov 12 00:43:12 2003 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.11 lisppaste2/web-server.lisp:1.12 --- lisppaste2/web-server.lisp:1.11 Wed Nov 12 00:38:46 2003 +++ lisppaste2/web-server.lisp Wed Nov 12 00:43:11 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.11 2003/11/12 05:38:46 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.12 2003/11/12 05:43:11 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -38,12 +38,12 @@ " | " ((a :href "http://common-lisp.net/project/lisppaste") "lisppaste home page"))) -(defun time-delta (time) +(defun time-delta (time &optional (level 2)) (let ((delta (- (get-universal-time) time))) (cond ((< delta 1) "<Doc Brown>From the future...</Doc Brown>") ((< delta (* 60 60)) (format nil "~A ago" (time-delta-primitive delta 1))) - (t (format nil "~A ago" (time-delta-primitive delta)))))) + (t (format nil "~A ago" (time-delta-primitive delta level)))))) (defun first-<-mod (n &rest nums) (some #'(lambda (n2) @@ -86,7 +86,7 @@ `(tr ((td :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) ,(encode-for-pre (paste-user paste))) - ((td :nowrap) ,(time-delta (paste-universal-time paste))) + ((td :nowrap) ,(time-delta (paste-universal-time paste) 1)) ((td :width "100%" :bgcolor "#F4F4F4" :nowrap) ,(encode-for-pre (paste-title paste))) ((td :nowrap) ,(length (paste-annotations paste))))) *pastes*))) @@ -207,13 +207,13 @@ `((tr (td (p)) (td)) (tr (td ((a :name ,(prin1-to-string (paste-number a))) "Annotation title:")) - (td ,(encode-for-pre (paste-title a)))) + ((td :align "left") ,(encode-for-pre (paste-title a)))) (tr (td "Annotated by:") - (td ,(encode-for-pre (paste-user a)))) + ((td :align "left") ,(encode-for-pre (paste-user a)))) (tr (td) - (td ,(time-delta (paste-universal-time a)))) + ((td :align "left") ,(time-delta (paste-universal-time a)))) (tr ((td :valign "top" :nowrap) "Annotation contents:") ((td :bgcolor "#F4F4F4" :width "100%") (pre ,(encode-for-pre (paste-contents a)))))))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Brian Mastenbrook 11 Nov '03

11 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv7490 Modified Files: web-server.lisp Log Message: Changed HTML output a slight bit Date: Wed Nov 12 00:38:46 2003 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.10 lisppaste2/web-server.lisp:1.11 --- lisppaste2/web-server.lisp:1.10 Tue Nov 11 23:38:11 2003 +++ lisppaste2/web-server.lisp Wed Nov 12 00:38:46 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.10 2003/11/12 04:38:11 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.11 2003/11/12 05:38:46 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -190,11 +190,11 @@ (body ((table :width "100%" :cellpadding 2) (tr ((td :align "left" :nowrap) "Paste number " ,paste-number ": ") - ((td :width "100%") (b ,(encode-for-pre (paste-title paste))))) + ((td :width "100%" :align "left") (b ,(encode-for-pre (paste-title paste))))) (tr ((td :align "left" :nowrap) "Pasted by: ") - ((td :width "100%") ,(encode-for-pre (paste-user paste)))) + ((td :width "100%" :align "left") ,(encode-for-pre (paste-user paste)))) (tr (td) - ((td :width "100%") ,(time-delta (paste-universal-time paste)))) + ((td :width "100%" :align "left") ,(time-delta (paste-universal-time paste)))) (tr ((td :align "left" :valign "top" :nowrap) "Paste contents:") (td)) (tr (td (p))) @@ -206,7 +206,7 @@ (mapcar #'(lambda (a) `((tr (td (p)) (td)) (tr - (td ((a :name ,(prin1-to-string (paste-number a)))"Annotation title:")) + (td ((a :name ,(prin1-to-string (paste-number a))) "Annotation title:")) (td ,(encode-for-pre (paste-title a)))) (tr (td "Annotated by:")

1 0