- lisppaste-cvs@common-lisp.net - mailman3.common-lisp.net

[Lisppaste-cvs] CVS update: lisppaste2/variable.lisp
by Brian Mastenbrook 06 Jul '04

06 Jul '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/test/lisppaste2 Modified Files: variable.lisp Log Message: New variable.lisp Date: Tue Jul 6 09:59:59 2004 Author: bmastenbrook Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.25 lisppaste2/variable.lisp:1.26 --- lisppaste2/variable.lisp:1.25 Tue Jul 6 09:57:56 2004 +++ lisppaste2/variable.lisp Tue Jul 6 09:59:59 2004 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.25 2004/07/06 16:57:56 bmastenbrook Exp $ +;;;; $Id: variable.lisp,v 1.26 2004/07/06 16:59:59 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -23,12 +23,12 @@ (in-package :lisppaste) -(defparameter *internal-http-port* 8081 +(defparameter *internal-http-port* 8000 "Port lisppaste's araneida will listen on for requests from Apache.") -(defparameter *external-http-port* 80 +(defparameter *external-http-port* 8000 "Port lisppaste's araneida will listen on for requests from remote clients.") -(defparameter *paste-site-name* "paste.lisp.org" +(defparameter *paste-site-name* "localhost" "Website we are running on (used for creating links).") (defparameter *paste-external-url* @@ -37,13 +37,8 @@ :host *paste-site-name* ;;; comment out this next line when running ;;; behind a proxying apache - #| :port *external-http-port* |# - ) "/")) - -(defparameter *old-url* (araneida:merge-url - (araneida:make-url :scheme "http" - :host "www.common-lisp.net") - "/paste/")) + :port *external-http-port* + ) "/paste/")) (defvar *meme-links* t) ; whether to link to meme IRC logs, probably ; only useful for freenode's lisppaste @@ -112,17 +107,13 @@ (araneida:merge-url *paste-external-url* "lisppaste.css")) (defvar *paste-listener* - (let ((fwd-url (araneida:copy-url *paste-external-url*)) - (fwd-old-url (araneida:copy-url *old-url*))) + (let ((fwd-url (araneida:copy-url *paste-external-url*))) (setf (araneida:url-port fwd-url) *internal-http-port*) - (setf (araneida:url-port fwd-old-url) *internal-http-port*) (make-instance #+sbcl 'araneida:serve-event-reverse-proxy-listener #-sbcl 'araneida:threaded-reverse-proxy-listener :translations `((,(araneida:urlstring *paste-external-url*) - ,(araneida:urlstring fwd-url)) - (,(araneida:urlstring *old-url*) - ,(araneida:urlstring fwd-old-url))) + ,(araneida:urlstring fwd-url))) :address #(0 0 0 0) :port (araneida:url-port fwd-url))))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Brian Mastenbrook 06 Jul '04

06 Jul '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: web-server.lisp Log Message: Make the timing go to the same dir as lisppaste Date: Tue Jul 6 09:58:13 2004 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.60 lisppaste2/web-server.lisp:1.61 --- lisppaste2/web-server.lisp:1.60 Tue Jul 6 09:33:46 2004 +++ lisppaste2/web-server.lisp Tue Jul 6 09:58:13 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.60 2004/07/06 16:33:46 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.61 2004/07/06 16:58:13 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -56,11 +56,7 @@ (defun times-file-for-class (class) (merge-pathnames (format nil "times-~(~A~)" (symbol-name (class-name (class-of class)))) - (make-pathname - :directory - (pathname-directory - (or *load-truename* - *default-pathname-defaults*))))) + *times-file-root*)) (defmethod araneida:handle-request-response :around ((handler lisppaste-basic-handler) method request) (with-open-file (*trace-output* (times-file-for-class handler)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/variable.lisp
by Brian Mastenbrook 06 Jul '04

06 Jul '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: variable.lisp Log Message: Bring it up to date with the running lisppaste, then edit out what I don't need Date: Tue Jul 6 09:57:56 2004 Author: bmastenbrook Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.24 lisppaste2/variable.lisp:1.25 --- lisppaste2/variable.lisp:1.24 Thu Jun 24 12:52:25 2004 +++ lisppaste2/variable.lisp Tue Jul 6 09:57:56 2004 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.24 2004/06/24 19:52:25 bmastenbrook Exp $ +;;;; $Id: variable.lisp,v 1.25 2004/07/06 16:57:56 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -23,12 +23,12 @@ (in-package :lisppaste) -(defparameter *internal-http-port* 8000 +(defparameter *internal-http-port* 8081 "Port lisppaste's araneida will listen on for requests from Apache.") -(defparameter *external-http-port* 8000 +(defparameter *external-http-port* 80 "Port lisppaste's araneida will listen on for requests from remote clients.") -(defparameter *paste-site-name* "localhost" +(defparameter *paste-site-name* "paste.lisp.org" "Website we are running on (used for creating links).") (defparameter *paste-external-url* @@ -37,10 +37,15 @@ :host *paste-site-name* ;;; comment out this next line when running ;;; behind a proxying apache - :port *external-http-port* - ) "/paste/")) + #| :port *external-http-port* |# + ) "/")) -(defvar *meme-links* nil) ; whether to link to meme IRC logs, probably +(defparameter *old-url* (araneida:merge-url + (araneida:make-url :scheme "http" + :host "www.common-lisp.net") + "/paste/")) + +(defvar *meme-links* t) ; whether to link to meme IRC logs, probably ; only useful for freenode's lisppaste (defvar *paste-maximum-size* 51200) ; in bytes @@ -53,12 +58,26 @@ ; freenode's lisppaste (defparameter *ban-log-file* - "ban-log") ; where logs of attempts by banned users to paste go + (merge-pathnames "ban-log" + (make-pathname + :directory + (pathname-directory + (or *load-truename* + *default-pathname-defaults*))))) + ; where logs of attempts by + ; banned users to paste go (defparameter *event-log-file* - "event-log") ; where normal events are logged + (merge-pathnames "event-log" + (make-pathname + :directory + (pathname-directory + (or *load-truename* + *default-pathname-defaults*))))) + ; where normal events are + ; logged -(defparameter *no-channel-pastes* nil) ; whether to allow pastes that +(defparameter *no-channel-pastes* t) ; whether to allow pastes that ; don't get announced on a ; channel @@ -93,22 +112,20 @@ (araneida:merge-url *paste-external-url* "lisppaste.css")) (defvar *paste-listener* - (let ((fwd-url (araneida:copy-url *paste-external-url*))) + (let ((fwd-url (araneida:copy-url *paste-external-url*)) + (fwd-old-url (araneida:copy-url *old-url*))) (setf (araneida:url-port fwd-url) *internal-http-port*) - (make-instance 'araneida:serve-event-reverse-proxy-listener + (setf (araneida:url-port fwd-old-url) *internal-http-port*) + (make-instance #+sbcl 'araneida:serve-event-reverse-proxy-listener + #-sbcl 'araneida:threaded-reverse-proxy-listener :translations `((,(araneida:urlstring *paste-external-url*) - ,(araneida:urlstring fwd-url))) + ,(araneida:urlstring fwd-url)) + (,(araneida:urlstring *old-url*) + ,(araneida:urlstring fwd-old-url))) :address #(0 0 0 0) :port (araneida:url-port fwd-url)))) -(defvar *paste-listener* - (make-instance #+sbcl #+sb-thread 'threaded-http-listener - #+sbcl #-sb-thread 'araneida:serve-event-http-listener - #-sbcl 'threaded-http-listener - :address #(127 0 0 1) - :port *internal-http-port*)) - (defvar *default-nickname* "devpaste") (defvar *default-irc-server* "irc.freenode.net") (defvar *default-irc-server-port* 6667) @@ -117,8 +134,21 @@ (defvar *pastes* nil) (defvar *paste-counter* 0) (defvar *connection* nil) -(defvar *channels* nil) +(defvar *channels* '("None")) -(defvar *paste-file* "pastes.lisp-expr") +(defvar *paste-file* + (merge-pathnames "pastes.lisp-expr" + (make-pathname + :directory + (pathname-directory + (or *load-truename* + *default-pathname-defaults*))))) + +(defparameter *times-file-root* + (make-pathname + :directory + (pathname-directory + (or *load-truename* + *default-pathname-defaults*)))) (defvar *boot-time* 0)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/package.lisp
by Brian Mastenbrook 06 Jul '04

06 Jul '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: package.lisp Log Message: MORE EXPORTS Date: Tue Jul 6 09:34:24 2004 Author: bmastenbrook Index: lisppaste2/package.lisp diff -u lisppaste2/package.lisp:1.7 lisppaste2/package.lisp:1.8 --- lisppaste2/package.lisp:1.7 Tue Jun 8 08:23:04 2004 +++ lisppaste2/package.lisp Tue Jul 6 09:34:24 2004 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.7 2004/06/08 15:23:04 bmastenbrook Exp $ +;;;; $Id: package.lisp,v 1.8 2004/07/06 16:34:24 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -9,6 +9,7 @@ (defpackage :lisppaste (:use :cl #+sbcl :sb-bsd-sockets :html-encode) (:export :start-lisppaste :join-new-channel :shut-up :un-shut-up :say-help - :kill-paste :kill-paste-annotations :kill-paste-annotation))) + :kill-paste :kill-paste-annotations :kill-paste-annotation + :display-paste-url :find-paste)))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/colorize.lisp
by Brian Mastenbrook 06 Jul '04

06 Jul '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: colorize.lisp Log Message: use *trace-output* for logging Date: Tue Jul 6 09:34:17 2004 Author: bmastenbrook Index: lisppaste2/colorize.lisp diff -u lisppaste2/colorize.lisp:1.3 lisppaste2/colorize.lisp:1.4 --- lisppaste2/colorize.lisp:1.3 Fri Jun 11 07:34:34 2004 +++ lisppaste2/colorize.lisp Tue Jul 6 09:34:17 2004 @@ -228,7 +228,7 @@ (if (> current-position (length string)) (return-from scan-string (progn - (format t "Scan was called ~S times.~%" + (format *trace-output* "Scan was called ~S times.~%" *scan-calls*) (finish-current (length string) nil (constantly nil)) result))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Brian Mastenbrook 06 Jul '04

06 Jul '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: web-server.lisp Log Message: Bringing CVS up to date, step 1 of 2354235235 Date: Tue Jul 6 09:33:46 2004 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.59 lisppaste2/web-server.lisp:1.60 --- lisppaste2/web-server.lisp:1.59 Thu Jun 24 12:47:39 2004 +++ lisppaste2/web-server.lisp Tue Jul 6 09:33:46 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.59 2004/06/24 19:47:39 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.60 2004/07/06 16:33:46 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -17,29 +17,65 @@ (channel :initarg :channel :initform "" :accessor paste-channel) (colorization-mode :initarg :colorization-mode :initform "" :accessor paste-colorization-mode))) +(defun paste-display-url (paste) + (araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number paste))))) + +(defun find-paste (number) + (find number *pastes* :key #'paste-number)) + (defmacro make-paste (&rest arguments) `(progn (funcall 'make-instance 'paste ,@arguments))) -(defclass main-handler (araneida:handler) ()) +(defclass lisppaste-basic-handler (araneida:handler) ()) + +(defclass main-handler (lisppaste-basic-handler) ()) + +(defclass css-handler (lisppaste-basic-handler) ()) -(defclass css-handler (araneida:handler) ()) +(defclass new-paste-handler (lisppaste-basic-handler) ()) -(defclass new-paste-handler (araneida:handler) ()) +(defclass list-paste-handler (lisppaste-basic-handler) ()) -(defclass list-paste-handler (araneida:handler) ()) +(defclass submit-paste-handler (lisppaste-basic-handler) ()) -(defclass submit-paste-handler (araneida:handler) ()) +(defclass display-paste-handler (lisppaste-basic-handler) ()) -(defclass display-paste-handler (araneida:handler) ()) +(defclass rss-handler (lisppaste-basic-handler) ()) -(defclass rss-handler (araneida:handler) ()) +(defclass rss-full-handler (lisppaste-basic-handler) ()) -(defclass rss-full-handler (araneida:handler) ()) +(defclass syndication-handler (lisppaste-basic-handler) ()) -(defclass syndication-handler (araneida:handler) ()) +(defclass stats-handler (lisppaste-basic-handler) ()) -(defclass stats-handler (araneida:handler) ()) +(defvar *referer-hash* (make-hash-table :test #'equalp)) + +(defvar *referer-example-hash* (make-hash-table :test #'equalp)) + +(defun times-file-for-class (class) + (merge-pathnames (format nil "times-~(~A~)" + (symbol-name (class-name (class-of class)))) + (make-pathname + :directory + (pathname-directory + (or *load-truename* + *default-pathname-defaults*))))) + +(defmethod araneida:handle-request-response :around ((handler lisppaste-basic-handler) method request) + (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 + (incf (gethash (araneida:url-host url) *referer-hash* 0)) + (setf (gethash (araneida:url-host url) *referer-example-hash*) url))))) + (call-next-method))))) (defmethod araneida:handle-request-response ((handler css-handler) method request) (let ((colorize:*css-background-class* "paste")) @@ -86,9 +122,6 @@ ,@forms ,@(bottom-links)))) -(defun paste-display-url (paste) - (araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number paste))))) - (defmethod araneida:handle-request-response ((handler main-handler) method request) (araneida:request-send-headers request :expires 0) (araneida:html-stream @@ -102,13 +135,19 @@ ((td :valign top :width "40%") ((div :class "simple-paste-list") (table - ,@(loop for i from 1 to 10 + ,@(loop for i from 1 to 10 for j in *pastes* collect `(tr ((td :valign center) ((a :href ,(paste-display-url j)) ,(encode-for-pre (paste-title j)))) ((td :valign bottom) " by " ,(encode-for-pre (paste-user j))) - ((td :valign bottom) ,(encode-for-pre (paste-channel j))))))) + ((td :valign bottom) ,(encode-for-pre (paste-channel j))))) + (tr + ((td :colspan 3) + (center + (b + ((a :href ,(araneida:urlstring *list-paste-url*)) + "More recent pastes..."))))))) (p) ((div :class "small-header") "About lisppaste") ((div :class "info-text") @@ -130,8 +169,12 @@ (p) "Lisppaste is graciously hosted by " (b ((a :href "http://www.common-lisp.net/") "common-lisp.net")) - " - a hosting service for projects written in Common Lisp -(like this one).")) + " - a hosting service for projects written in Common Lisp (like this one)." + (p) + "Please consider " + (b ((a :href "https://www.paypal.com/xclick/business=bmastenb%40indiana.edu&item_name…") "supporting Lisppaste development")) + " with your contributions. Thanks!" + )) ((td :valign top :align right) ((form :method post :action ,(araneida:urlstring *submit-paste-url*)) ,(generate-new-paste-form :width 60)))) @@ -216,7 +259,10 @@ (tr ((td :id "main-link") ((a :href ,(araneida:urlstring *paste-external-url*)) - "Main page")) + "Main page") + " | " + ((a :href "https://www.paypal.com/xclick/business=bmastenb%40indiana.edu&item_name…") + "Support Lisppaste")) ((td :id "other-links") ((a :href ,(araneida:urlstring *new-paste-url*)) "New paste") " | " @@ -239,9 +285,12 @@ (t (format nil "~A~A" (time-delta-primitive delta level) (if ago-p " ago" "")))))) (defun irc-log-link (utime channel) - (format nil "http://meme.b9.com/now.html?utime=~A&channel=~A" - utime - (string-left-trim "#" channel))) + (format nil "http://meme.b9.com/cview.html?utime=~A&channel=~A&start=~A&end=…" + (- utime 5) + (string-left-trim "#" channel) + #+nil (* 60 60) + (- utime (* 60 60)) + (+ utime (* 60 60)))) (defun first-<-mod (n &rest nums) (some #'(lambda (n2) @@ -319,6 +368,25 @@ ((span :class "small-header") "Uptime: ") ,(time-delta *boot-time* :ago-p nil :level 3) (p) + ((span :class "small-header") "Most common HTTP referrers:") + (p) + ((table :class "info-table") + ,@(mapcar #'(lambda (pair) + `(tr + ((th :valign top) + ,(car pair)) + ((td :valign top) + ,(cdr pair) + ,@(when (gethash (car pair) *referer-example-hash*) + `(" " ((a :href ,(araneida:urlstring (gethash (car pair) + *referer-example-hash*))) + "(Example)")))))) + (nreverse + (last + (sort + (loop for count being the hash-values of *referer-hash* using (hash-key host) + collect (cons host count)) #'< :key #'cdr) 10)))) + (p) ((span :class "small-header") "Most popular channels:") (p) ((table :border 0 :class "info-table") @@ -534,10 +602,7 @@ (if discriminate-channel (format nil " on channel ~A" discriminate-channel) "") (mapcar #'(lambda (paste) (format nil "<item><link>~A</link><pubDate>~A</pubDate><title>\"~A\" by ~A</title><description>~A</description></item>~C~C" - (concatenate 'string - (araneida:urlstring - (araneida:merge-url *display-paste-url* - (prin1-to-string (paste-number paste))))) + (paste-display-url paste) (date:universal-time-to-rfc-date (apply #'max (paste-universal-time paste) @@ -628,7 +693,8 @@ `("The paste will be announced on the selected channel on " ,(irc:server-name *connection*) ". ")) ,@(if annotate `("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) ".")) + (b + ((a :href ,(paste-display-url annotate)) ,(concatenate 'string (paste-title annotate) "."))) ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number annotate)))) ((input :type hidden :name "channel" :value ,(paste-channel annotate)))))) (p) @@ -703,11 +769,25 @@ ,@(unless (and *no-channel-pastes* (string-equal channel "none")) `(", and was also sent to " ,channel " at " ,(irc:server-name *connection*))) ".") - `((span :class "small-header") "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 ((span :class "controls") - ((input :type submit :value "Annotate this paste"))))) + (table + (tr + (td + ((div :class "controls") + ((span :class "small-header") "Don't make more pastes; annotate this one!") + (br) + ((input :type submit :value "Annotate this paste"))))))) + `(p) + `(table + (tr + (td + ((div :class "info-text") + ((span :class "small-header") "Donations accepted") + (br) + "If you appreciate Lisppaste, please consider " + (b ((a :href "https://www.paypal.com/xclick/business=bmastenb%40indiana.edu&item_name…") "making a donation")) + " to support further development of the service. Thanks!")))) )))))))) (defun ends-with (str end)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/variable.lisp
by Brian Mastenbrook 24 Jun '04

24 Jun '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/test/lisppaste2 Modified Files: variable.lisp Log Message: The variable part of CSS, I think Date: Thu Jun 24 12:52:25 2004 Author: bmastenbrook Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.23 lisppaste2/variable.lisp:1.24 --- lisppaste2/variable.lisp:1.23 Thu Jun 17 06:42:32 2004 +++ lisppaste2/variable.lisp Thu Jun 24 12:52:25 2004 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.23 2004/06/17 13:42:32 bmastenbrook Exp $ +;;;; $Id: variable.lisp,v 1.24 2004/06/24 19:52:25 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -31,12 +31,6 @@ (defparameter *paste-site-name* "localhost" "Website we are running on (used for creating links).") -(defparameter *paste-url* - (araneida:merge-url - (araneida:make-url :scheme "http" - :host *paste-site-name* - :port *internal-http-port*) "/paste/")) - (defparameter *paste-external-url* (araneida:merge-url (araneida:make-url :scheme "http" @@ -95,6 +89,9 @@ (defparameter *stats-url* (araneida:merge-url *paste-external-url* "stats")) +(defparameter *css-url* + (araneida:merge-url *paste-external-url* "lisppaste.css")) + (defvar *paste-listener* (let ((fwd-url (araneida:copy-url *paste-external-url*))) (setf (araneida:url-port fwd-url) *internal-http-port*) @@ -110,7 +107,7 @@ #+sbcl #-sb-thread 'araneida:serve-event-http-listener #-sbcl 'threaded-http-listener :address #(127 0 0 1) - :port (araneida:url-port *paste-url*))) + :port *internal-http-port*)) (defvar *default-nickname* "devpaste") (defvar *default-irc-server* "irc.freenode.net")

1 0

[Lisppaste-cvs] CVS update: lisppaste2/encode-for-pre.lisp
by Brian Mastenbrook 24 Jun '04

24 Jun '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: encode-for-pre.lisp Log Message: more beginning-of-line damage Date: Thu Jun 24 12:48:04 2004 Author: bmastenbrook Index: lisppaste2/encode-for-pre.lisp diff -u lisppaste2/encode-for-pre.lisp:1.17 lisppaste2/encode-for-pre.lisp:1.18 --- lisppaste2/encode-for-pre.lisp:1.17 Tue Jun 8 08:20:40 2004 +++ lisppaste2/encode-for-pre.lisp Thu Jun 24 12:48:04 2004 @@ -1,4 +1,4 @@ -;;;; $Id: encode-for-pre.lisp,v 1.17 2004/06/08 15:20:40 bmastenbrook Exp $ +;;;; $Id: encode-for-pre.lisp,v 1.18 2004/06/24 19:48:04 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -10,13 +10,16 @@ (defun encode-for-tt (string &key with-line-numbers first-char-nbsp) (let ((pos 0) (end (length string)) - (char nil)) + (char nil) (last-was-newline nil)) (flet ((next-char () - (setf char (when (> end pos) - (prog1 - (schar string pos) - (incf pos)))))) - (with-output-to-string (out) + (prog1 + (setf char (when (> end pos) + (prog1 + (schar string pos) + (incf pos)))) + (when char (setf last-was-newline (eql char #\newline)))))) + (values + (with-output-to-string (out) (block nil (tagbody (unless first-char-nbsp @@ -32,9 +35,9 @@ ((nil) (return)) ((#\Newline) (write-string "<br>" out) - (if with-line-numbers - (write-string (funcall with-line-numbers) out)) - (go escape-spaces)) + (when with-line-numbers + (write-string (funcall with-line-numbers) out)) + (go escape-spaces)) ((#\&) (write-string "&" out)) ((#\<) @@ -50,7 +53,8 @@ (t (write-char char out))) (next-char) - (go process-char))))))) + (go process-char)))) + last-was-newline)))) (defun encode-for-pre (string)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp lisppaste2/coloring-css.lisp
by Brian Mastenbrook 24 Jun '04

24 Jun '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: web-server.lisp coloring-css.lisp Log Message: super-neato CSS, part 1 Date: Thu Jun 24 12:47:39 2004 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.58 lisppaste2/web-server.lisp:1.59 --- lisppaste2/web-server.lisp:1.58 Thu Jun 24 08:02:58 2004 +++ lisppaste2/web-server.lisp Thu Jun 24 12:47:39 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.58 2004/06/24 15:02:58 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.59 2004/06/24 19:47:39 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -23,6 +23,8 @@ (defclass main-handler (araneida:handler) ()) +(defclass css-handler (araneida:handler) ()) + (defclass new-paste-handler (araneida:handler) ()) (defclass list-paste-handler (araneida:handler) ()) @@ -39,19 +41,50 @@ (defclass stats-handler (araneida:handler) ()) -(defun lisppaste-wrap-page (title &rest forms) +(defmethod araneida:handle-request-response ((handler css-handler) method request) (let ((colorize:*css-background-class* "paste")) - `(html - (head (title ,title) - ((style :type "text/css") - ,(format nil "~A~%~A~%" - (colorize:make-background-css "#F4F4F4") - colorize:*coloring-css*)) - ,(rss-link-header)) - (body - (h2 ,title) - ,@forms - ,@(bottom-links))))) + (araneida:request-send-headers request :expires 0 :content-type "text/css") + (araneida:html-stream + (araneida:request-stream request) + (format nil "a { margin:1px; border-collapse: collapse; } +a:link { color:#335570; text-decoration: none; background-color: transparent;} +a:visited { color:#705533; text-decoration: none; background-color: transparent;} +a:hover { color:#000000; text-decoration: none; background-color: #BBCCEE; border: 1px solid #335577; margin: 0px;} +a:active { color:#000000; text-decoration: none; background-color: #CCBBFF; border: 1px solid #335577; margin: 0px;} +.simple-paste-list { background-color : #E9FFE9 ; border: 2px solid #9D9; padding : 4px; font-size: small; } +.simple-paste-list td { border-bottom: 1px dotted #9D9; font-size: small; } +table.detailed-paste-list { border-collapse: collapse; border : 1px solid #AAA ; } +table.detailed-paste-list td { border : 1px dotted #AAA; } +table.info-table { border-collapse: collapse; border : 1px solid #AAA ; background-color: #F9E9F9; empty-cells: hide; } +table.info-table td { border : 1px dotted #AAA; background-color: transparent; padding-left: 2em; padding-right: 2em; } +table.info-table th { border : 1px dotted #AAA; background-color: transparent; text-align: left; padding-right: 1em; } +.new-paste-form { background-color : #FFE9E9 ; border: 2px solid #D99; padding : 4px; } +.paste-header { background-color : #E9F9F9 ; border: 2px solid #9DD; padding : 4px; margin-bottom : 4px; } +.info-text { background-color : #E9F9F9 ; border: 2px solid #9DD; padding : 4px; margin-top : 4px; text-align: justify; } +.controls { background-color : #E9E9FF ; border: 2px solid #99D; padding : 4px; } +.small-header { font-weight: bold; font-size: large; } +.top-header { text-align : center; font-style: italic; font-weight: bold; font-size: x-large; } +.big-warning { text-align : center; font-weight: bold; font-size: x-large; } +.paste-area { background-color : #F4F4F4 ; border : 2px solid #AAA ; } +.bottom-links { background-color : #F9F9E9; border: 2px solid #DD9; padding : 4px; margin-bottom : 4px;} +#main-link { text-align : left; font-weight: bold; } +#other-links { text-align : right; } +hr { border: 1px solid #999; } +~A~&~A~&" + (colorize:make-background-css "#F4F4F4") + colorize:*coloring-css*)))) + +(defun lisppaste-wrap-page (title &rest forms) + `(html + (head (title ,title) + ((link :type "text/css" :rel "stylesheet" :href ,(araneida:url-path *css-url*))) + ,(rss-link-header)) + (body + ((div :class "top-header") + ,title) + (p) + ,@forms + ,@(bottom-links)))) (defun paste-display-url (paste) (araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number paste))))) @@ -61,20 +94,49 @@ (araneida:html-stream (araneida:request-stream request) (lisppaste-wrap-page - "Lisppaste" + *paste-site-name* `((table :width "100%" :border 0 :cellpadding 2) - (tr (td (b "Recent pastes")) - (td (center (b "Make a new paste")))) + (tr (td ((div :class "small-header") "Recent pastes")) + ((td :align right) ((div :class "small-header") "Make a new paste"))) (tr - ((td :valign top) - ,@(loop for i from 1 to 10 - for j in *pastes* - appending `( - ((a :href ,(paste-display-url j)) - ,(encode-for-pre (paste-title j))) - " by " ,(encode-for-pre (paste-user j)) (br)))) - ((td :valign top) - ,(generate-new-paste-form :width 40))))))) + ((td :valign top :width "40%") + ((div :class "simple-paste-list") + (table + ,@(loop for i from 1 to 10 + for j in *pastes* + collect `(tr + ((td :valign center) ((a :href ,(paste-display-url j)) + ,(encode-for-pre (paste-title j)))) + ((td :valign bottom) " by " ,(encode-for-pre (paste-user j))) + ((td :valign bottom) ,(encode-for-pre (paste-channel j))))))) + (p) + ((div :class "small-header") "About lisppaste") + ((div :class "info-text") + "Many times when working via IRC, people want to share a +snippet of code with somebody else. However, just pasting the code +into IRC creates a flood of text which is hard to read and scrolls by +as discussion progresses." + (p) + "Thus, the pastebot was invented, which has a web form where +users can paste code, and the URL of the paste is announced on the +desired channel. Lisppaste is an advanced pastebot running on the IRC +server " + ,(encode-for-pre (irc:server-name *connection*)) + " which has many unique features." + ,@(if *no-channel-pastes* + '((p) " It also allows pastes which are not announced on any channel, which +is useful for sections of code which need to be sent to a mailing list +or are discussed in ways other than IRC.")) + (p) + "Lisppaste is graciously hosted by " + (b ((a :href "http://www.common-lisp.net/") "common-lisp.net")) + " - a hosting service for projects written in Common Lisp +(like this one).")) + ((td :valign top :align right) + ((form :method post :action ,(araneida:urlstring *submit-paste-url*)) + ,(generate-new-paste-form :width 60)))) + + )))) (defmethod araneida:handle-request-response :around ((handler submit-paste-handler) method request) @@ -137,29 +199,36 @@ (lisppaste-wrap-page "Select a channel" `((form :method post :action ,(araneida:urlstring *new-paste-url*)) - ((input :type "hidden" :name "annotate" :value ,annotate-string)) - "Please select a channel to lisppaste to: " - ((select :name "channel") - ((option :value "")) - ,@(mapcar #'(lambda (e) - `((option :value ,e) - ,(encode-for-pre e))) *channels*)) - ((input :type submit :value "Submit"))))))))) - + ((div :class "controls") + ((input :type "hidden" :name "annotate" :value ,annotate-string)) + "Please select a channel to lisppaste to: " + ((select :name "channel") + ((option :value "")) + ,@(mapcar #'(lambda (e) + `((option :value ,e) + ,(encode-for-pre e))) *channels*)) + ((input :type submit :value "Submit")))))))))) + (defun bottom-links () - `((hr) - ((a :href ,(araneida:urlstring *new-paste-url*)) "New paste") - " | " - ((a :href ,(araneida:urlstring *list-paste-url*)) "List all pastes") - " | " - ((a :href ,(araneida:urlstring *syndication-url*)) "Syndication") - " | " - ((a :href "http://common-lisp.net/project/lisppaste/xml-rpc.html") "XML-RPC") - " | " - ((a :href ,(araneida:urlstring *stats-url*)) "Stats") - " | " - ((a :href "http://common-lisp.net/project/lisppaste") "lisppaste home page") - (br) + `((p) + ((div :class "bottom-links") + ((table :width "100%") + (tr + ((td :id "main-link") + ((a :href ,(araneida:urlstring *paste-external-url*)) + "Main page")) + ((td :id "other-links") + ((a :href ,(araneida:urlstring *new-paste-url*)) "New paste") + " | " + ((a :href ,(araneida:urlstring *list-paste-url*)) "List all pastes") + " | " + ((a :href ,(araneida:urlstring *syndication-url*)) "Syndication") + " | " + ((a :href "http://common-lisp.net/project/lisppaste/xml-rpc.html") "XML-RPC") + " | " + ((a :href ,(araneida:urlstring *stats-url*)) "Stats") + " | " + ((a :href "http://common-lisp.net/project/lisppaste") "Project home"))))) (i "Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively."))) (defun time-delta (time &key (level 2) (ago-p t) (origin (get-universal-time))) @@ -219,35 +288,24 @@ "Lisppaste can be syndicated in a variety of RSS formats for use with your favorite RSS reader." `(p) - `(table + `((table :class "info-table") (tr ((th :align left) "All channels") - ((td :width 30)) (td ((a :href ,(araneida:urlstring *rss-url*)) "Basic")) - ((td :width 10)) (td ((a :href ,(araneida:urlstring *rss-full-url*)) "Full"))) - ,@(if *no-channel-pastes* - `((tr - ((th :align left) "None") - ((td :width 30)) - (td ((a :href ,(concatenate 'string - (araneida:urlstring *rss-url*) - "?none")) "Basic")) - ((td :width 10)) - (td ((a :href ,(concatenate 'string - (araneida:urlstring *rss-full-url*) - "?none")) "Full"))))) ,@(mapcar #'(lambda (channel) + (let ((append (if (and *no-channel-pastes* + (string-equal channel "None")) + "?none" + (substitute #\? #\# channel)))) `(tr ((th :align left) ,channel) - ((td :width 30)) (td ((a :href ,(concatenate 'string (araneida:urlstring *rss-url*) - (substitute #\? #\# channel))) "Basic")) - ((td :width 10)) + append)) "Basic")) (td ((a :href ,(concatenate 'string (araneida:urlstring *rss-full-url*) - (substitute #\? #\# channel))) "Full")))) + append)) "Full"))))) *channels*))))) (defmethod araneida:handle-request-response ((handler stats-handler) method request) @@ -258,18 +316,16 @@ (lisppaste-wrap-page "Statistics" `(div - (b "Uptime: ") + ((span :class "small-header") "Uptime: ") ,(time-delta *boot-time* :ago-p nil :level 3) (p) - (b "Most popular channels:") - (br) - ((table :border 0) + ((span :class "small-header") "Most popular channels:") + (p) + ((table :border 0 :class "info-table") ,@(mapcar #'(lambda (pair) `(tr - ((td :valign top) + ((th :valign top) ,(car pair)) - ((td) - " ") ((td :valign top) ,(cdr pair)))) (sort @@ -279,14 +335,13 @@ :test #'string=))) #'> :key #'cdr))) (p) - (b "Average rates of pasting:") (br) - ((table :border 0) + ((span :class "small-header") "Average rates of pasting:") (p) + ((table :border 0 :class "info-table") ,@(mapcar #'(lambda (pair) `(tr #+(or) (td ,(length (second pair))) - ((td :valign top) + ((th :valign top) ,(first pair)) - (td " ") ((td :valign top) ,(time-delta 0 :origin @@ -401,7 +456,7 @@ discriminate-channel))))))) `(center ((form :method post :action ,(araneida:urlstring *list-paste-url*)) - (table + ((table :class "controls") (tr ((td :align left) "View only: ") ((td :valign top :align center) ((select :name "channel") @@ -439,10 +494,11 @@ ,@page-links)) ))) `(p) - `((table :width "100%" :cellpadding 2) + `((table :width "100%" :cellpadding 2 :class "detailed-paste-list") (tr (td) (td "By") (td "Where") (td "When") (td "Titled") (td "Ann.")) ,@(mapcar #'(lambda (paste) - `(tr ((td :nowrap "nowrap") ((a :href ,(paste-display-url paste)) + `(tr + ((td :nowrap "nowrap") ((a :href ,(paste-display-url paste)) ,(concatenate 'string "#" (prin1-to-string (paste-number paste))))) ((td :nowrap "nowrap") ,(encode-for-pre (max-length (paste-user paste) 12))) ((td :nowrap "nowrap") ,(encode-for-pre (paste-channel paste))) @@ -454,8 +510,9 @@ for j in discriminated-pastes if (>= i (* page *pastes-per-page*)) collect j))) + `(p) `(center - "Page: " ,@page-links) + ((table :class "controls") (tr (td "Page: " ,@page-links)))) )))))) (defun handle-rss-request (request &key full) @@ -515,41 +572,43 @@ (handle-rss-request request :full t)) (defun generate-new-paste-form (&key annotate (default-channel "None") (default-user "") (default-title "") (default-contents "") (width 80)) - `(table - ,@(if (not annotate) - `((tr - ((th :align left) "Select a channel:") - (td ((select :name "channel") - ((option :value "")) - ,@(mapcar #'(lambda (e) - `((option :value ,e ,@(if (string-equal e default-channel) - '(:selected "SELECTED"))) - ,(encode-for-pre e))) *channels*)))))) - (tr - ((th :align left) "Enter your username:") - (td ((input :type text :name "username" - :value ,(encode-for-pre default-user))))) - (tr - ((th :align left) "Enter a title:") - (td ((input :type text :name "title" - :value ,(encode-for-pre default-title))))) - ,@(if (not annotate) - `((tr - ((th :align left) (i "(Optional) Colorize as: ")) - (td ((select :name "colorize") - ((option :value "" :selected "SELECTED") "Default for this channel") - ((option :value "None") "None") - ,@(mapcar #'(lambda (pair) - `((option :value ,(cdr pair)) - ,(cdr pair))) - (colorize:coloring-types))))))) - (tr - ((th :align left :valign top) "Enter your paste:") - (td ((textarea :rows 24 :cols ,width :name "text") - ,(encode-for-pre default-contents)))) - (tr - ((th :align left) "Submit your paste:") - ((td) ((input :type submit :value "Submit paste")) " " ((input :type reset :value "Clear paste")))))) + `((table :class "new-paste-form") + ,@(if (not annotate) + `((tr + ((th :align left :width "0%" :nowrap "nowrap") "Select a channel:") + (td ((select :name "channel") + ((option :value "")) + ,@(mapcar #'(lambda (e) + `((option :value ,e ,@(if (string-equal e default-channel) + '(:selected "SELECTED"))) + ,(encode-for-pre e))) *channels*)))))) + (tr + ((th :align left :width "0%" :nowrap "nowrap") "Enter your username:") + (td ((input :type text :name "username" + :value ,(encode-for-pre default-user))))) + (tr + ((th :align left :width "0%" :nowrap "nowrap") "Enter a title:") + (td ((input :type text :name "title" + :value ,(encode-for-pre default-title))))) + ,@(if (not annotate) + `((tr + ((th :align left :width "0%" :nowrap "nowrap") (i "(Optional) Colorize as: ")) + (td ((select :name "colorize") + ((option :value "" :selected "SELECTED") "Default for this channel") + ((option :value "None") "None") + ,@(mapcar #'(lambda (pair) + `((option :value ,(cdr pair)) + ,(cdr pair))) + (colorize:coloring-types))))))) + (tr + ((th :align left :valign top :width "0%" :nowrap "nowrap") "Enter your paste:") + ((td #|:width "100%"|#))) + (tr + ((td :colspan 2) ((textarea :rows 24 :cols ,width :name "text") + ,(encode-for-pre default-contents)))) + (tr + ((th :align left :width "0%" :nowrap "nowrap") "Submit your paste:") + ((td) ((input :type submit :value "Submit paste")) " " ((input :type reset :value "Clear paste")))))) (defun new-paste-form (request &key (message "") (annotate nil) (default-channel "") (default-user "") (default-title "") (default-contents "")) (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") @@ -557,19 +616,22 @@ (araneida:request-stream request) (lisppaste-wrap-page (if annotate "Enter your annotation" "Enter your paste") - `((font :color red) (h2 ,message)) + (if (length message) + `((div :class "big-warning") ,message) + "") `((form :method post :action ,(araneida:urlstring *submit-paste-url*)) - (p "Enter a username, title, and paste contents into the fields below." - ,@(unless (and annotate - *no-channel-pastes* - (string-equal (paste-channel annotate) "None")) - `("The 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 "channel" :value ,(paste-channel annotate))))) - (hr) + ((div :class "info-text") + "Enter a username, title, and paste contents into the fields below. " + ,@(unless (and annotate + *no-channel-pastes* + (string-equal (paste-channel annotate) "None")) + `("The paste will be announced on the selected channel on " ,(irc:server-name *connection*) ". ")) + ,@(if annotate + `("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 "channel" :value ,(paste-channel annotate)))))) + (p) ,(generate-new-paste-form :annotate annotate :default-channel default-channel :default-user default-user :default-title default-title :default-contents default-contents))))) (defmethod araneida:handle-request-response ((handler submit-paste-handler) method request) @@ -637,14 +699,15 @@ (araneida:request-stream request) (lisppaste-wrap-page (format nil "Paste number ~A pasted!" paste-number) - `(p ,(if annotate "Your annotation should be available at " "Your paste should be available at ") ((a :href ,url) ,url) + `(p ,(if annotate "Your annotation should be available at " "Your paste should be available at ") (b ((a :href ,url) ,url)) ,@(unless (and *no-channel-pastes* (string-equal channel "none")) - `(", and was also sent to " ,channel " @ " ,(irc:server-name *connection*))) ".") - `(h3 "Don't paste more junk; annotate!") + `(", and was also sent to " ,channel " at " ,(irc:server-name *connection*))) ".") + `((span :class "small-header") "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")))) + (center ((span :class "controls") + ((input :type submit :value "Annotate this paste"))))) )))))))) (defun ends-with (str end) @@ -654,7 +717,7 @@ (string= (subseq str (- l1 l2) l1) end)))) (defun format-paste (paste this-url paste-number &optional annotation colorize-as line-numbers) - (let ((n 0) (next-first-char-nbsp nil)) + (let ((n 0) (next-first-char-nbsp t)) (labels ((line-number () (format nil "<span class=\"paste\">~A</span>" @@ -669,40 +732,41 @@ :first-char-nbsp next-first-char-nbsp) (prog1 encoded (setf next-first-char-nbsp last))))) - `((table :width "100%" :cellpadding 2) - (tr ((td :align "left" :width "0%" :nowrap "nowrap") - ,(if annotation - `((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: ") - ((td :align "left" :width "100%") ,(encode-for-pre (paste-user paste)))) - (tr (td) - ((td :align "left" :width "100%") ,(time-delta (paste-universal-time paste)))) - ,@(if (or (not annotation) *meme-links*) - `((tr (td) - ((td :align "left" :width "100%") - ,@(if (not annotation) - `((,(encode-for-pre (paste-channel paste))))) - ,@(if (and *meme-links* - (not (and *no-channel-pastes* - (string-equal (paste-channel paste) "None")))) - `(" | " ((a :href ,(irc-log-link (paste-universal-time paste) (paste-channel paste))) "Context in IRC logs"))))))) - (tr ((td :align "left" :valign "top" :nowrap "nowrap") "Paste contents:") - ,@(if this-url - `(((td :width "100%") ((a :href ,(concatenate 'string this-url "/raw")) "(raw source)"))))) - (tr (td (p))) - (tr ((td :bgcolor "#F4F4F4" :colspan 2 :width "100%") - (tt - ,@(if line-numbers - (list (line-number))) - ,(if colorize-as - (colorize:format-scan colorize-as - (mapcar #'(lambda (e) - (cons (car e) - (encode (cdr e)))) - (colorize:scan-string colorize-as (paste-contents paste)))) - (encode (paste-contents paste)))))))))) + `(div + ((table :class "paste-header") + (tr ((td :align "left" :width "0%" :nowrap "nowrap") + ,(if annotation + `((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: ") + ((td :align "left" :width "100%") ,(encode-for-pre (paste-user paste)))) + (tr (td) + ((td :align "left" :width "100%") ,(time-delta (paste-universal-time paste)))) + ,@(if (or (not annotation) *meme-links*) + `((tr (td) + ((td :align "left" :width "100%") + ,@(if (not annotation) + `((,(encode-for-pre (paste-channel paste))))) + ,@(if (and *meme-links* + (not (and *no-channel-pastes* + (string-equal (paste-channel paste) "None")))) + `(,@(and (not annotation) '(" | ")) ((a :href ,(irc-log-link (paste-universal-time paste) (paste-channel paste))) "Context in IRC logs"))))))) + (tr ((td :align "left" :valign "top" :nowrap "nowrap") "Paste contents:") + ,@(if this-url + `(((td :width "100%") ((a :href ,(concatenate 'string this-url "/raw")) "(raw source)")))))) + ((table :width "100%" :class "paste-area") + (tr ((td :bgcolor "#F4F4F4" :colspan 2 :width "100%") + (tt + ,@(if line-numbers + (list (line-number))) + ,(if colorize-as + (colorize:format-scan colorize-as + (mapcar #'(lambda (e) + (cons (car e) + (encode (cdr e)))) + (colorize:scan-string colorize-as (paste-contents paste)))) + (encode (paste-contents paste))))))))))) (defmethod araneida:handle-request-response ((handler display-paste-handler) method request) ; XXX request-unhandled-part will be exported in 0.81 @@ -749,7 +813,22 @@ (write-string (remove #\return (paste-contents paste) :test #'char=)(araneida:request-stream request))))) - (progn + (let ((annotate-html + `((table :class "controls") + (tr (td + ,@(if (paste-annotations paste) + `("Index of paste annotations: " + ,@(loop for ann in (reverse (paste-annotations paste)) + for test from (length (paste-annotations paste)) downto 1 + appending + `(((a :href ,(format nil "#~A" + (paste-number ann))) + ,(prin1-to-string (paste-number ann)))) + if (not (eql test 1)) + appending '(" | ")) + (p))) + ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number paste)))) + (center ((input :type submit :value "Annotate this paste")))))))) (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 @@ -757,57 +836,56 @@ (lisppaste-wrap-page (format nil "Paste number ~A" paste-number) `(div - ,@(if (paste-annotations paste) - `("Index of paste annotations: " - ,@(loop for ann in (reverse (paste-annotations paste)) - for test from (length (paste-annotations paste)) downto 1 - appending - `(((a :href ,(format nil "#~A" - (paste-number ann))) - ,(prin1-to-string (paste-number ann)))) - if (not (eql test 1)) - appending '(" | ")) - (p))) + ((form :method post :action ,(araneida:urlstring *new-paste-url*)) + (center + ,annotate-html)) + (p) ,(format-paste paste (araneida:urlstring (araneida:request-url request)) paste-number nil colorize-as linenumbers) ,@(if (paste-annotations paste) `((p) - "Annotations for this paste: " + ((span :class "small-header") "Annotations for this paste: ") ,@(reduce #'append (mapcar #'(lambda (a) - `((hr) + `((p) ,(format-paste a (format nil "~A,~A" (araneida:urlstring (araneida:request-url request)) (paste-number a)) (paste-number a) t colorize-as linenumbers))) (reverse (paste-annotations paste))))) - `((p) "This paste has no annotations.")) + `((p) ((span :class "small-header") "This paste has no annotations."))) (p) - ((form :method post :action ,(araneida:urlstring - (araneida:merge-url - *display-paste-url* - (araneida:request-unhandled-part request)))) - "Colorize as: " - ((select :name "colorize") - ((option :value "None") "None") - ,@(mapcar #'(lambda (pair) - `((option :value ,(cdr pair) - ,@(if (eq - (car pair) - colorize-as) - '(:selected "SELECTED"))) - ,(cdr pair))) - (colorize:coloring-types))) - (br) - ((input :type "checkbox" :name "linenumbers" :value "true" - ,@(if linenumbers '(:checked "checked")))) " Show Line Numbers" - (br) - ((input :type submit :value "Format"))) - (p) - ((form :method post :action ,(araneida:urlstring *new-paste-url*)) - ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number paste)))) - (center ((input :type submit :value "Annotate this paste")))) - ))))) + ((table :width "100%") + (tr + ((td :align "left") + ((form :method post :action ,(araneida:urlstring + (araneida:merge-url + *display-paste-url* + (araneida:request-unhandled-part request)))) + ((table :class "controls") + (tr + (td + "Colorize as: " + ((select :name "colorize") + ((option :value "None") "None") + ,@(mapcar #'(lambda (pair) + `((option :value ,(cdr pair) + ,@(if (eq + (car pair) + colorize-as) + '(:selected "SELECTED"))) + ,(cdr pair))) + (colorize:coloring-types))) + (br) + ((input :type "checkbox" :name "linenumbers" :value "true" + ,@(if linenumbers '(:checked "checked")))) + " Show Line Numbers" + (br) + (center ((input :type submit :value "Format")))))))) + ((td :align "right") + ((form :method post :action ,(araneida:urlstring *new-paste-url*)) + ,annotate-html)))) + ))))) (progn (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\">") @@ -861,3 +939,8 @@ (araneida:http-listener-handler *paste-listener*) (make-instance 'main-handler) (araneida:urlstring *paste-external-url*) t) + +(araneida:install-handler + (araneida:http-listener-handler *paste-listener*) + (make-instance 'css-handler) + (araneida:urlstring *css-url*) t) Index: lisppaste2/coloring-css.lisp diff -u lisppaste2/coloring-css.lisp:1.3 lisppaste2/coloring-css.lisp:1.4 --- lisppaste2/coloring-css.lisp:1.3 Thu Jun 17 05:46:59 2004 +++ lisppaste2/coloring-css.lisp Thu Jun 24 12:47:39 2004 @@ -3,28 +3,37 @@ (in-package :colorize) (defparameter *coloring-css* - ".symbol { color : #770055; background-color : inherit; } -a.symbol:link { color : #229955; background-color : inherit; text-decoration: none; } -a.symbol:active { color : #229955; background-color : inherit; text-decoration: none; } -a.symbol:visited { color : #229955; background-color : inherit; text-decoration: none; } -a.symbol:hover { color : #229955; background-color : inherit; text-decoration: none; } + ".symbol { color : #770055; background-color : transparent; border: 0px; margin: 0px;} +a.symbol:link { color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } +a.symbol:active { color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } +a.symbol:visited { color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } +a.symbol:hover { color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } .special { color : #FF5000; background-color : inherit; } .keyword { color : #770000; background-color : inherit; } .comment { color : #007777; background-color : inherit; } .string { color : #777777; background-color : inherit; } .character { color : #0055AA; background-color : inherit; } .syntaxerror { color : #FF0000; background-color : inherit; } -.paren1:hover { color : inherit; background-color : #CAFFFF; } +.paren1:hover { color : inherit; background-color : #BAFFFF; } .paren2:hover { color : inherit; background-color : #FFCACA; } -.paren3:hover { color : inherit; background-color : #FFFFCA; } +.paren3:hover { color : inherit; background-color : #FFFFBA; } .paren4:hover { color : inherit; background-color : #CACAFF; } .paren5:hover { color : inherit; background-color : #CAFFCA; } -.paren6:hover { color : inherit; background-color : #FFCAFF; } +.paren6:hover { color : inherit; background-color : #FFBAFF; } ") (defvar *css-background-class* "") -(defun make-background-css (color &key (class *css-background-class*)) - (format nil ".~A { background-color: ~A; color: WindowText; }~:*~:* -.~A:hover { background-color: ~A; color: WindowText; }~%" - class color)) +(defun for-css (thing) + (if (symbolp thing) (string-downcase (symbol-name thing)) + thing)) + +(defun make-background-css (color &key (class *css-background-class*) (extra nil)) + (format nil ".~A { background-color: ~A; color: WindowText; ~{~A; ~}}~:*~:*~:* +.~A:hover { background-color: ~A; color: WindowText; ~{~A; ~}}~%" + class color + (mapcar #'(lambda (extra) + (format nil "~A : ~{~A ~}" + (for-css (first extra)) + (mapcar #'for-css (cdr extra)))) + extra)))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/lisppaste.lisp
by Brian Mastenbrook 24 Jun '04

24 Jun '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: lisppaste.lisp Log Message: Small error in make-paste Date: Thu Jun 24 08:03:22 2004 Author: bmastenbrook Index: lisppaste2/lisppaste.lisp diff -u lisppaste2/lisppaste.lisp:1.21 lisppaste2/lisppaste.lisp:1.22 --- lisppaste2/lisppaste.lisp:1.21 Wed Jun 9 13:05:31 2004 +++ lisppaste2/lisppaste.lisp Thu Jun 24 08:03:22 2004 @@ -1,4 +1,4 @@ -;;;; $Id: lisppaste.lisp,v 1.21 2004/06/09 20:05:31 bmastenbrook Exp $ +;;;; $Id: lisppaste.lisp,v 1.22 2004/06/24 15:03:22 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -85,7 +85,7 @@ &key channel user title &allow-other-keys) (let ((paste-name (gensym))) `(let ((,paste-name (make-paste ,@keys))) - (if (not (string-equal channel "None")) + (if (not (string-equal ,channel "None")) (irc:privmsg *connection* ,channel (if ,annotate (format nil "~A annotated #~A with \"~A\" at ~A" ,user ,real-number ,title ,url) @@ -124,4 +124,4 @@ :if-does-not-exist :create) (write-string text *trace-output*) (write-string text s) - (finish-output s))) \ No newline at end of file + (finish-output s)))

1 0