[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp lisppaste2/coloring-css.lisp
Brian Mastenbrook
bmastenbrook at common-lisp.net
Thu Jun 24 19:47:40 UTC 2004
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)
- , at 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)
+ , at 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 @@
, at 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: " , at page-links)
+ ((table :class "controls") (tr (td "Page: " , at 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)))
More information about the Lisppaste-cvs
mailing list