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