[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp lisppaste2/encode-for-pre.lisp

[Brian Mastenbrook]

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))