[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