Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2
Modified Files: README.lisp variable.lisp web-server.lisp Log Message: Random bug fixes
Date: Mon Nov 29 16:47:53 2004 Author: bmastenbrook
Index: lisppaste2/README.lisp diff -u lisppaste2/README.lisp:1.16 lisppaste2/README.lisp:1.17 --- lisppaste2/README.lisp:1.16 Sun Nov 7 22:01:43 2004 +++ lisppaste2/README.lisp Mon Nov 29 16:47:52 2004 @@ -1,4 +1,4 @@ -;;;; $Id: README.lisp,v 1.16 2004/11/07 21:01:43 bmastenbrook Exp $ +;;;; $Id: README.lisp,v 1.17 2004/11/29 15:47:52 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/README.lisp,v $
;;;; See the LICENSE file for licensing information. @@ -42,8 +42,8 @@ "#growl" "#chicken" "#quicksilver" "#svn" "#slate" "#squeak" "#wiki" "#nebula" "#imgames") :nickname "lisppaste" - :server "orwell.freenode.net" + :server "niven.freenode.net" :port 6667) (lisppaste:start-irc-notification - :channels '("#lisppaste" "#pearpc" "#fpc" "#hprog") + :channels '("#lisppaste" "#pearpc" "#fpc" "#hprog" "#concatenative" "#slate-users") :nickname "lisppaste2"))
Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.36 lisppaste2/variable.lisp:1.37 --- lisppaste2/variable.lisp:1.36 Sun Nov 7 22:01:43 2004 +++ lisppaste2/variable.lisp Mon Nov 29 16:47:52 2004 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.36 2004/11/07 21:01:43 bmastenbrook Exp $ +;;;; $Id: variable.lisp,v 1.37 2004/11/29 15:47:52 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $
;;;; See the LICENSE file for licensing information. @@ -127,6 +127,9 @@
(defparameter *email-redirect-url* (araneida:merge-url *paste-external-url* "email")) + +(defparameter *channel-select-url* + (araneida:merge-url *paste-external-url* "channels"))
(defparameter *main-system-server-url* (araneida:merge-url *paste-external-url* "system-server/"))
Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.69 lisppaste2/web-server.lisp:1.70 --- lisppaste2/web-server.lisp:1.69 Sun Nov 7 22:01:43 2004 +++ lisppaste2/web-server.lisp Mon Nov 29 16:47:52 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.69 2004/11/07 21:01:43 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.70 2004/11/29 15:47:52 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
;;;; See the LICENSE file for licensing information. @@ -52,6 +52,8 @@
(defclass email-redirect-handler (lisppaste-basic-handler) ())
+(defclass channel-select-handler (lisppaste-basic-handler) ()) + (defvar *referer-hash* (make-hash-table :test #'equalp))
(defvar *referer-example-hash* (make-hash-table :test #'equalp)) @@ -83,33 +85,35 @@ (incf (gethash "Google" *referer-hash* 0) count)))))
(defmethod araneida:handle-request-response :around ((handler lisppaste-basic-handler) method request) - (progn #+nil with-open-file #+nil (*trace-output* (times-file-for-class handler) + (with-open-file (*trace-output* (times-file-for-class handler) :direction :output :if-exists :append :if-does-not-exist :create) - (time - (progn - (let ((referer (car (araneida:request-header request :referer))) - (araneida::*default-url-defaults* (araneida:request-url request))) - (when (stringp referer) - (let ((url (araneida:parse-urlstring referer nil))) - (when url - (let ((real-host (araneida:url-host url)) - (split-host (split-sequence:split-sequence #. (araneida:url-host url)))) - (if (or - (and (eql (length split-host) 3) - (string-equal (first split-host) "www") - (string-equal (second split-host) "google")) - (and (eql (length split-host) 4) - (string-equal (first split-host) "www") - (string-equal (second split-host) "google") - (or - (string-equal (third split-host) "co") - (string-equal (third split-host) "com")) - (eql (length (fourth split-host)) 2))) - (setf real-host "Google")) - (incf (gethash real-host *referer-hash* 0)) - (setf (gethash real-host *referer-example-hash*) url)))))) - (call-next-method))))) + (unwind-protect + (time + (progn + (let ((referer (car (araneida:request-header request :referer))) + (araneida::*default-url-defaults* (araneida:request-url request))) + (when (stringp referer) + (let ((url (araneida:parse-urlstring referer nil))) + (when url + (let ((real-host (araneida:url-host url)) + (split-host (split-sequence:split-sequence #. (araneida:url-host url)))) + (if (or + (and (eql (length split-host) 3) + (string-equal (first split-host) "www") + (string-equal (second split-host) "google")) + (and (eql (length split-host) 4) + (string-equal (first split-host) "www") + (string-equal (second split-host) "google") + (or + (string-equal (third split-host) "co") + (string-equal (third split-host) "com")) + (eql (length (fourth split-host)) 2))) + (setf real-host "Google")) + (incf (gethash real-host *referer-hash* 0)) + (setf (gethash real-host *referer-example-hash*) url)))))) + (call-next-method))) + (force-output *trace-output*))))
(defun make-css () (let ((colorize:*css-background-class* "paste")) @@ -196,7 +200,7 @@ (araneida:html-stream (araneida:request-stream request) (lisppaste-wrap-page - *paste-site-name* + (format nil "~A pastebin" *paste-site-name*) `((table :width "100%" :border 0 :cellpadding 2) (tr (td ((div :class "small-header") "Recent pastes")) ((td :align right) ((div :class "small-header") "Make a new paste"))) @@ -271,14 +275,9 @@ (and (eql method :post) (araneida:body-param "channel" (araneida:request-body request))) + (substitute ## #/ (araneida::request-unhandled-part request) :test #'char=) (and *no-channel-pastes* - (or - (string-equal (araneida::request-unhandled-part request) "/none") - (string-equal (araneida:request-cookie request "CHANNEL") "None")) "None") - (substitute ## #/ (araneida::request-unhandled-part request) :test #'char=) - (concatenate 'string "#" - (araneida:request-cookie request "CHANNEL")) ))))) (cond ((and default-channel (or (and *no-channel-pastes* @@ -414,6 +413,36 @@ append)) "Full"))))) *channels*)))))
+(defmethod araneida:handle-request-response ((handler channel-select-handler) method request) + (araneida:request-send-headers request :expires 0) + (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") + (araneida:html-stream + (araneida:request-stream request) + (lisppaste-wrap-page + "Select a channel" + `((table :width "100%" :border 0 :cellpadding 2) + ((tr :valign top :align left) + ((td :style "width: 5em;") " ") + (td + ((table :class "info-table") + ,@(mapcar #'(lambda (channel) + `(tr + ((th :align left) + ((a :href ,(concatenate 'string + (araneida:urlstring *new-paste-url*) + "/" + (subseq channel 1))) ,channel) + ))) + (sort (copy-list (remove "None" *channels* :test #'string=)) #'string<)))) + ((td :style "width: 5em;") " ") + (td + ((div :class "info-text") + ,(format nil "Lisppaste is available in a number of channels on the IRC network ~A. Select a channel from the list below and bookmark its URL to paste with direct notification to your channel." *irc-network-name*) + (p) + "Questions? Comments? Want lisppaste in your channel? " ((a :href ,(araneida:urlstring *email-redirect-url*)) "Email me") ".")) + + ((td :style "width: 5em;") " ")))))) + (defun encode-beginning-of-month (month year &key next-month) (if next-month (encode-beginning-of-month (if (eql month 12) 1 (1+ month)) @@ -809,13 +838,22 @@ ,@(if (not annotate) `((tr ((th :align left :width "0%" :nowrap "nowrap") "Select a channel:") - (td ((select :name "channel") - ,@(if (not *no-channel-pastes*) - `(((option :value "")))) - ,@(mapcar #'(lambda (e) - `((option :value ,e ,@(if (string-equal e default-channel) - '(:selected "SELECTED"))) - ,(encode-for-pre e))) *channels*)))))) + (td ,@(if (or (string= default-channel "") + (string= default-channel "None")) + `(,(format nil "To paste to an IRC channel on the network ~A, select a channel from the " + *irc-network-name*) + ((input :type "hidden" :name "channel" :value ,default-channel))) + `(((select :name "channel") + ,@(mapcar #'(lambda (e) + `((option :value ,e ,@(if (string-equal e default-channel) + '(:selected "SELECTED"))) + ,(encode-for-pre e))) + (list* default-channel (if *no-channel-pastes* '("None"))))) + (br) + ,(format nil "To paste to a different IRC channel on the network ~A, select a channel from the " + *irc-network-name*))) + ((a :href ,(araneida:urlstring *channel-select-url*)) "channel list") + ".")))) (tr ((th :align left :width "0%" :nowrap "nowrap") "Enter your username:") (td ((input :type text :name "username" @@ -1042,9 +1080,10 @@ (colorize-string (or (araneida:body-param "colorize" (araneida:request-body request)) (and paste - (when (eql (paste-colorization-mode paste) :none) - (setf (paste-colorization-mode paste) "") - nil) + (if (eql (paste-colorization-mode paste) :none) + (progn (setf (paste-colorization-mode paste) "") + nil) + t) (> (length (paste-colorization-mode paste)) 0) (paste-colorization-mode paste)) )) @@ -1103,7 +1142,7 @@ (araneida:html-stream (araneida:request-stream request) (lisppaste-wrap-page - (format nil "Paste number ~A" paste-number) + (format nil "Paste number ~A: ~A" paste-number (encode-for-pre (paste-title paste))) `(div ((form :method post :action ,(araneida:urlstring *new-paste-url*)) (center @@ -1236,3 +1275,8 @@ (araneida:http-listener-handler *paste-listener*) (make-instance 'email-redirect-handler) (araneida:urlstring *email-redirect-url*) t) + +(araneida:install-handler + (araneida:http-listener-handler *paste-listener*) + (make-instance 'channel-select-handler) + (araneida:urlstring *channel-select-url*) t)