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