[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