Update of /project/lisppaste/cvsroot/lisppaste2
In directory common-lisp.net:/tmp/cvs-serv14272
Modified Files:
encode-for-pre.lisp lisppaste.asd lisppaste.lisp variable.lisp
web-server.lisp
Log Message:
Add multiple channel support; allow line-wrapping of pastes
Date: Sat Jan 17 12:54:13 2004
Author: bmastenbrook
Index: lisppaste2/encode-for-pre.lisp
diff -u lisppaste2/encode-for-pre.lisp:1.6 lisppaste2/encode-for-pre.lisp:1.7
--- lisppaste2/encode-for-pre.lisp:1.6 Sun Nov 30 17:32:45 2003
+++ lisppaste2/encode-for-pre.lisp Sat Jan 17 12:54:13 2004
@@ -1,18 +1,26 @@
-;;;; $Id: encode-for-pre.lisp,v 1.6 2003/11/30 22:32:45 bmastenbrook Exp $
+;;;; $Id: encode-for-pre.lisp,v 1.7 2004/01/17 17:54:13 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)
+(defun replace-in-string-1 (str char repstr &optional only-in-dup)
(let* ((new-length (loop for i from 0 to (1- (length str))
- summing (if (char= (elt str i) char)
- (length repstr) 1)))
+ summing (if (not only-in-dup)
+ (if (char= (elt str i) char)
+ (length repstr) 1)
+ (if (< i (1- (length str)))
+ (if (and (char= (elt str i) char)
+ (char= (elt str (1+ i)) char))
+ (length repstr) 1) 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)
+ do (if (if only-in-dup
+ (and (< i (1- (length str))) (and (char= (elt str i) char)
+ (char= (elt str (1+ i)) char)))
+ (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)))
@@ -33,4 +41,4 @@
(replace-in-string str '(#\& #\< #\>) '("&" "<" ">")))
(defun encode-for-tt (str)
- (replace-in-string str '(#\& #\< #\> #\newline #\return #\linefeed #\space #\tab) '("&" "<" ">" "" "<br>" "" " " " ")))
\ No newline at end of file
+ (replace-in-string-1 (replace-in-string str '(#\& #\< #\> #\newline #\return #\linefeed #\tab) '("&" "<" ">" "" "<br>" "" " ")) #\space " " 1))
\ No newline at end of file
Index: lisppaste2/lisppaste.asd
diff -u lisppaste2/lisppaste.asd:1.1.1.1 lisppaste2/lisppaste.asd:1.2
--- lisppaste2/lisppaste.asd:1.1.1.1 Mon Nov 3 12:17:53 2003
+++ lisppaste2/lisppaste.asd Sat Jan 17 12:54:13 2004
@@ -1,4 +1,4 @@
-;;;; $Id: lisppaste.asd,v 1.1.1.1 2003/11/03 17:17:53 eenge Exp $
+;;;; $Id: lisppaste.asd,v 1.2 2004/01/17 17:54:13 bmastenbrook Exp $
;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.asd,v $
;;;; See the LICENSE file for licensing information.
@@ -20,7 +20,7 @@
paste text into it. Once pasted, lisppaste will notify a
pre-configured IRC channel about the paste and where it can be
located."
- :depends-on (:araneida :net-nittin-irc)
+ :depends-on (:araneida :cl-irc)
:components ((:file "package")
(:file "variable"
:depends-on ("package"))
Index: lisppaste2/lisppaste.lisp
diff -u lisppaste2/lisppaste.lisp:1.2 lisppaste2/lisppaste.lisp:1.3
--- lisppaste2/lisppaste.lisp:1.2 Mon Nov 10 11:28:43 2003
+++ lisppaste2/lisppaste.lisp Sat Jan 17 12:54:13 2004
@@ -1,11 +1,11 @@
-;;;; $Id: lisppaste.lisp,v 1.2 2003/11/10 16:28:43 eenge Exp $
+;;;; $Id: lisppaste.lisp,v 1.3 2004/01/17 17:54:13 bmastenbrook Exp $
;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.lisp,v $
;;;; See the LICENSE file for licensing information.
(in-package :lisppaste)
-(defun start-lisppaste (&key (channel *default-channel*)
+(defun start-lisppaste (&key (channels (list *default-channel*))
(nickname *default-nickname*)
(server *default-irc-server*)
(port *default-irc-server-port*))
@@ -15,8 +15,7 @@
:server server
:port port)))
(setf *connection* connection)
- (setf *channel* channel)
- (irc:join connection channel)
+ (setf *channels* channels)
+ (mapcar #'(lambda (channel) (irc:join connection channel)) channels)
(araneida:start-listening *paste-listener*)
- (irc:read-message-loop connection)))
-
+ (irc:read-message-loop connection)))
\ No newline at end of file
Index: lisppaste2/variable.lisp
diff -u lisppaste2/variable.lisp:1.4 lisppaste2/variable.lisp:1.5
--- lisppaste2/variable.lisp:1.4 Tue Nov 11 23:19:38 2003
+++ lisppaste2/variable.lisp Sat Jan 17 12:54:13 2004
@@ -1,4 +1,4 @@
-;;;; $Id: variable.lisp,v 1.4 2003/11/12 04:19:38 bmastenbrook Exp $
+;;;; $Id: variable.lisp,v 1.5 2004/01/17 17:54:13 bmastenbrook Exp $
;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $
;;;; See the LICENSE file for licensing information.
@@ -55,4 +55,4 @@
(defvar *pastes* nil)
(defvar *paste-counter* 0)
(defvar *connection* nil)
-(defvar *channel* "")
\ No newline at end of file
+(defvar *channels* nil)
\ No newline at end of file
Index: lisppaste2/web-server.lisp
diff -u lisppaste2/web-server.lisp:1.16 lisppaste2/web-server.lisp:1.17
--- lisppaste2/web-server.lisp:1.16 Wed Nov 12 01:23:43 2003
+++ lisppaste2/web-server.lisp Sat Jan 17 12:54:13 2004
@@ -1,4 +1,4 @@
-;;;; $Id: web-server.lisp,v 1.16 2003/11/12 06:23:43 bmastenbrook Exp $
+;;;; $Id: web-server.lisp,v 1.17 2004/01/17 17:54:13 bmastenbrook Exp $
;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
;;;; See the LICENSE file for licensing information.
@@ -13,7 +13,8 @@
(universal-time nil :type integer)
(is-annotation nil :type boolean)
(annotations nil :type list)
- (annotation-counter 0 :type integer))
+ (annotation-counter 0 :type integer)
+ (channel "" :type string))
(defclass new-paste-handler (araneida:handler) ())
@@ -81,11 +82,12 @@
(body
(center (h2 "All pastes in system"))
((table :width "100%" :cellpadding 2)
- (tr (td) (td "By") (td "When") (td "Titled") (td "Ann."))
+ (tr (td) (td "By") (td "Where") (td "When") (td "Titled") (td "Ann."))
,@(reverse (mapcar #'(lambda (paste)
`(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) ,(encode-for-pre (paste-channel 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)))))
@@ -102,13 +104,18 @@
((font :color red) (h2 ,message))
((form :method post :action ,(araneida:urlstring *submit-paste-url*))
(p "Enter a username, title, and paste contents into the fields below. The
-paste will be announced on " ,*channel* " @ " ,(irc:server-name *connection*) ".")
+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))))))
+ ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number annotate))))
+ ((input :type hidden :name "channel" :value ,(paste-channel annotate)))))
(hr)
(table
+ ,@(if (not annotate)
+ `((tr
+ (th "Select a channel:")
+ (td ((select :name "channel") ,@(mapcar #'(lambda (e) `((option :value ,e) ,(encode-for-pre e))) *channels*))))))
(tr
(th "Enter your username:")
(td ((input :type text :name "username"))))
@@ -127,7 +134,8 @@
(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)
(cond
@@ -139,8 +147,9 @@
(new-paste-form request :message "Please enter your paste."))
((and annotate (not (parse-integer annotate :junk-allowed t)))
(new-paste-form request :message "Malformed annotation request."))
+ ((not (member channel *channels* :test #'string-equal))
+ (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)))))
@@ -155,11 +164,12 @@
:user username
:title title
:contents text
- :universal-time (get-universal-time))))
- (irc:privmsg *connection* *channel*
+ :universal-time (get-universal-time)
+ :channel channel)))
+ (irc:privmsg *connection* channel
(if annotate
- (format nil "~A annotated #~A with ~A at ~A" username paste-number title url)
- (format nil "~A pasted ~A at ~A" username title url)))
+ (format nil "~A annotated #~A with \"~A\" at ~A" username paste-number title url)
+ (format nil "~A pasted \"~A\" at ~A" username title url)))
(if annotate
(push paste (paste-annotations paste-to-annotate))
(push paste *pastes*))
@@ -169,7 +179,7 @@
(head (title "Paste number " ,*paste-counter*))
(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 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))))))))))
@@ -196,6 +206,8 @@
((td :align "left" :width "100%") ,(encode-for-pre (paste-user paste))))
(tr (td)
((td :align "left" :width "100%") ,(time-delta (paste-universal-time paste))))
+ (tr (td)
+ ((td :align "left" :width "100%") ,(encode-for-pre (paste-channel paste))))
(tr ((td :align "left" :valign "top" :nowrap) "Paste contents:")
((td :width "100%")))
(tr (td (p)))
