[Lisppaste-cvs] CVS update: lisppaste2/colorize.lisp lisppaste2/coloring-types.lisp lisppaste2/encode-for-pre.lisp lisppaste2/web-server.lisp lisppaste2/lisppaste.lisp
Brian Mastenbrook
bmastenbrook at common-lisp.net
Tue Jun 1 13:17:50 UTC 2004
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*))
More information about the Lisppaste-cvs
mailing list