June 2004 - lisppaste-cvs@common-lisp.net

[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 " " 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 "~A" @@ -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

[Lisppaste-cvs] CVS update: lisppaste2/web-server.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 Log Message: Bit-o-refactoring, "main page" Date: Thu Jun 24 08:02:58 2004 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.57 lisppaste2/web-server.lisp:1.58 --- lisppaste2/web-server.lisp:1.57 Thu Jun 17 05:46:59 2004 +++ lisppaste2/web-server.lisp Thu Jun 24 08:02:58 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.57 2004/06/17 12:46:59 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.58 2004/06/24 15:02:58 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -21,6 +21,8 @@ `(progn (funcall 'make-instance 'paste ,@arguments))) +(defclass main-handler (araneida:handler) ()) + (defclass new-paste-handler (araneida:handler) ()) (defclass list-paste-handler (araneida:handler) ()) @@ -37,6 +39,43 @@ (defclass stats-handler (araneida:handler) ()) +(defun lisppaste-wrap-page (title &rest forms) + (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))))) + +(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 + (araneida:request-stream request) + (lisppaste-wrap-page + "Lisppaste" + `((table :width "100%" :border 0 :cellpadding 2) + (tr (td (b "Recent pastes")) + (td (center (b "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))))))) + (defmethod araneida:handle-request-response :around ((handler submit-paste-handler) method request) (let ((forwarded-for (car (araneida:request-header request :x-forwarded-for)))) @@ -95,22 +134,17 @@ (t (araneida:request-send-headers request :expires 0) (araneida:html-stream (araneida:request-stream request) - `(html - (head - (title "Select a channel") - ,(rss-link-header)) - (body - (h2 "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"))) - ,@(bottom-links)))))))) + (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"))))))))) (defun bottom-links () `((hr) @@ -180,74 +214,70 @@ (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") (araneida:html-stream (araneida:request-stream request) - `(html - (head (title "Syndication options") - ,(rss-link-header)) - (body - (h2 "Syndication options") - "Lisppaste can be syndicated in a variety of RSS formats for use + (lisppaste-wrap-page + "Syndication options" + "Lisppaste can be syndicated in a variety of RSS formats for use with your favorite RSS reader." - (p) - (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) - `(tr - ((th :align left) ,channel) - ((td :width 30)) - (td ((a :href ,(concatenate 'string - (araneida:urlstring *rss-url*) - (substitute #\? #\# channel))) "Basic")) - ((td :width 10)) - (td ((a :href ,(concatenate 'string - (araneida:urlstring *rss-full-url*) - (substitute #\? #\# channel))) "Full")))) - *channels*)) - ,@(bottom-links))))) + `(p) + `(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) + `(tr + ((th :align left) ,channel) + ((td :width 30)) + (td ((a :href ,(concatenate 'string + (araneida:urlstring *rss-url*) + (substitute #\? #\# channel))) "Basic")) + ((td :width 10)) + (td ((a :href ,(concatenate 'string + (araneida:urlstring *rss-full-url*) + (substitute #\? #\# channel))) "Full")))) + *channels*))))) (defmethod araneida:handle-request-response ((handler stats-handler) method request) (araneida:request-send-headers request :expires 0) (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") (araneida:html-stream (araneida:request-stream request) - `(html - (head (title "Statistics") - ,(rss-link-header)) - (body - (h2 "Statistics") - (b "Uptime: ") ,(time-delta *boot-time* :ago-p nil :level 3) + (lisppaste-wrap-page + "Statistics" + `(div + (b "Uptime: ") + ,(time-delta *boot-time* :ago-p nil :level 3) (p) - (b "Most popular channels:") (br) + (b "Most popular channels:") + (br) ((table :border 0) ,@(mapcar #'(lambda (pair) - `(tr - ((td :valign top) - ,(car pair)) + `(tr + ((td :valign top) + ,(car pair)) ((td) " ") ((td :valign top) - ,(cdr pair)))) + ,(cdr pair)))) (sort - (loop for i in *channels* - collect (cons i (count i *pastes* - :key #'paste-channel - :test #'string=))) - #'> :key #'cdr))) + (loop for i in *channels* + collect (cons i (count i *pastes* + :key #'paste-channel + :test #'string=))) + #'> :key #'cdr))) (p) (b "Average rates of pasting:") (br) ((table :border 0) @@ -300,7 +330,7 @@ (- (paste-universal-time (first p)) (paste-universal-time (car (last p))))))) #'> :key #'(lambda (e) (length (second e))))))) - ,@(bottom-links))))) + )))) (defmethod araneida:handle-request-response ((handler list-paste-handler) method request) (araneida:request-send-headers request :expires 0) @@ -360,75 +390,73 @@ "> Older")))))) (araneida:html-stream (araneida:request-stream request) - `(html - (head (title "All pastes") - ,(rss-link-header)) - (body - (center (h2 ,(if discriminate-channel - (format nil "All pastes in channel ~A" discriminate-channel) - "All pastes in system"))) + (lisppaste-wrap-page + (if discriminate-channel + (format nil "All pastes in channel ~A" discriminate-channel) + "All pastes in system") + `(div ,@(if discriminate-channel (if (not (member discriminate-channel *channels* :test #'string-equal)) `(((h2) ((font :color "red") ,(format nil "Warning: no channel named ~A found!" - discriminate-channel)))))) - (center - ((form :method post :action ,(araneida:urlstring *list-paste-url*)) - (table - (tr ((td :align left) "View only: ") - ((td :valign top :align center) - ((select :name "channel") - ((option :value "allchannels") "All channels") - ,@(mapcar #'(lambda (e) - `((option :value ,e ,@(if (and discriminate-channel - (string-equal e discriminate-channel)) - '(:selected))) - ,(encode-for-pre e))) *channels*)) - ((input :type submit :value "Submit"))) - ) - (tr ((td :align left) - ,(if discriminate-channel "Syndicate this channel: " "Syndicate all channels: ")) - ((td :align center) - ((a :href ,(concatenate 'string - (araneida:urlstring *rss-url*) - (if discriminate-channel - (or (and *no-channel-pastes* - (string-equal discriminate-channel "none") - "?none") - (substitute #\? #\# discriminate-channel)) ""))) "Basic") - " | " - ((a :href ,(concatenate 'string - (araneida:urlstring *rss-full-url*) - (if discriminate-channel - (or (and *no-channel-pastes* - (string-equal discriminate-channel "none") - "?none") - (substitute #\? #\# discriminate-channel)) - ""))) "Full")) - ) - (tr ((td :align left) - "Page: ") - ((td :align center) - ,@page-links)) - ))) - (p) - ((table :width "100%" :cellpadding 2) - (tr (td) (td "By") (td "Where") (td "When") (td "Titled") (td "Ann.")) - ,@(mapcar #'(lambda (paste) - `(tr ((td :nowrap "nowrap") ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number 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))) - ((td :nowrap "nowrap") ,(time-delta (paste-universal-time paste) :level 1 :ago-p nil)) - ((td :width "100%" :bgcolor "#F6F6F6" :nowrap "nowrap") ,(encode-for-pre (max-length (paste-title paste) 50))) - ((td :nowrap "nowrap") ,(length (paste-annotations paste))))) - (loop for i from 0 - to (- (* (1+ page) *pastes-per-page*) 1) - for j in discriminated-pastes - if (>= i (* page *pastes-per-page*)) - collect j))) - (center - "Page: " ,@page-links) - ,@(bottom-links)))))))) + discriminate-channel))))))) + `(center + ((form :method post :action ,(araneida:urlstring *list-paste-url*)) + (table + (tr ((td :align left) "View only: ") + ((td :valign top :align center) + ((select :name "channel") + ((option :value "allchannels") "All channels") + ,@(mapcar #'(lambda (e) + `((option :value ,e ,@(if (and discriminate-channel + (string-equal e discriminate-channel)) + '(:selected))) + ,(encode-for-pre e))) *channels*)) + ((input :type submit :value "Submit"))) + ) + (tr ((td :align left) + ,(if discriminate-channel "Syndicate this channel: " "Syndicate all channels: ")) + ((td :align center) + ((a :href ,(concatenate 'string + (araneida:urlstring *rss-url*) + (if discriminate-channel + (or (and *no-channel-pastes* + (string-equal discriminate-channel "none") + "?none") + (substitute #\? #\# discriminate-channel)) ""))) "Basic") + " | " + ((a :href ,(concatenate 'string + (araneida:urlstring *rss-full-url*) + (if discriminate-channel + (or (and *no-channel-pastes* + (string-equal discriminate-channel "none") + "?none") + (substitute #\? #\# discriminate-channel)) + ""))) "Full")) + ) + (tr ((td :align left) + "Page: ") + ((td :align center) + ,@page-links)) + ))) + `(p) + `((table :width "100%" :cellpadding 2) + (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)) + ,(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))) + ((td :nowrap "nowrap") ,(time-delta (paste-universal-time paste) :level 1 :ago-p nil)) + ((td :width "100%" :bgcolor "#F6F6F6" :nowrap "nowrap") ,(encode-for-pre (max-length (paste-title paste) 50))) + ((td :nowrap "nowrap") ,(length (paste-annotations paste))))) + (loop for i from 0 + to (- (* (1+ page) *pastes-per-page*) 1) + for j in discriminated-pastes + if (>= i (* page *pastes-per-page*)) + collect j))) + `(center + "Page: " ,@page-links) + )))))) (defun handle-rss-request (request &key full) (araneida:request-send-headers request :expires 0 :content-type "application/rss+xml") @@ -486,32 +514,11 @@ (defmethod araneida:handle-request-response ((handler rss-full-handler) method request) (handle-rss-request request :full t)) -(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\">") - (araneida:html-stream - (araneida:request-stream request) - `(html - (head (title ,(if annotate "Annotate" "Paste")) - ,(rss-link-header)) - (body - (h2 ,(if annotate "Enter your annotation" "Enter your paste")) - ((font :color red) (h2 ,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) - (table +(defun generate-new-paste-form (&key annotate (default-channel "None") (default-user "") (default-title "") (default-contents "") (width 80)) + `(table ,@(if (not annotate) `((tr - (th "Select a channel:") + ((th :align left) "Select a channel:") (td ((select :name "channel") ((option :value "")) ,@(mapcar #'(lambda (e) @@ -519,16 +526,16 @@ '(:selected "SELECTED"))) ,(encode-for-pre e))) *channels*)))))) (tr - (th "Enter your username:") + ((th :align left) "Enter your username:") (td ((input :type text :name "username" :value ,(encode-for-pre default-user))))) (tr - (th "Enter a title:") + ((th :align left) "Enter a title:") (td ((input :type text :name "title" :value ,(encode-for-pre default-title))))) ,@(if (not annotate) `((tr - (th (i "(Optional) Colorize as: ")) + ((th :align left) (i "(Optional) Colorize as: ")) (td ((select :name "colorize") ((option :value "" :selected "SELECTED") "Default for this channel") ((option :value "None") "None") @@ -537,13 +544,33 @@ ,(cdr pair))) (colorize:coloring-types))))))) (tr - ((th :valign top) "Enter your paste:") - (td ((textarea :rows 24 :cols 80 :name "text") + ((th :align left :valign top) "Enter your paste:") + (td ((textarea :rows 24 :cols ,width :name "text") ,(encode-for-pre default-contents)))) (tr - ((th) "Submit your paste:") + ((th :align left) "Submit your paste:") ((td) ((input :type submit :value "Submit paste")) " " ((input :type reset :value "Clear paste")))))) - ,@(bottom-links))))) + +(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\">") + (araneida:html-stream + (araneida:request-stream request) + (lisppaste-wrap-page + (if annotate "Enter your annotation" "Enter your paste") + `((font :color red) (h2 ,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) + ,(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) (let* ((username (araneida:body-param "username" (araneida:request-body request))) @@ -608,20 +635,17 @@ (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") (araneida:html-stream (araneida:request-stream request) - `(html - (head (title "Paste number " ,paste-number) - ,(rss-link-header)) - (body - (h2 "Pasted!") - (p ,(if annotate "Your annotation should be available at " "Your paste should be available at ") ((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!") - ((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")))) - ,@(bottom-links)))))))))) + (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) + ,@(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!") + `((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")))) + )))))))) (defun ends-with (str end) (let ((l1 (length str)) @@ -630,17 +654,21 @@ (string= (subseq str (- l1 l2) l1) end)))) (defun format-paste (paste this-url paste-number &optional annotation colorize-as line-numbers) - (let ((n 0)) + (let ((n 0) (next-first-char-nbsp nil)) (labels ((line-number () (format nil "~A" (encode-for-tt (format nil "~4D: " (incf n)) :first-char-nbsp t))) (encode (str) - (encode-for-tt str - :with-line-numbers - (if line-numbers - #'line-number)))) + (multiple-value-bind (encoded last) + (encode-for-tt str + :with-line-numbers + (if line-numbers + #'line-number) + :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 @@ -701,9 +729,10 @@ (colorize:*css-background-class* "paste")) (and paste (log-event - (format nil "Serving paste number ~S to ~S.~%" + (format nil "Serving paste number ~S to ~S (referred by ~S).~%" (paste-number paste) - (car (araneida:request-header request :x-forwarded-for))))) + (car (araneida:request-header request :x-forwarded-for)) + (car (araneida:request-header request :referer))))) (if paste (if raw (let ((p (position #\, (araneida::request-unhandled-part request) :test #'char=))) @@ -725,16 +754,9 @@ (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") (araneida:html-stream (araneida:request-stream request) - `(html - (head - (title "Paste number " ,paste-number) - ((style :type "text/css") - ,(format nil "~A~%~A~%" - (colorize:make-background-css "#F4F4F4") - colorize:*coloring-css*)) - ,(rss-link-header)) - (body - + (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)) @@ -749,17 +771,17 @@ ,(format-paste paste (araneida:urlstring (araneida:request-url request)) paste-number nil colorize-as linenumbers) ,@(if (paste-annotations paste) - `((p) - "Annotations for this paste: " - ,@(reduce #'append - (mapcar #'(lambda (a) - `((hr) - ,(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) + "Annotations for this paste: " + ,@(reduce #'append + (mapcar #'(lambda (a) + `((hr) + ,(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) ((form :method post :action ,(araneida:urlstring (araneida:merge-url @@ -785,19 +807,15 @@ ((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")))) - ,@(bottom-links)))))) - (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\">") - (araneida:html-stream - (araneida:request-stream request) - `(html - (head - (title "Invalid paste number" ,paste-number) - ,(rss-link-header)) - (body - (h3 "No paste numbered " ,paste-number " could be found.") - ,@(bottom-links)))))))) + ))))) + (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\">") + (araneida:html-stream + (araneida:request-stream request) + (lisppaste-wrap-page + (format nil "Invalid paste number ~A!" paste-number) + )))))) (araneida:install-handler (araneida:http-listener-handler *paste-listener*) @@ -838,3 +856,8 @@ (araneida:http-listener-handler *paste-listener*) (make-instance 'stats-handler) (araneida:urlstring *stats-url*) nil) + +(araneida:install-handler + (araneida:http-listener-handler *paste-listener*) + (make-instance 'main-handler) + (araneida:urlstring *paste-external-url*) t)

1 0

[Lisppaste-cvs] CVS update: public_html/index.html
by Brian Mastenbrook 17 Jun '04

17 Jun '04

Update of /project/lisppaste/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv8105 Modified Files: index.html Log Message: release 2.3 Date: Thu Jun 17 07:15:35 2004 Author: bmastenbrook Index: public_html/index.html diff -u public_html/index.html:1.8 public_html/index.html:1.9 --- public_html/index.html:1.8 Mon Mar 8 22:48:14 2004 +++ public_html/index.html Thu Jun 17 07:15:35 2004 @@ -28,8 +28,13 @@ as that sounds. Lisppaste 2 can be downloaded from here: <a - href="ftp://common-lisp.net/pub/project/lisppaste/lisppaste2-latest.tar.gz">lisppaste2-latest.tar.gz</a>. The - latest version is 2.2, released March 9, 2004. + href="ftp://common-lisp.net/pub/project/lisppaste/lisppaste2.3.tar.gz">lisppaste2.3.tar.gz</a>. The + latest version is 2.3, released June 17, 2004. + + New in lisppaste 2.3 is a whole slew of improvements, including + pagination for the paste list page, colorization for many + languages, portability to other lisps (when run with CVS araneida) + and support for pastes without a channel announcement. New in lisppaste 2.2 is greater RSS flexibility, channel-specific URLs for new pastes and paste listing, much @@ -39,10 +44,11 @@ context at <a href="http://meme.b9.com/">meme.b9.com</a>. The code in CVS (<a href="/faq.shtml">checkout - instructions</a>) is also considered fairly usable. You'll also - need <a href="http://araneida.telent.net">araneida</a> and <a - href="http://www.sbcl.org"> SBCL</a>. If you do install it, read - the <a + instructions</a>) mirrors what is currently running on freenode + and should be fairly usable. You'll also need <a + href="http://www.cliki.net/araneida">araneida</a> and + href="http://www.cliki.net/cl-irc">CL-IRC</a>. If you do install + it, read the <a href="/cgi-bin/viewcvs.cgi/lisppaste2/README.lisp?rev=HEAD&cvsroot=lisppaste&content-type=text/vnd.viewcvs-markup">README.lisp</a> file which contains all the information you need to run a lisppaste on your own. @@ -64,7 +70,7 @@ <address><a href="http://www.cs.indiana.edu/~bmastenb/">Brian Mastenbrook</a></address>   -Last modified: Tue Mar 9 01:48:05 2004 EST +Last modified: Thu Jun 17 09:15:17 2004 CDT  </body> </html>

1 0

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

17 Jun '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv16551 Modified Files: variable.lisp Log Message: MORE DOCUMENTATION Date: Thu Jun 17 06:42:32 2004 Author: bmastenbrook Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.22 lisppaste2/variable.lisp:1.23 --- lisppaste2/variable.lisp:1.22 Thu Jun 17 06:26:12 2004 +++ lisppaste2/variable.lisp Thu Jun 17 06:42:32 2004 @@ -1,8 +1,26 @@ -;;;; $Id: variable.lisp,v 1.22 2004/06/17 13:26:12 bmastenbrook Exp $ +;;;; $Id: variable.lisp,v 1.23 2004/06/17 13:42:32 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. +;;; This is the main file to edit to customize lisppaste to your +;;; site. In particular, the main variables are at the top, which +;;; define how lisppaste knows which site it is running on, and how to +;;; generate links to itself. There are two ways to run lisppaste: +;;; naked, and behind a proxying apache. When running naked, you can +;;; leave much of this file as-is, and change *internal-http-port* and +;;; *external-http-port* to the port you want it to run on, and +;;; *paste-site-name* to the hostname it is running on. + +;;; When running behind a proxy, set *internal-http-port* to the port +;;; it will listen for requests from Apache, but set +;;; *external-http-port* to 80. Set *paste-site-name* to a hostname +;;; that lisppaste is running on, and comment out the line in +;;; *paste-external-url* as indicated. + +;;; There are a few other options below, but the defaults should work +;;; well. + (in-package :lisppaste) (defparameter *internal-http-port* 8000 @@ -23,25 +41,32 @@ (araneida:merge-url (araneida:make-url :scheme "http" :host *paste-site-name* + ;;; comment out this next line when running + ;;; behind a proxying apache :port *external-http-port* ) "/paste/")) -(defvar *meme-links* nil) ; whether to link to meme IRC logs +(defvar *meme-links* nil) ; whether to link to meme IRC logs, probably + ; only useful for freenode's lisppaste -(defvar *paste-maximum-size* 51200) +(defvar *paste-maximum-size* 51200) ; in bytes -(defvar *pastes-per-page* 50) +(defvar *pastes-per-page* 50) ; for the paste list (defparameter *banned-ips* - '("69.11.238.252" "168.143.113.138")) + '("69.11.238.252" "168.143.113.138")) ; two examples of + ; troublemakers affecting + ; freenode's lisppaste (defparameter *ban-log-file* - "ban-log") + "ban-log") ; where logs of attempts by banned users to paste go (defparameter *event-log-file* - "event-log") + "event-log") ; where normal events are logged -(defparameter *no-channel-pastes* nil) +(defparameter *no-channel-pastes* nil) ; whether to allow pastes that + ; don't get announced on a + ; channel ;; You shouldn't need to edit below this line. ;; LINE

1 0

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

17 Jun '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv23892 Modified Files: variable.lisp Log Message: A somewhat sane starting configuration Date: Thu Jun 17 06:26:12 2004 Author: bmastenbrook Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.21 lisppaste2/variable.lisp:1.22 --- lisppaste2/variable.lisp:1.21 Wed Jun 9 12:48:46 2004 +++ lisppaste2/variable.lisp Thu Jun 17 06:26:12 2004 @@ -1,13 +1,13 @@ -;;;; $Id: variable.lisp,v 1.21 2004/06/09 19:48:46 bmastenbrook Exp $ +;;;; $Id: variable.lisp,v 1.22 2004/06/17 13:26:12 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. (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* "localhost" @@ -23,7 +23,7 @@ (araneida:merge-url (araneida:make-url :scheme "http" :host *paste-site-name* - #|:port *external-http-port*|# + :port *external-http-port* ) "/paste/")) (defvar *meme-links* nil) ; whether to link to meme IRC logs

1 0

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

17 Jun '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv1487 Modified Files: lisppaste.asd Log Message: Oops. forgot the colorize-package dependency in web-server Date: Thu Jun 17 06:10:04 2004 Author: bmastenbrook Index: lisppaste2/lisppaste.asd diff -u lisppaste2/lisppaste.asd:1.12 lisppaste2/lisppaste.asd:1.13 --- lisppaste2/lisppaste.asd:1.12 Fri Jun 4 17:14:31 2004 +++ lisppaste2/lisppaste.asd Thu Jun 17 06:10:04 2004 @@ -1,5 +1,5 @@ ;;;; Silly emacs, this is -*- Lisp -*- -;;;; $Id: lisppaste.asd,v 1.12 2004/06/05 00:14:31 bmastenbrook Exp $ +;;;; $Id: lisppaste.asd,v 1.13 2004/06/17 13:10:04 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -39,6 +39,6 @@ (:file "coloring-types" :depends-on ("colorize" "clhs-lookup")) (:file "web-server" - :depends-on ("encode-for-pre" "lisppaste")) + :depends-on ("encode-for-pre" "lisppaste" "colorize-package")) (:file "persistent-pastes" :depends-on ("web-server"))))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/clhs-lookup.lisp
by Brian Mastenbrook 17 Jun '04

17 Jun '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv13571 Modified Files: clhs-lookup.lisp Log Message: Slightly less aggressive warning behavior Date: Thu Jun 17 05:59:17 2004 Author: bmastenbrook Index: lisppaste2/clhs-lookup.lisp diff -u lisppaste2/clhs-lookup.lisp:1.5 lisppaste2/clhs-lookup.lisp:1.6 --- lisppaste2/clhs-lookup.lisp:1.5 Thu Jun 17 05:53:17 2004 +++ lisppaste2/clhs-lookup.lisp Thu Jun 17 05:59:17 2004 @@ -30,6 +30,8 @@ (defun valid-target (&rest numbers) (probe-file (format nil "Body/~2,'0d_~(~{~36r~}~).htm" (car numbers) (mapcar #'(lambda (x) (+ x 9)) (cdr numbers))))) +(defvar *last-warn-time* 0) + (defun populate-table () (unless *populated-p* ;; Hyperspec @@ -37,7 +39,9 @@ ;; populate the table with the symbols from the Map file ;; this bit is easy and portable. (unless s - (format *trace-output* "Warning: could not find hyperspec map file. Adjust the path at the top of clhs-lookup.lisp to get links to the HyperSpec.~%") + (when (> (- (get-universal-time) *last-warn-time*) 10) + (format *trace-output* "Warning: could not find hyperspec map file. Adjust the path at the top of clhs-lookup.lisp to get links to the HyperSpec.~%") + (setf *last-warn-time* (get-universal-time))) (return-from populate-table nil)) (do ((symbol-name (read-line s nil s) (read-line s nil s)) (url (read-line s nil s) (read-line s nil s)))

1 0