Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/example In directory common-lisp.net:/tmp/cvs-serv11495
Modified Files: irclogs.css logger.lisp Log Message: use css style names rather than hard coding the colors, weights, and sizes Date: Sun Dec 14 08:01:51 2003 Author: krosenberg
Index: net-nittin-irc/example/irclogs.css diff -u net-nittin-irc/example/irclogs.css:1.2 net-nittin-irc/example/irclogs.css:1.3 --- net-nittin-irc/example/irclogs.css:1.2 Sun Dec 14 06:53:41 2003 +++ net-nittin-irc/example/irclogs.css Sun Dec 14 08:01:50 2003 @@ -1,16 +1,17 @@ /* -*- Mode: CSS -*- */ /* Cascading stylesheet for logger.lisp */
+#body { font-family: fixed; + font-size: 10px; + background: #FFFFFF; + color: #000000; + margin: 0px 0px 10px 0px; + } + .time { color:#888; }
.privmsg { }
-.action { } - -.info { font-size:85%; font-style:italic; } - -.brack ( color:#CCC; ) - .subject { color:#22C; font-weight: bold; }
.msg ( color:#000; ) @@ -23,8 +24,10 @@
.user-address { color:#444; }
-.info-brack { color:#CCC; } +.info-subject { color:#22C; font-weight: bold; font-size:80% } + +.info-brack { color:#CCC; font-size:80%}
-.info-msg { color:#000; } +.info-msg { color:#000; font-size:80%}
-.object { color:#822; } +.info-object { color:#822; font-size:80%; }
Index: net-nittin-irc/example/logger.lisp diff -u net-nittin-irc/example/logger.lisp:1.4 net-nittin-irc/example/logger.lisp:1.5 --- net-nittin-irc/example/logger.lisp:1.4 Sun Dec 14 06:53:41 2003 +++ net-nittin-irc/example/logger.lisp Sun Dec 14 08:01:50 2003 @@ -1,5 +1,5 @@ ;;;; -*- Mode: Lisp -*- -;;;; $Id: logger.lisp,v 1.4 2003/12/14 11:53:41 krosenberg Exp $ +;;;; $Id: logger.lisp,v 1.5 2003/12/14 13:01:50 krosenberg Exp $ ;;;; ;;;; Purpose: A logging bot ;;;; Author: Kevin Rosenberg @@ -14,9 +14,6 @@ (asdf:operate 'asdf:load-op 'net-nittin-irc)) (unless (find-package 'cl-ppcre) (asdf:operate 'asdf:load-op 'cl-ppcre)) -#+ignore -(unless (find-package 'puri) - (asdf:operate 'asdf:load-op 'puri))
(in-package cl-user) (defpackage logger @@ -84,12 +81,21 @@ (declare (ignore second minute hour day-of-week daylight-p zone)) (format nil "~A~4,'0D.~2,'0D.~2,'0D" base-name year month day-of-month)))
+(defun html-title (channel) + (multiple-value-bind + (second minute hour day-of-month month year day-of-week daylight-p zone) + (decode-universal-time (get-universal-time)) + (declare (ignore second minute hour day-of-week daylight-p zone)) + (format nil "~A IRC Log ~4,'0D/~2,'0D/~2,'0D" + (string-left-trim '(##) (name channel)) year month day-of-month))) + (defun output-file-header (logger channel istream) (case (elt (formats logger) istream) (:html (format (elt (streams channel) istream) - "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">~%") - (format (elt (streams channel) istream) "<html><head><link rel='stylesheet' href='/irclogs.css' type='text/css' /></head><body>~%")))) + "<?xml version='1.0' ?>~%<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">~%") + (format (elt (streams channel) istream) "<html xmlns='http://www.w3.org/1999/xhtml'>~%<head>~%<title>~A</title>~%<link rel='stylesheet' href='/irclogs.css' type='text/css' />~%</head>~%<body>~%" + (html-title channel)))))
(defun output-file-footer (logger channel istream) (case (elt (formats logger) istream) @@ -172,14 +178,9 @@ (assert (streamp stream)) (case (elt (formats logger) istream) (:html - (format stream - "<div class='~A'><span class='time'>" - (case type - (:privmsg "privmsg") - (:action "action") - (t "info"))) + (write-string "<div><span class='time'>" stream) (write-string (format-time (received-time msg)) stream) - (format stream "</span> ") + (write-string "</span> " stream) (case type (:privmsg (format stream "<span class='brack'><</span><span class='subject'>~A</span><span class='brack'>></span> <span class='msg'>~A</span>" @@ -189,10 +190,10 @@ "<span class='action-brack'>*</span><span class='action-name'>~A</span><span class='action-brack'>*</span> <span class='action-msg'>~A</span>" source (activate-uris text))) (t - (format stream "<span class='subject'>~A</span> <span class='info-brack'>[</span><span class='user-address'>~A</span><span class='info-brack'>]</span> <span class='info-msg'>~A</span>" + (format stream "<span class='info-subject'>~A</span> <span class='info-brack'>[</span><span class='user-address'>~A</span><span class='info-brack'>]</span> <span class='info-msg'>~A</span>" source (user-address msg) text) (when object - (format stream " <span class='object'>~A</span>" object)))) + (format stream " <span class='info-object'>~A</span>" object)))) (format stream "</div>~%")) (:sexp (format stream "(~W ~W ~W ~W ~W ~W)~%" (received-time msg) @@ -215,16 +216,22 @@
(defun output-event (msg type text &optional object) (dolist (logger *loggers*) - (let* ((channel-name (case type - (:join - (trailing-argument msg)) - (t - (car (last (arguments msg)))))) - (channel (find channel-name (the list (channels logger)) - :test #'string-equal :key #'name))) - (when channel - (dotimes (i (length (formats logger))) - (output-event-for-a-stream msg type text object logger channel i)))))) + (case type + (:quit + (dolist (channel (channels logger)) + (dotimes (i (length (formats logger))) + (output-event-for-a-stream msg type text object logger channel i)))) + (t + (let* ((channel-name (case type + (:join + (trailing-argument msg)) + (t + (car (last (arguments msg)))))) + (channel (find channel-name (the list (channels logger)) + :test #'string-equal :key #'name))) + (when channel + (dotimes (i (length (formats logger))) + (output-event-for-a-stream msg type text object logger channel i))))))))
(defun privmsg-hook (msg) (output-event msg :privmsg (trailing-argument msg)))
net-nittin-irc-cvs@common-lisp.net