[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp

Brian Mastenbrook bmastenbrook at common-lisp.net
Thu Jul 8 17:42:40 UTC 2004


Update of /project/lisppaste/cvsroot/lisppaste2
In directory common-lisp.net:/home/bmastenbrook/lisppaste2

Modified Files:
	web-server.lisp 
Log Message:
recent paste list

Date: Thu Jul  8 10:42:40 2004
Author: bmastenbrook

Index: lisppaste2/web-server.lisp
diff -u lisppaste2/web-server.lisp:1.61 lisppaste2/web-server.lisp:1.62
--- lisppaste2/web-server.lisp:1.61	Tue Jul  6 09:58:13 2004
+++ lisppaste2/web-server.lisp	Thu Jul  8 10:42:40 2004
@@ -1,4 +1,4 @@
-;;;; $Id: web-server.lisp,v 1.61 2004/07/06 16:58:13 bmastenbrook Exp $
+;;;; $Id: web-server.lisp,v 1.62 2004/07/08 17:42:40 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -31,6 +31,8 @@
 
 (defclass main-handler (lisppaste-basic-handler) ())
 
+(defclass recent-handler (lisppaste-basic-handler) ())
+
 (defclass css-handler (lisppaste-basic-handler) ())
 
 (defclass new-paste-handler (lisppaste-basic-handler) ())
@@ -118,6 +120,31 @@
      , at forms
      ,@(bottom-links))))
 
+(defun recent-paste-list-div (&key (count 10))
+  `((div :class "simple-paste-list")
+    (table
+     ,@(loop for i from 1 to count
+             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)))))
+     (tr
+      ((td :colspan 3)
+       (center
+        (b
+         ((a :href ,(araneida:urlstring *list-paste-url*))
+          "More recent pastes..."))))))))
+
+(defmethod araneida:handle-request-response ((handler recent-handler) method request)
+  (araneida:request-send-headers request :expires 0)
+  (araneida:html-stream
+   (araneida:request-stream request)
+   (lisppaste-wrap-page
+    "Recent Pastes"
+    (recent-paste-list-div :count 20))))
+
 (defmethod araneida:handle-request-response ((handler main-handler) method request)
   (araneida:request-send-headers request :expires 0)
   (araneida:html-stream
@@ -129,21 +156,7 @@
        ((td :align right) ((div :class "small-header") "Make a new paste")))
       (tr
        ((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)))))
-          (tr
-           ((td :colspan 3)
-            (center
-             (b
-              ((a :href ,(araneida:urlstring *list-paste-url*))
-               "More recent pastes...")))))))
+        ,(recent-paste-list-div)
         (p)
         ((div :class "small-header") "About lisppaste")
         ((div :class "info-text")
@@ -168,7 +181,7 @@
          " - a hosting service for projects written in Common Lisp (like this one)."
          (p)
          "Please consider "
-         (b ((a :href "https://www.paypal.com/xclick/business=bmastenb%40indiana.edu&item_name=Support+Lisppaste%2C+SBCL/Darwin%2C+etc.&no_shipping=1&no_note=1&tax=0&currency_code=USD") "supporting Lisppaste development"))
+         (b ((a :href "https://www.paypal.com/xclick/business=chandler%40iddqd.org&item_name=Support+Lisppaste%2C+SBCL/Darwin%2C+etc.&no_shipping=1&no_note=1&tax=0&currency_code=USD") "supporting Lisppaste development"))
          " with your contributions. Thanks!"
          ))
        ((td :valign top :align right)
@@ -257,7 +270,7 @@
         ((a :href ,(araneida:urlstring *paste-external-url*))
          "Main page")
         " | "
-        ((a :href "https://www.paypal.com/xclick/business=bmastenb%40indiana.edu&item_name=Support+Lisppaste%2C+SBCL/Darwin%2C+etc.&no_shipping=1&no_note=1&tax=0&currency_code=USD")
+        ((a :href "https://www.paypal.com/xclick/business=chandler%40iddqd.org&item_name=Support+Lisppaste%2C+SBCL/Darwin%2C+etc.&no_shipping=1&no_note=1&tax=0&currency_code=USD")
          "Support Lisppaste"))
        ((td :id "other-links")
         ((a :href ,(araneida:urlstring *new-paste-url*)) "New paste")
@@ -381,7 +394,7 @@
                   (last
                    (sort
                     (loop for count being the hash-values of *referer-hash* using (hash-key host)
-                          collect (cons host count)) #'< :key #'cdr) 10))))
+                          collect (cons host count)) #'< :key #'cdr) 20))))
       (p)
       ((span :class "small-header") "Most popular channels:")
       (p)
@@ -782,7 +795,7 @@
                  ((span :class "small-header") "Donations accepted")
                  (br)
                  "If you appreciate Lisppaste, please consider "
-                 (b ((a :href "https://www.paypal.com/xclick/business=bmastenb%40indiana.edu&item_name=Support+Lisppaste%2C+SBCL/Darwin%2C+etc.&no_shipping=1&no_note=1&tax=0&currency_code=USD") "making a donation"))
+                 (b ((a :href "https://www.paypal.com/xclick/business=chandler%40iddqd.org&item_name=Support+Lisppaste%2C+SBCL/Darwin%2C+etc.&no_shipping=1&no_note=1&tax=0&currency_code=USD") "making a donation"))
                  " to support further development of the service. Thanks!"))))
             ))))))))
 
@@ -1020,3 +1033,8 @@
  (araneida:http-listener-handler *paste-listener*)
  (make-instance 'css-handler)
  (araneida:urlstring *css-url*) t)
+
+(araneida:install-handler
+ (araneida:http-listener-handler *paste-listener*)
+ (make-instance 'recent-handler)
+ (araneida:urlstring *recent-url*) t)





More information about the Lisppaste-cvs mailing list