Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: web-server.lisp encode-for-pre.lisp Log Message: recent fixes and new features Date: Wed Mar 31 16:33:07 2004 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.43 lisppaste2/web-server.lisp:1.44 --- lisppaste2/web-server.lisp:1.43 Thu Mar 11 09:21:34 2004 +++ lisppaste2/web-server.lisp Wed Mar 31 16:33:07 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.43 2004/03/11 14:21:34 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.44 2004/03/31 21:33:07 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -35,7 +35,11 @@ (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))) - (default-channel (substitute #\# #\/ (araneida::request-unhandled-part request) :test #'char=))) + (default-channel (find-if #'(lambda (e) (> (length e) 1)) + (list + (substitute #\# #\/ (araneida::request-unhandled-part request) :test #'char=) + (concatenate 'string "#" + (araneida:request-cookie request "CHANNEL")))))) (new-paste-form request :annotate annotate :default-channel default-channel))) (defun bottom-links () @@ -298,7 +302,8 @@ (text (araneida:body-param "text" (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) + (araneida:request-send-headers request :expires 0 + :set-cookie (format nil "CHANNEL=~A; path=/" (subseq channel 1))) (cond ((zerop (length username)) @@ -336,12 +341,15 @@ (araneida:html-stream (araneida:request-stream request) `(html - (head (title "Paste number " ,*paste-counter*) + (head (title "Paste number " ,paste-number) ,(rss-link-header)) (body (h2 "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.")) + (h3 "Don't paste more junk; annotate!") + ((form :method post :action ,(araneida:urlstring *new-paste-url*)) + ((input :type hidden :name "annotate" :value ,(prin1-to-string paste-number))) + (center ((input :type submit :value "Annotate this paste")))) ,@(bottom-links)))))))))) (defun ends-with (str end) @@ -354,7 +362,7 @@ `((table :width "100%" :cellpadding 2) (tr ((td :align "left" :width "0%" :nowrap "nowrap") ,(if annotation - "Annotation number " + `((a :name ,(prin1-to-string paste-number)) "Annotation number ") "Paste number ") ,paste-number ": ") ((td :align "left" :width "100%") (b ,(encode-for-pre (paste-title paste))))) (tr ((td :align "left" :nowrap "nowrap") "Pasted by: ") Index: lisppaste2/encode-for-pre.lisp diff -u lisppaste2/encode-for-pre.lisp:1.12 lisppaste2/encode-for-pre.lisp:1.13 --- lisppaste2/encode-for-pre.lisp:1.12 Wed Mar 31 16:25:14 2004 +++ lisppaste2/encode-for-pre.lisp Wed Mar 31 16:33:07 2004 @@ -1,4 +1,4 @@ -;;;; $Id: encode-for-pre.lisp,v 1.12 2004/03/31 21:25:14 bmastenbrook Exp $ +;;;; $Id: encode-for-pre.lisp,v 1.13 2004/03/31 21:33:07 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -10,7 +10,7 @@ summing (if (not only-in-dup) (if (char= (elt str i) char) (length repstr) 1) - (if (> i 1) + (if (> i 0) (if (and (member (elt str (1- i)) only-in-dup :test #'char=) (char= (elt str i) char)) (length repstr) 1) 1)))) @@ -18,7 +18,7 @@ (loop for i from 0 to (1- (length str)) with j = 0 do (if (if only-in-dup - (and (> i 1) (char= (elt str i) char) + (and (> i 0) (char= (elt str i) char) (member (elt str (1- i)) only-in-dup :test #'char=)) (char= (elt str i) char)) @@ -47,7 +47,7 @@ str)) (defun encode-for-tt (str) - (replace-in-string-1 (replace-in-string str '(#\& #\< #\> #\newline #\return #\linefeed #\tab) '("&" "<" ">" "<br>" "" "" "    ")) #\space " " '(#\space #\>))) + (replace-first-space (replace-in-string-1 (replace-in-string str '(#\& #\< #\> #\newline #\return #\linefeed #\tab) '("&" "<" ">" "<br>" "" "" "    ")) #\space " " '(#\space #\>)))) (defun encode-for-http (str) (replace-in-string-1 str #\> (format nil ">~%") nil))