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