[Lisppaste-cvs] CVS update: lisppaste2/README.lisp lisppaste2/variable.lisp lisppaste2/web-server.lisp
Brian Mastenbrook
bmastenbrook at common-lisp.net
Mon Nov 29 15:47:54 UTC 2004
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)
More information about the Lisppaste-cvs
mailing list