Update of /project/lisppaste/cvsroot/lisppaste2 In directory nittin.net:/tmp/cvs-serv1010 Modified Files: encode-for-pre.lisp web-server.lisp lisppaste.lisp Added Files: colorize.lisp coloring-types.lisp Log Message: Major changes: new colorizer, URL via IRC, etc Date: Tue Jun 1 06:17:50 2004 Author: bmastenbrook Index: lisppaste2/encode-for-pre.lisp diff -u lisppaste2/encode-for-pre.lisp:1.14 lisppaste2/encode-for-pre.lisp:1.15 --- lisppaste2/encode-for-pre.lisp:1.14 Fri May 21 15:11:09 2004 +++ lisppaste2/encode-for-pre.lisp Tue Jun 1 06:17:50 2004 @@ -1,9 +1,12 @@ -;;;; $Id: encode-for-pre.lisp,v 1.14 2004/05/21 22:11:09 bmastenbrook Exp $ +;;;; $Id: encode-for-pre.lisp,v 1.15 2004/06/01 13:17:50 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $ ;;;; See the LICENSE file for licensing information. -(in-package :lisppaste) +(defpackage :html-encode + (:use :common-lisp) + (:export :encode-for-pre :encode-for-tt :encode-for-http)) +(in-package :html-encode) (defun encode-for-tt (string) (let ((pos 0) (end (length string)) Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.47 lisppaste2/web-server.lisp:1.48 --- lisppaste2/web-server.lisp:1.47 Fri May 21 14:29:11 2004 +++ lisppaste2/web-server.lisp Tue Jun 1 06:17:50 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.47 2004/05/21 21:29:11 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.48 2004/06/01 13:17:50 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -178,14 +178,16 @@ (b "Uptime: ") ,(time-delta *boot-time* :ago-p nil :level 3) (p) (b "Most popular channels:") (br) - ((table :border 2) + ((table :border 0) ,@(mapcar #'(lambda (pair) `(tr ((td :valign top) - (tt ,(car pair))) - ((td :valign top) - (tt ,(cdr pair))))) - (sort + ,(car pair)) + ((td) + " ") + ((td :valign top) + ,(cdr pair)))) + (sort (loop for i in *channels* collect (cons i (count i *pastes* :key #'paste-channel @@ -193,19 +195,20 @@ #'> :key #'cdr))) (p) (b "Average rates of pasting:") (br) - ((table :border 2) + ((table :border 0) ,@(mapcar #'(lambda (pair) `(tr #+(or) (td ,(length (second pair))) ((td :valign top) - (tt ,(first pair))) + ,(first pair)) + (td " ") ((td :valign top) - (tt ,(time-delta - 0 :origin - (truncate (/ - (third pair) - (length (second pair)))) :ago-p nil) - " between pastes")))) + ,(time-delta + 0 :origin + (truncate (/ + (third pair) + (length (second pair)))) :ago-p nil) + " between pastes"))) (list* (list "Overall" *pastes* (- (paste-universal-time (first *pastes*)) (paste-universal-time (car (last *pastes*))))) @@ -314,16 +317,16 @@ ((form :method post :action ,(araneida:urlstring *list-paste-url*)) (table (tr ((td :align left) "View only: ") - ((td :valign top) + ((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*))) - ((td :valign top) - ((input :type submit :value "Submit")))) + ,(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) @@ -336,7 +339,7 @@ (araneida:urlstring *rss-full-url*) (if discriminate-channel (substitute #\? #\# discriminate-channel) ""))) "Full")) - (td)) + ) (tr ((td :align left) "Page: ") ((td :align center) @@ -530,7 +533,7 @@ (if (< l1 l2) nil (string= (subseq str (- l1 l2) l1) end)))) -(defun format-paste (paste this-url paste-number &optional annotation) +(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 @@ -553,7 +556,15 @@ ,@(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 ,(encode-for-tt (paste-contents paste))))))) + (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)))))))) (defmethod araneida:handle-request-response ((handler display-paste-handler) method request) ; XXX request-unhandled-part will be exported in 0.81 @@ -563,7 +574,13 @@ (raw (ends-with (araneida::request-unhandled-part request) "/raw")) (paste (some #'(lambda (element) (and (eql paste-number (paste-number element)) - element)) *pastes*))) + element)) *pastes*)) + (colorize-string (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)))))) (if paste (if raw (let ((p (position #\, (araneida::request-unhandled-part request) :test #'char=))) @@ -588,9 +605,11 @@ `(html (head (title "Paste number " ,paste-number) + ((style :type "text/css") + ,colorize:*coloring-css*) ,(rss-link-header)) (body - ,(format-paste paste (araneida:urlstring (araneida:request-url request)) paste-number) + ,(format-paste paste (araneida:urlstring (araneida:request-url request)) paste-number nil colorize-as) ,(if (paste-annotations paste) `(p "Annotations for this paste: " @@ -600,9 +619,26 @@ ,(format-paste a (format nil "~A,~A" (araneida:urlstring (araneida:request-url request)) - (paste-number a)) (paste-number a) t))) + (paste-number a)) (paste-number a) t colorize-as))) (reverse (paste-annotations paste))))) `(p "This paste has no annotations.")) + ((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 "true"))) + ,(cdr pair))) + (colorize:coloring-types))) + ((input :type submit :value "Colorize"))) + (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")))) Index: lisppaste2/lisppaste.lisp diff -u lisppaste2/lisppaste.lisp:1.15 lisppaste2/lisppaste.lisp:1.16 --- lisppaste2/lisppaste.lisp:1.15 Tue Apr 27 14:03:21 2004 +++ lisppaste2/lisppaste.lisp Tue Jun 1 06:17:50 2004 @@ -1,4 +1,4 @@ -;;;; $Id: lisppaste.lisp,v 1.15 2004/04/27 21:03:21 bmastenbrook Exp $ +;;;; $Id: lisppaste.lisp,v 1.16 2004/06/01 13:17:50 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -7,11 +7,25 @@ (defun make-msg-hook (nick) (lambda (message) - (if (string= (first (irc:arguments message)) nick) - (irc:privmsg *connection* - (irc:source message) - (format nil "To use the lisppaste bot, visit ~A and enter your paste. Be sure to select the right channel!" (araneida:urlstring *new-paste-url*)))))) - + (let ((text (irc:trailing-argument message))) + (cond ((string= (first (irc:arguments message)) nick) + (irc:privmsg *connection* + (irc:source message) + (format nil "To use the lisppaste bot, visit ~A and enter your paste. Be sure to select the right channel!" (araneida:urlstring *new-paste-url*)))) + ((and (> (length text) + (length nick)) + (search nick text :start2 0 :end2 (length nick) :test #'char-equal)) + (let ((url-position (search "url" text :start2 (length nick) + :test #'char-equal))) + (if (and + url-position + (notany #'alphanumericp (subseq text (length nick) (1- url-position))) + (notany #'alphanumericp (subseq text (+ url-position 3)))) + (irc:privmsg *connection* + (first (irc:arguments message)) + (format nil "To use the lisppaste bot, visit ~A/~A and enter your paste." (araneida:urlstring *new-paste-url*) (subseq (first (irc:arguments message)) 1)))))))))) + + (defun add-hook (nick) (irc:remove-hooks *connection* 'irc:irc-privmsg-message) (irc:add-hook *connection* 'irc:irc-privmsg-message (make-msg-hook nick))) @@ -68,4 +82,4 @@ (setf (irc:client-stream *connection*) (make-broadcast-stream))) (defun un-shut-up () - (setf (irc:client-stream *connection*) *trace-output*)) \ No newline at end of file + (setf (irc:client-stream *connection*) *trace-output*))