Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2
Modified Files: web-server.lisp encode-for-pre.lisp Log Message: Fix line numbering, spacing. Add support for pastes with no channel.
Date: Tue Jun 8 08:20:40 2004 Author: bmastenbrook
Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.51 lisppaste2/web-server.lisp:1.52 --- lisppaste2/web-server.lisp:1.51 Fri Jun 4 14:23:23 2004 +++ lisppaste2/web-server.lisp Tue Jun 8 08:20:40 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.51 2004/06/04 21:23:23 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.52 2004/06/08 15:20:40 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
;;;; See the LICENSE file for licensing information. @@ -60,7 +60,6 @@ (body (h1 ((font :color "red") "Naughty boy!")))))) (call-next-method))))
- (defmethod araneida:handle-request-response ((handler new-paste-handler) method request) (let* ((annotate-string (araneida:body-param "annotate" (araneida:request-body request))) (annotate-number (if annotate-string (parse-integer annotate-string :junk-allowed t))) @@ -69,15 +68,28 @@ (or (and annotate (paste-channel annotate)) (find-if #'(lambda (e) (> (length e) 1)) (list + (and (eql method :post) + (araneida:body-param "channel" + (araneida:request-body request))) + (and *no-channel-pastes* + (or + (string-equal (araneida::request-unhandled-part request) "/none") + (string-equal (araneida:request-cookie request "CHANNEL") "None")) + "None") (substitute ## #/ (araneida::request-unhandled-part request) :test #'char=) (concatenate 'string "#" (araneida:request-cookie request "CHANNEL")) - (and (eql method :post) - (araneida:body-param "channel" - (araneida:request-body request)))))))) + ))))) (cond - ((and default-channel (find default-channel *channels* :test #'string=)) - (araneida:request-send-headers request :expires 0 :set-cookie (format nil "CHANNEL=~A; path=/" (subseq default-channel 1))) + ((and default-channel (or (and *no-channel-pastes* + (string-equal default-channel "None")) + (find default-channel *channels* :test #'string=))) + (araneida:request-send-headers request :expires 0 :set-cookie + (format nil "CHANNEL=~A; path=/" + (or (and *no-channel-pastes* + (string-equal default-channel "none") + "None") + (subseq default-channel 1)))) (new-paste-form request :annotate annotate :default-channel default-channel)) (t (araneida:request-send-headers request :expires 0) (araneida:html-stream @@ -180,6 +192,17 @@ (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) @@ -300,8 +323,11 @@ (let* ((discriminate-channel (or (araneida:body-param "channel" (araneida:request-body request)) (if (not (string= channel "")) - (substitute ## #/ channel - :test #'char=)))) + (or (and *no-channel-pastes* + (string-equal channel "/none") + "None") + (substitute ## #/ channel + :test #'char=))))) (discriminate-channel (if (string-equal discriminate-channel "allchannels") nil discriminate-channel)) @@ -362,12 +388,19 @@ ((a :href ,(concatenate 'string (araneida:urlstring *rss-url*) (if discriminate-channel - (substitute #? ## discriminate-channel) ""))) "Basic") + (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 - (substitute #? ## discriminate-channel) ""))) "Full")) + (or (and *no-channel-pastes* + (string-equal discriminate-channel "none") + "?none") + (substitute #? ## discriminate-channel)) + ""))) "Full")) ) (tr ((td :align left) "Page: ") @@ -398,8 +431,11 @@ (araneida:request-send-headers request :expires 0 :content-type "application/rss+xml") (format (araneida:request-stream request) "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>~C~C" #\Return #\Linefeed) (let ((discriminate-channel (if (not (string= (araneida::request-unhandled-part request) "")) - (substitute ## #? (araneida::request-unhandled-part request) - :test #'char=)))) + (or (and *no-channel-pastes* + (string-equal (araneida::request-unhandled-part request) "?none") + "None") + (substitute ## #? (araneida::request-unhandled-part request) + :test #'char=))))) (araneida:html-stream (araneida:request-stream request) `((|rss| :|version| "2.0") @@ -458,8 +494,11 @@ (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. The -paste will be announced on the selected channel @ " ,(irc:server-name *connection*) ".") + (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) "."))) @@ -474,7 +513,7 @@ (option :value "") ,@(mapcar #'(lambda (e) `((option :value ,e ,@(if (string-equal e default-channel) - '(:selected))) + '(:selected "SELECTED"))) ,(encode-for-pre e))) *channels*)))))) (tr (th "Enter your username:") @@ -484,6 +523,16 @@ (th "Enter a title:") (td ((input :type text :name "title" :value ,(encode-for-pre default-title))))) + ,@(if (not annotate) + `((tr + (th (i "(Optional) Colorize as: ")) + (td ((select :name "colorize") + ((option :value "" :selected "SELECTED") "") + ((option :value "None") "None") + ,@(mapcar #'(lambda (pair) + `((option :value ,(cdr pair)) + ,(cdr pair))) + (colorize:coloring-types))))))) (tr ((th :valign top) "Enter your paste:") (td ((textarea :rows 24 :cols 80 :name "text") @@ -497,13 +546,18 @@ (let* ((username (araneida:body-param "username" (araneida:request-body request))) (title (araneida:body-param "title" (araneida:request-body request))) (text (araneida:body-param "text" (araneida:request-body request))) + (colorize-as (araneida:body-param "colorize" (araneida:request-body request))) (annotate (araneida:body-param "annotate" (araneida:request-body request))) (annotate-number (if annotate (parse-integer annotate :junk-allowed t))) (annotate-paste (if annotate-number (find annotate-number *pastes* :key #'paste-number))) (channel (araneida:body-param "channel" (araneida:request-body request)))) (if (> (length channel) 1) (araneida:request-send-headers request :expires 0 - :set-cookie (format nil "CHANNEL=~A; path=/" (subseq channel 1))) + :set-cookie (format nil "CHANNEL=~A; path=/" + (or (and *no-channel-pastes* + (string-equal channel "none") + "None") + (subseq channel 1)))) (araneida:request-send-headers request :expires 0)) (cond ((> (length text) *paste-maximum-size*) @@ -540,7 +594,8 @@ :title title :contents text :universal-time (get-universal-time) - :channel channel) + :channel channel + :colorization-mode (coerce colorize-as 'string)) (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) @@ -549,7 +604,10 @@ ,(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) ", and was also sent to " ,channel " @ " ,(irc:server-name *connection*)) + (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))) @@ -562,38 +620,51 @@ (if (< l1 l2) nil (string= (subseq str (- l1 l2) l1) end))))
-(defun format-paste (paste this-url paste-number &optional annotation colorize-as) - `((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 *meme-links* - " | " "")))) - ,@(if *meme-links* - `(((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 colorize-as - (colorize:format-scan colorize-as - (mapcar #'(lambda (e) - (cons (car e) - (encode-for-tt (cdr e)))) - (colorize:scan-string colorize-as (paste-contents paste)))) - (encode-for-tt (paste-contents paste)))))))) +(defun format-paste (paste this-url paste-number &optional annotation colorize-as line-numbers) + (let ((n 0)) + (labels + ((line-number () + (format nil "<span class="paste">~A</span>" + (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)))) + `((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 *meme-links* + " | " "")))) + ,@(if *meme-links* + `(((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))))))))))
(defmethod araneida:handle-request-response ((handler display-paste-handler) method request) ; XXX request-unhandled-part will be exported in 0.81 @@ -604,13 +675,22 @@ (paste (some #'(lambda (element) (and (eql paste-number (paste-number element)) element)) *pastes*)) - (colorize-string (araneida:body-param "colorize" (araneida:request-body request))) + (linenumbers (equalp (araneida:body-param "linenumbers" (araneida:request-body request)) + "true")) + (colorize-string (or (and paste + (> (length (paste-colorization-mode paste)) 0) + (paste-colorization-mode paste)) + (araneida:body-param "colorize" (araneida:request-body request)))) (colorize-as (or (car (rassoc colorize-string (colorize:coloring-types) :test #'string-equal)) (if (and paste (not (string-equal colorize-string "None"))) (colorize:autodetect-coloring-type (paste-channel paste))))) (colorize:*css-background-class* "paste")) + (and paste + (format t "Serving paste number ~S to ~S.~%" + (paste-number paste) + (car (araneida:request-header request :x-forwarded-for)))) (if paste (if raw (let ((p (position #, (araneida::request-unhandled-part request) :test #'char=))) @@ -641,7 +721,8 @@ colorize:*coloring-css*)) ,(rss-link-header)) (body - ,(format-paste paste (araneida:urlstring (araneida:request-url request)) paste-number nil colorize-as) + ,(format-paste paste (araneida:urlstring (araneida:request-url request)) paste-number nil colorize-as + linenumbers) ,@(if (paste-annotations paste) `((p) "Annotations for this paste: " @@ -651,7 +732,7 @@ ,(format-paste a (format nil "~A,~A" (araneida:urlstring (araneida:request-url request)) - (paste-number a)) (paste-number a) t colorize-as))) + (paste-number a)) (paste-number a) t colorize-as linenumbers))) (reverse (paste-annotations paste))))) `((p) "This paste has no annotations.")) (p) @@ -670,7 +751,11 @@ '(:selected "SELECTED"))) ,(cdr pair))) (colorize:coloring-types))) - ((input :type submit :value "Colorize"))) + (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))))
Index: lisppaste2/encode-for-pre.lisp diff -u lisppaste2/encode-for-pre.lisp:1.16 lisppaste2/encode-for-pre.lisp:1.17 --- lisppaste2/encode-for-pre.lisp:1.16 Thu Jun 3 13:19:40 2004 +++ lisppaste2/encode-for-pre.lisp Tue Jun 8 08:20:40 2004 @@ -1,4 +1,4 @@ -;;;; $Id: encode-for-pre.lisp,v 1.16 2004/06/03 20:19:40 bmastenbrook Exp $ +;;;; $Id: encode-for-pre.lisp,v 1.17 2004/06/08 15:20:40 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $
;;;; See the LICENSE file for licensing information. @@ -8,7 +8,7 @@ (:export :encode-for-pre :encode-for-tt :encode-for-http)) (in-package :html-encode)
-(defun encode-for-tt (string) +(defun encode-for-tt (string &key with-line-numbers first-char-nbsp) (let ((pos 0) (end (length string)) (char nil)) (flet ((next-char () @@ -19,6 +19,9 @@ (with-output-to-string (out) (block nil (tagbody + (unless first-char-nbsp + (next-char) + (go process-char)) escape-spaces (next-char) (when (eql char #\Space) @@ -29,6 +32,8 @@ ((nil) (return)) ((#\Newline) (write-string "<br>" out) + (if with-line-numbers + (write-string (funcall with-line-numbers) out)) (go escape-spaces)) ((#&) (write-string "&" out))