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

Brian Mastenbrook bmastenbrook at common-lisp.net
Tue Feb 17 23:56:42 UTC 2004


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

Modified Files:
	web-server.lisp 
Log Message:
Minor changes

Date: Tue Feb 17 18:56:41 2004
Author: bmastenbrook

Index: lisppaste2/web-server.lisp
diff -u lisppaste2/web-server.lisp:1.27 lisppaste2/web-server.lisp:1.28
--- lisppaste2/web-server.lisp:1.27	Tue Feb 10 11:18:17 2004
+++ lisppaste2/web-server.lisp	Tue Feb 17 18:56:41 2004
@@ -1,4 +1,4 @@
-;;;; $Id: web-server.lisp,v 1.27 2004/02/10 16:18:17 bmastenbrook Exp $
+;;;; $Id: web-server.lisp,v 1.28 2004/02/17 23:56:41 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -44,12 +44,12 @@
     " | "
     ((a :href "http://common-lisp.net/project/lisppaste") "lisppaste home page")))
 
-(defun time-delta (time &optional (level 2))
+(defun time-delta (time &key (level 2) (ago-p t))
   (let ((delta (- (get-universal-time) time)))
     (cond
      ((< delta 1) "<Doc Brown>From the <i>future</i>...</Doc Brown>")
-     ((< delta (* 60 60)) (format nil "~A ago" (time-delta-primitive delta 1)))
-     (t (format nil "~A ago" (time-delta-primitive delta level))))))
+     ((< delta (* 60 60)) (format nil "~A~A" (time-delta-primitive delta 1) (if ago-p " ago" "")))
+     (t (format nil "~A~A" (time-delta-primitive delta level) (if ago-p " ago" ""))))))
 
 (defun irc-log-link (utime channel)
   (format nil "http://meme.b9.com/now?utime=~A&channel=~A"
@@ -86,6 +86,11 @@
 (defun rss-link-header ()
   `((link :rel "alternate" :type "application/rss+xml" :title "Lisppaste RSS" :href ,(araneida:urlstring *rss-url*))))
 
+(defun max-length (str n)
+  (if (> (length str) n)
+      (concatenate 'string (subseq str 0 (1- n)) "...")
+    str))
+
 (defmethod araneida:handle-request-response ((handler list-paste-handler) method request)
   (araneida:request-send-headers request :expires 0)
   (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">")
@@ -101,10 +106,10 @@
        ,@(reverse (mapcar #'(lambda (paste)
 			      `(tr ((td :nowrap "nowrap") ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number paste)))))
 						  ,(concatenate 'string "#" (prin1-to-string (paste-number paste)))))
-				   ((td :nowrap "nowrap") ,(encode-for-pre (paste-user paste)))
+				   ((td :nowrap "nowrap") ,(encode-for-pre (max-length (paste-user paste) 12)))
                                    ((td :nowrap "nowrap") ,(encode-for-pre (paste-channel paste)))
-				   ((td :nowrap "nowrap") ,(time-delta (paste-universal-time paste) 1))
-				   ((td :width "100%" :bgcolor "#F4F4F4" :nowrap "nowrap") ,(encode-for-pre (paste-title paste)))
+				   ((td :nowrap "nowrap") ,(time-delta (paste-universal-time paste) :level 1 :ago-p nil))
+				   ((td :width "100%" :bgcolor "#F4F4F4" :nowrap "nowrap") ,(encode-for-pre (max-length (paste-title paste) 50)))
 				   ((td :nowrap "nowrap") ,(length (paste-annotations paste)))))
 			  *pastes*)))
       ,@(bottom-links)))))





More information about the Lisppaste-cvs mailing list