- net-nittin-irc-cvs@common-lisp.net - mailman3.common-lisp.net

[net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp
by Kevin Rosenberg 16 Dec '03

16 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv22463 Modified Files: protocol.lisp Log Message: fix typo Date: Tue Dec 16 18:21:56 2003 Author: krosenberg Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.26 net-nittin-irc/protocol.lisp:1.27 --- net-nittin-irc/protocol.lisp:1.26 Tue Dec 16 17:45:54 2003 +++ net-nittin-irc/protocol.lisp Tue Dec 16 18:21:56 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.26 2003/12/16 22:45:54 krosenberg Exp $ +;;;; $Id: protocol.lisp,v 1.27 2003/12/16 23:21:56 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -136,14 +136,12 @@ irc-message-event on them." (flet ((do-loop () (read-message-loop connection))) (let ((name (format nil "irc-hander-~D" (incf *background-count*)))) - (cond - (async - #+allegro (mp:process-run-function name #'do-loop) - #+cmu (mp:make-process #'do-loop :name name) - #+lispworks (mp:process-run-function name nil #'do-loop) - #+sbcl-thread (sb-thread:make-thread #'do-loop) - #+(and sbcl (not sbcl-thread)) (add-asynchronous-message-handler - connection)))))) + #+allegro (mp:process-run-function name #'do-loop) + #+cmu (mp:make-process #'do-loop :name name) + #+lispworks (mp:process-run-function name nil #'do-loop) + #+sbcl-thread (sb-thread:make-thread #'do-loop) + #+(and sbcl (not sbcl-thread)) (add-asynchronous-message-handler + connection)))) (defmethod read-message-loop ((connection connection)) (loop while (read-message connection)))

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/example/cliki.lisp
by Brian Mastenbrook 16 Dec '03

16 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/example In directory common-lisp.net:/tmp/cvs-serv20742 Modified Files: cliki.lisp Log Message: Just in case commit Date: Tue Dec 16 18:18:02 2003 Author: bmastenbrook Index: net-nittin-irc/example/cliki.lisp diff -u net-nittin-irc/example/cliki.lisp:1.7 net-nittin-irc/example/cliki.lisp:1.8 --- net-nittin-irc/example/cliki.lisp:1.7 Mon Dec 15 18:11:12 2003 +++ net-nittin-irc/example/cliki.lisp Tue Dec 16 18:18:01 2003 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.7 2003/12/15 23:11:12 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.8 2003/12/16 23:18:01 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -133,7 +133,7 @@ (defparameter *cliki-attention-prefix* "minion: ") -(defparameter *cliki-bot-help* "The minion bot supplies small definitions and performs lookups on CLiki. To use it, try ``minion: term?''. To add a term for IRC, try saying ``minion: add \"term\" as: definition''; otherwise, edit the corresponding CLiki page.") +(defparameter *cliki-bot-help* "The minion bot supplies small definitions and performs lookups on CLiki. To use it, try ``minion: term?''. To add a term for IRC, try saying ``minion: add \"term\" as: definition'' or ``minion: alias \"term\" as: term''; otherwise, edit the corresponding CLiki page.") (defun cliki-lookup (term-with-question) (let ((first-pass (regex-replace-all "^(\\s*)([^?]+)(\\?*)$" term-with-question "\\2")))

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/package.lisp net-nittin-irc/protocol.lisp
by Kevin Rosenberg 16 Dec '03

16 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv7798 Modified Files: package.lisp protocol.lisp Log Message: add read-message-loop-background function Date: Tue Dec 16 17:45:54 2003 Author: krosenberg Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.13 net-nittin-irc/package.lisp:1.14 --- net-nittin-irc/package.lisp:1.13 Tue Dec 16 16:29:12 2003 +++ net-nittin-irc/package.lisp Tue Dec 16 17:45:54 2003 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.13 2003/12/16 21:29:12 krosenberg Exp $ +;;;; $Id: package.lisp,v 1.14 2003/12/16 22:45:54 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -12,6 +12,7 @@ (:nicknames :irc :cl-irc) (:export :read-message-loop :read-message + :read-message-loop-background :add-asynchronous-message-handler :send-message :server-name Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.25 net-nittin-irc/protocol.lisp:1.26 --- net-nittin-irc/protocol.lisp:1.25 Tue Dec 16 13:57:36 2003 +++ net-nittin-irc/protocol.lisp Tue Dec 16 17:45:54 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.25 2003/12/16 18:57:36 krosenberg Exp $ +;;;; $Id: protocol.lisp,v 1.26 2003/12/16 22:45:54 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -130,9 +130,22 @@ message))) ; needed because of the "loop while" in read-message-loop (stream-error () (setf read-more-p nil))))) -(defmethod read-message-loop ((connection connection)) +(defvar *background-count* 0) +(defmethod read-message-loop-background ((connection connection)) "Read messages from the `connection', parse them and dispatch irc-message-event on them." + (flet ((do-loop () (read-message-loop connection))) + (let ((name (format nil "irc-hander-~D" (incf *background-count*)))) + (cond + (async + #+allegro (mp:process-run-function name #'do-loop) + #+cmu (mp:make-process #'do-loop :name name) + #+lispworks (mp:process-run-function name nil #'do-loop) + #+sbcl-thread (sb-thread:make-thread #'do-loop) + #+(and sbcl (not sbcl-thread)) (add-asynchronous-message-handler + connection)))))) + +(defmethod read-message-loop ((connection connection)) (loop while (read-message connection))) (defmethod read-irc-message ((connection connection))

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/example/irc-logger.asd net-nittin-irc/example/logger.lisp
by Kevin Rosenberg 16 Dec '03

16 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/example In directory common-lisp.net:/tmp/cvs-serv9612 Removed Files: irc-logger.asd logger.lisp Log Message: move to http://files.b9.com/irc-logger/ Date: Tue Dec 16 16:41:46 2003 Author: krosenberg

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/debian/changelog net-nittin-irc/debian/compat net-nittin-irc/debian/control net-nittin-irc/debian/copyright net-nittin-irc/debian/postinst net-nittin-irc/debian/prerm net-nittin-irc/debian/rules
by Kevin Rosenberg 16 Dec '03

16 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/debian In directory common-lisp.net:/tmp/cvs-serv4333/debian Added Files: changelog compat control copyright postinst prerm rules Log Message: add cl-irc.asd file for new name, add debian packaging files Date: Tue Dec 16 16:29:12 2003 Author: krosenberg

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/cl-irc.asd net-nittin-irc/CREDITS net-nittin-irc/package.lisp
by Kevin Rosenberg 16 Dec '03

16 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv4333 Modified Files: CREDITS package.lisp Added Files: cl-irc.asd Log Message: add cl-irc.asd file for new name, add debian packaging files Date: Tue Dec 16 16:29:12 2003 Author: krosenberg Index: net-nittin-irc/CREDITS diff -u net-nittin-irc/CREDITS:1.2 net-nittin-irc/CREDITS:1.3 --- net-nittin-irc/CREDITS:1.2 Sat Nov 22 13:40:36 2003 +++ net-nittin-irc/CREDITS Tue Dec 16 16:29:12 2003 @@ -1,3 +1,4 @@ Erik Enge Brian Mastenbrook Jochen Schmidt +Kevin Rosenberg Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.12 net-nittin-irc/package.lisp:1.13 --- net-nittin-irc/package.lisp:1.12 Tue Dec 16 13:57:36 2003 +++ net-nittin-irc/package.lisp Tue Dec 16 16:29:12 2003 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.12 2003/12/16 18:57:36 krosenberg Exp $ +;;;; $Id: package.lisp,v 1.13 2003/12/16 21:29:12 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -9,7 +9,7 @@ (eval-when (:execute :load-toplevel :compile-toplevel) (defpackage :net-nittin-irc (:use :cl) - (:nicknames :irc) + (:nicknames :irc :cl-irc) (:export :read-message-loop :read-message :add-asynchronous-message-handler

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/example/logger.lisp net-nittin-irc/example/irclogs.css
by Kevin Rosenberg 16 Dec '03

16 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/example In directory common-lisp.net:/tmp/cvs-serv32272 Modified Files: logger.lisp Removed Files: irclogs.css Log Message: add raw support, unichannel format support, remove html support, improve sexp format Date: Tue Dec 16 16:19:56 2003 Author: krosenberg Index: net-nittin-irc/example/logger.lisp diff -u net-nittin-irc/example/logger.lisp:1.10 net-nittin-irc/example/logger.lisp:1.11 --- net-nittin-irc/example/logger.lisp:1.10 Mon Dec 15 13:16:40 2003 +++ net-nittin-irc/example/logger.lisp Tue Dec 16 16:19:56 2003 @@ -1,5 +1,5 @@ ;;;; -*- Mode: Lisp -*- -;;;; $Id: logger.lisp,v 1.10 2003/12/15 18:16:40 krosenberg Exp $ +;;;; $Id: logger.lisp,v 1.11 2003/12/16 21:19:56 krosenberg Exp $ ;;;; ;;;; Purpose: A logging bot ;;;; Author: Kevin Rosenberg @@ -12,7 +12,10 @@ (:use :common-lisp :irc :cl-ppcre) (:export #:add-logger #:quit-logger - #:log-file-path)) + #:log-file-path + #:add-hook-logger + #:remove-hook-logger + #:*loggers*)) (in-package irc-logger) (defclass channel () @@ -36,25 +39,13 @@ (user-output :initarg :user-output :reader user-output :documentation "Output parameter from user, maybe stream or pathname.") + (unichannel :initarg :unichannel :reader unichannel :type boolean + :documentation "T if user-output is directory for individual channel output.") (formats :initarg :formats :reader formats :documentation "A list of output formats."))) (defvar *loggers* nil "List of active loggers.") -(defvar *uri-scanner* - (create-scanner - '(:register - (:alternation - (:sequence :word-boundary "http://" - (:char-class (:range #\a #\z) (:range #\a #\z) (:range #\0 #\9)) - (:greedy-repetition 1 nil :non-whitespace-char-class)) - (:sequence :word-boundary "ftp://" - (:char-class (:range #\a #\z) (:range #\a #\z) (:range #\0 #\9)) - (:greedy-repetition 1 nil :non-whitespace-char-class)) - (:sequence :word-boundary "mailto:" - (:char-class (:range #\a #\z) (:range #\a #\z) (:range #\0 #\9)) - (:greedy-repetition 1 nil :non-whitespace-char-class)))) - :case-insensitive-mode t)) (defparameter *user-address-scanner* (create-scanner @@ -77,29 +68,19 @@ (declare (ignore second minute hour day-of-week daylight-p zone)) (make-output-name name year month day-of-month))) -(defun html-title (channel-name) - (multiple-value-bind - (second minute hour day-of-month month year dow daylight-p zone) - (decode-universal-time (get-universal-time)) - (declare (ignore second minute hour dow daylight-p zone)) - (format nil "~A IRC Log ~4,'0D/~2,'0D/~2,'0D" - (string-left-trim '(#\#) channel-name) year month day-of-month))) - -(defun write-file-header (format channel-name stream) - (case format - (:html - (format stream - "<?xml version='1.0' ?>~%<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">~%") - (format stream - "<html xmlns='http://www.w3.org/1999/xhtml'>~%<head>~%<title>~A</title>~%<link rel='stylesheet' href='/irclogs.css' type='text/css' />~%</head>~%<body id='body'>~%<table><tbody>~%" - (html-title channel-name))))) - -(defun write-file-footer (format stream) - (case format - (:html - (format stream "</tbody></table></body></html>~%")))) +(defgeneric write-file-header (format channel-name stream)) -(defun log-file-path (output-root channel-name year month day format) +(defmethod write-file-header ((format t) channel-name stream) + (declare (ignore format channel-name stream)) + ) + +(defgeneric write-file-footer (format channel-name stream)) + +(defmethod write-file-footer ((format t) channel-name stream) + (declare (ignore format channel-name stream)) + ) + +(defun %log-file-path (output-root channel-name year month day type) (make-pathname :defaults output-root :directory (append (pathname-directory output-root) @@ -107,10 +88,18 @@ (string-left-trim '(#\#) channel-name) (format nil "~4,'0D-~2,'0D" year month))) :name (make-output-name channel-name year month day) - :type (case format - (:html "html") - (:sexp "sexp") - (t "txt")))) + :type type)) + +(defgeneric log-file-path (output-root channel-name year month day format)) + +(defmethod log-file-path (output-root channel-name year month day (format (eql :raw))) + (%log-file-path output-root channel-name year month day "raw")) + +(defmethod log-file-path (output-root channel-name year month day (format (eql :sexp))) + (%log-file-path output-root channel-name year month day "sexp")) + +(defmethod log-file-path (output-root channel-name year month day (format (eql :text))) + (%log-file-path output-root channel-name year month day "txt")) (defun log-file-path-utime (output-root channel-name format utime) @@ -135,11 +124,12 @@ (defun (setf get-output-name) (value channel istream) (setf (elt (current-output-names channel) istream) value)) -(defun ensure-output-stream-for-directory-output (utime logger channel istream) +(defun ensure-output-stream-for-unichannel (utime logger channel istream) (let ((name (make-output-name-utime (name channel) utime))) (unless (string= name (get-output-name channel istream)) (when (get-stream channel istream) (write-file-footer (get-format logger istream) + (name channel) (get-stream channel istream)) (close (get-stream channel istream))) (setf (get-output-name channel istream) name) @@ -161,18 +151,16 @@ (defun ensure-output-stream (utime logger channel istream) "Ensures that *output-stream* is correct." (cond - ((streamp (user-output logger)) - (unless (get-stream channel istream) - (setf (get-stream channel istream) (user-output logger)))) - ((pathnamep (user-output logger)) - (cond - ;; user specified a named file for output - ((pathname-name (user-output logger)) - (setf (get-stream channel istream) - (open (user-output logger) :direction :output :if-exists :append))) - ;; user specified a directory for output files - (t - (ensure-output-stream-for-directory-output utime logger channel istream)))))) + ((streamp (user-output logger)) + (unless (get-stream channel istream) + (setf (get-stream channel istream) (user-output logger)))) + ((pathnamep (user-output logger)) + (cond + ((unichannel logger) + (ensure-output-stream-for-unichannel utime logger channel istream)) + (t + (setf (get-stream channel istream) + (open (user-output logger) :direction :output :if-exists :append))))))) (defun format-utime (utime) (multiple-value-bind @@ -188,23 +176,6 @@ (declare (ignore second day-of-month month year day-of-week daylight-p zone)) (format nil "~2,'0D:~2,'0D" hour minute))) -(defun activate-uris (str) - "Find any URI's in a string and make them HTML clickable." - (let ((split (split *uri-scanner* str :with-registers-p t))) - (if (= 1 (length split)) - str - (with-output-to-string (stream) - (dolist (item split) - (if (and (> (length item) 6) - (or - (string-equal "http://" (subseq item 0 7)) - (string-equal "ftp://" (subseq item 0 6)) - (string-equal "mailto:" (subseq item 0 7))) - ;; (ignore-errors (puri:parse-uri item)) - t) - (format stream "<a href='~A'>~A</a>" item item) - (write-string item stream))))))) - (defun user-address (msg) (let ((split (split *user-address-scanner* (raw-message-string msg) :with-registers-p t))) @@ -212,108 +183,112 @@ (second split) ""))) -(defun %output-event (stream format utime type source text object user-address) - (case format - (:html - (write-string "<tr><td class='time'>" stream) - (write-string (format-utime utime) stream) - (write-string "</td> " stream) - (case type - (:privmsg - (format stream "<td><~A></td><td class='msg'>~A</td>" - source (activate-uris text))) - (:action - (format stream - "<td>*~A* ~A</td>" - source (activate-uris text))) - (t - (format stream "<td>~A [~A] ~A" - source user-address text) - (when object - (case type - (:quit - (format stream " [~A]" - object)) - (t - (format stream " ~A" object)))) - (write-string "</td>" stream) - )) - (write-string "</tr>" stream) - (write-char #\Newline stream)) - (:sexp - (format stream "(~W ~W ~W ~W ~W ~W)~%" utime type source text object user-address)) - (t - (format stream "~A " (format-utime utime)) - (case type - (:privmsg - (format stream "<~A> ~A" source text)) - (:action - (format stream "*~A* ~A" source text)) - (t - (format stream "[info] ~A [~A] ~A" source user-address text) - (when object - (format stream (case type - (:quit " [~A]") - (t " ~A")) - object)))) - (write-char #\Newline stream)))) - -(defun is-info-type (type) +(defun need-user-address? (type) (not (or (eq :action type) (eq :privmsg type)))) -(defun output-event-for-a-stream (msg type text object logger channel istream) +(defgeneric %output-event (format stream utime type channel source text msg unichannel)) + +(defmethod %output-event ((format t) stream utime type channel source text + msg unichannel) + (%output-event :raw stream utime type channel source text msg unichannel)) + +(defmethod %output-event ((format (eql :raw)) stream utime type channel source text + msg unichannel) + (declare (ignore unichannel)) + (format stream "~S~%" (string-right-trim '(#\return) (raw-message-string msg)))) + +(defmethod %output-event ((format (eql :sexp)) stream utime type channel source text + msg unichannel) + (if unichannel + (format stream "(~S ~S ~S ~S ~S)~%" utime type source text + (when (need-user-address? type) (user-address msg))) + (format stream "(~S ~S ~S ~S ~S ~S)~%" utime type source channel + text (when (need-user-address? type) (user-address msg))))) + +(defmethod %output-event ((format (eql :text)) stream utime type channel source text + msg unichannel) + (format stream "~A " (format-utime utime)) + (when (and (null unichannel) channel) + (format stream "[~A] " channel)) + + (let ((user-address (when (need-user-address? type) (user-address msg)))) + (case type + (:privmsg + (format stream "<~A> ~A" source text)) + (:action + (format stream "*~A* ~A" source text)) + (:join + (format stream "~A [~A] has joined ~A" source user-address channel)) + (:part + (format stream "-!- ~A [~A] has left ~A" source user-address channel)) + (:nick + (format stream "-!- ~A is now known as ~A" source text)) + (:kick + (format stream "-!- ~A [~A] has been kicked from ~A" source user-address channel)) + (:quit + (format stream "-!- ~A [~A] has quit [~A]" source user-address text)) + (:mode + (format stream "-!- ~A has set mode ~A" source text)) + (:topic + (format stream "-!- ~A changed the topic of ~A to: ~A" source channel text)) + (:notice + (format stream "-~A:~A- ~A" source channel text)) + (t + (warn "Unhandled msg type ~A." type)))) + (write-char #\Newline stream)) + +(defun output-event-for-a-stream (msg type channel text logger istream) (ensure-output-stream (received-time msg) logger channel istream) - (%output-event (get-stream channel istream) (get-format logger istream) - (received-time msg) type (source msg) text object - (when (is-info-type type) (user-address msg))) + (%output-event (get-format logger istream) (get-stream channel istream) + (received-time msg) type (name channel) (source msg) text msg + (unichannel logger)) (force-output (get-stream channel istream))) -(defun output-event (msg type text &optional object) +(defun output-event (msg type channel-name &optional text) (dolist (logger *loggers*) (case type - (:quit + ((:quit :nick) (dolist (channel (channels logger)) (dotimes (i (length (formats logger))) - (output-event-for-a-stream msg type text object logger channel i)))) + (output-event-for-a-stream msg type channel text logger i)))) (t - (let* ((channel-name (case type - (:join - (trailing-argument msg)) - (t - (car (last (arguments msg)))))) - (channel (find channel-name (the list (channels logger)) + (let* ((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)))))))) + (output-event-for-a-stream msg type channel text logger i)))))))) (defun privmsg-hook (msg) - (output-event msg :privmsg (trailing-argument msg))) + (output-event msg :privmsg (first (arguments msg)) (trailing-argument msg))) (defun action-hook (msg) - (output-event msg :action - (subseq (trailing-argument msg) - 8 + (output-event msg :action (first (arguments msg)) + (subseq (trailing-argument msg) 8 (- (length (trailing-argument msg)) 1)))) (defun nick-hook (msg) - (output-event msg :nick "is now known as" - (trailing-argument msg))) + (output-event msg :nick nil (trailing-argument msg))) (defun part-hook (msg) - (output-event msg :part "has left" - (first (arguments msg)))) + (output-event msg :part (first (arguments msg)))) (defun quit-hook (msg) - (output-event msg :quit "has quit" (trailing-argument msg))) + (output-event msg :quit (trailing-argument msg))) (defun join-hook (msg) - (output-event msg :join "has joined" - (trailing-argument msg))) + (output-event msg :join (trailing-argument msg))) (defun kick-hook (msg) - (output-event msg :kick "has been kicked from" - (first (arguments msg)))) + (output-event msg :kick (first (arguments msg)))) + +(defun notice-hook (msg) + (output-event msg :notice (first (arguments msg)) (trailing-argument msg))) + +(defun topic-hook (msg) + (output-event msg :topic (first (arguments msg)) (trailing-argument msg))) + +(defun mode-hook (msg) + (output-event msg :mode (first (arguments msg)))) (defun make-channels (names formats output) (loop for i from 0 to (1- (length names)) @@ -327,6 +302,10 @@ :current-output-names (make-array (length formats) :initial-element nil)))) +(defun is-unichannel-output (user-output) + "Returns T if output is setup for a single channel directory structure." + (and (pathnamep user-output) (null (pathname-name user-output)))) + (defun create-logger (nick server &key channels output (logging-stream t) (async t) @@ -350,7 +329,8 @@ :server server :channels (make-channels channels formats output) :user-output output - :formats formats))) + :formats formats + :unichannel (is-unichannel-output output)))) (mapc #'(lambda (channel) (join conn channel)) channels) (add-hook conn 'irc::irc-privmsg-message 'privmsg-hook) @@ -360,6 +340,9 @@ (add-hook conn 'irc::irc-quit-message 'quit-hook) (add-hook conn 'irc::irc-join-message 'join-hook) (add-hook conn 'irc::irc-kick-message 'kick-hook) + (add-hook conn 'irc::irc-mode-message 'mode-hook) + (add-hook conn 'irc::irc-topic-message 'topic-hook) + (add-hook conn 'irc::irc-notice-message 'notice-hook) (cond (async #+sbcl (add-asynchronous-message-handler conn) @@ -400,5 +383,9 @@ :async async :formats formats))) (push logger *loggers*) logger)) - +(defun add-hook-logger (logger msg hook) + (add-hook (connection logger) msg hook)) + +(defun remove-hook-logger (logger msg) + (remove-hook (connection logger) msg))

1 0

[net-nittin-irc-cvs] CVS update: Directory change: net-nittin-irc/debian
by Kevin Rosenberg 16 Dec '03

16 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/debian In directory common-lisp.net:/tmp/cvs-serv30571/debian Log Message: Directory /project/net-nittin-irc/cvsroot/net-nittin-irc/debian added to the repository Date: Tue Dec 16 16:16:55 2003 Author: krosenberg New directory net-nittin-irc/debian added

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/utility.lisp
by Kevin Rosenberg 16 Dec '03

16 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv16616 Modified Files: utility.lisp Log Message: bind *print-circle* to nil when composing irc messages Date: Tue Dec 16 15:52:40 2003 Author: krosenberg Index: net-nittin-irc/utility.lisp diff -u net-nittin-irc/utility.lisp:1.5 net-nittin-irc/utility.lisp:1.6 --- net-nittin-irc/utility.lisp:1.5 Sun Nov 23 17:39:16 2003 +++ net-nittin-irc/utility.lisp Tue Dec 16 15:52:39 2003 @@ -1,4 +1,4 @@ -;;;; $Id: utility.lisp,v 1.5 2003/11/23 22:39:16 eenge Exp $ +;;;; $Id: utility.lisp,v 1.6 2003/12/16 20:52:39 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/utility.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -53,13 +53,14 @@ (trailing-argument nil)) "Return a valid IRC message, as a string, composed of the input parameters." - (format nil "~A~{ ~A~}~A~A~A~A" command arguments - (if trailing-argument - " :" + (let ((*print-circle* nil)) + (format nil "~A~{ ~A~}~A~A~A~A" command arguments + (if trailing-argument + " :" "") - (or trailing-argument "") - #\Return - #\Linefeed)) + (or trailing-argument "") + #\Return + #\Linefeed))) (defun make-ctcp-message (string) "Return a valid IRC CTCP message, as a string, composed by

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp net-nittin-irc/package.lisp net-nittin-irc/command.lisp
by Kevin Rosenberg 16 Dec '03

16 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv32586 Modified Files: protocol.lisp package.lisp command.lisp Log Message: avoid setting symbol-functions on cl exported symbols Date: Tue Dec 16 13:57:36 2003 Author: krosenberg Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.24 net-nittin-irc/protocol.lisp:1.25 --- net-nittin-irc/protocol.lisp:1.24 Tue Dec 16 13:30:32 2003 +++ net-nittin-irc/protocol.lisp Tue Dec 16 13:57:36 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.24 2003/12/16 18:30:32 krosenberg Exp $ +;;;; $Id: protocol.lisp,v 1.25 2003/12/16 18:57:36 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -143,7 +143,7 @@ message)) (defmethod send-irc-message ((connection connection) command - trailing-argument &rest arguments) + &optional trailing-argument &rest arguments) "Turn the arguments into a valid IRC message and send it to the server, via the `connection'." (let ((raw-message (make-irc-message command @@ -186,7 +186,7 @@ user at this end can be reached via your normal connection object.") (stream :initarg :stream - :accessor stream) + :accessor dcc-stream) (output-stream :initarg :output-stream :accessor output-stream @@ -223,7 +223,7 @@ (warn "make-dcc-connection not supported for this implementation.")) (defmethod read-message ((connection dcc-connection)) - (let ((message (read-line (stream connection)))) + (let ((message (read-line (dcc-stream connection)))) (format (output-stream connection) "~A~%" message) (force-output (output-stream connection)) message)) @@ -232,19 +232,19 @@ (loop while (read-message connection))) (defmethod send-dcc-message ((connection dcc-connection) message) - (format (stream connection) "~A~%" message)) + (format (dcc-stream connection) "~A~%" message)) ;; argh. I want to name this quit but that gives me issues with ;; generic functions. need to resolve. (defmethod dcc-close ((connection dcc-connection)) - (close (stream connection)) + (close (dcc-stream connection)) (setf (user connection) nil) (setf *dcc-connections* (remove connection *dcc-connections*)) #+sbcl (sb-bsd-sockets:socket-close (socket connection)) ) (defmethod connectedp ((connection dcc-connection)) - (let ((stream (stream connection))) + (let ((stream (dcc-stream connection))) (and (streamp stream) (open-stream-p stream)))) Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.11 net-nittin-irc/package.lisp:1.12 --- net-nittin-irc/package.lisp:1.11 Mon Nov 24 22:35:55 2003 +++ net-nittin-irc/package.lisp Tue Dec 16 13:57:36 2003 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.11 2003/11/25 03:35:55 eenge Exp $ +;;;; $Id: package.lisp,v 1.12 2003/12/16 18:57:36 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -100,7 +100,7 @@ :away :rehash :die - :restart + :restart- :summon :users- :wallops Index: net-nittin-irc/command.lisp diff -u net-nittin-irc/command.lisp:1.9 net-nittin-irc/command.lisp:1.10 --- net-nittin-irc/command.lisp:1.9 Tue Dec 16 13:30:32 2003 +++ net-nittin-irc/command.lisp Tue Dec 16 13:57:36 2003 @@ -1,4 +1,4 @@ -;;;; $Id: command.lisp,v 1.9 2003/12/16 18:30:32 krosenberg Exp $ +;;;; $Id: command.lisp,v 1.10 2003/12/16 18:57:36 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/command.lisp,v $ ;;;; See LICENSE for licensing information. @@ -274,7 +274,7 @@ (defmethod die ((connection connection)) (send-irc-message connection :die)) -(defmethod restart ((connection connection)) +(defmethod restart- ((connection connection)) (send-irc-message connection :restart)) (defmethod summon ((connection connection) (nickname string)

1 0