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

[net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp
by Kevin Rosenberg 04 Jan '04

04 Jan '04

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv12417 Modified Files: protocol.lisp Log Message: add more messages Date: Sun Jan 4 06:22:51 2004 Author: krosenberg Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.34 net-nittin-irc/protocol.lisp:1.35 --- net-nittin-irc/protocol.lisp:1.34 Thu Jan 1 14:46:17 2004 +++ net-nittin-irc/protocol.lisp Sun Jan 4 06:22:50 2004 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.34 2004/01/01 19:46:17 krosenberg Exp $ +;;;; $Id: protocol.lisp,v 1.35 2004/01/04 11:22:50 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -537,7 +537,7 @@ (create-irc-message-classes (mapcar #'second *reply-names*)) (create-irc-message-classes '(:privmsg :notice :kick :topic :error :mode :ping :nick :join :part :quit :kill - :pong)) + :pong :invite)) (defmethod find-irc-message-class (type) (find-class 'irc-message))

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/event.lisp net-nittin-irc/protocol.lisp
by Kevin Rosenberg 01 Jan '04

01 Jan '04

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv8257 Modified Files: event.lisp protocol.lisp Log Message: add :kill, :error, and :pong message classes Date: Thu Jan 1 14:46:17 2004 Author: krosenberg Index: net-nittin-irc/event.lisp diff -u net-nittin-irc/event.lisp:1.14 net-nittin-irc/event.lisp:1.15 --- net-nittin-irc/event.lisp:1.14 Tue Nov 25 08:04:33 2003 +++ net-nittin-irc/event.lisp Thu Jan 1 14:46:17 2004 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.14 2003/11/25 13:04:33 eenge Exp $ +;;;; $Id: event.lisp,v 1.15 2004/01/01 19:46:17 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/event.lisp,v $ ;;;; See LICENSE for licensing information. @@ -12,7 +12,7 @@ (defmethod irc-message-event ((message irc-message)) (apply-to-hooks message) - (client-log (connection message) message "UNHANLDED-EVENT:")) + (client-log (connection message) message "UNHANDLED-EVENT:")) (defmethod default-hook ((message irc-rpl_whoisuser-message)) (let ((user (find-user (connection message) Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.33 net-nittin-irc/protocol.lisp:1.34 --- net-nittin-irc/protocol.lisp:1.33 Thu Jan 1 03:09:15 2004 +++ net-nittin-irc/protocol.lisp Thu Jan 1 14:46:17 2004 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.33 2004/01/01 08:09:15 krosenberg Exp $ +;;;; $Id: protocol.lisp,v 1.34 2004/01/01 19:46:17 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -536,7 +536,8 @@ ;; should perhaps wrap this in an eval-when? (create-irc-message-classes (mapcar #'second *reply-names*)) (create-irc-message-classes '(:privmsg :notice :kick :topic :error - :mode :ping :nick :join :part :quit)) + :mode :ping :nick :join :part :quit :kill + :pong)) (defmethod find-irc-message-class (type) (find-class 'irc-message))

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp
by Kevin Rosenberg 01 Jan '04

01 Jan '04

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv25153 Modified Files: protocol.lisp Log Message: separate out start-process for use in programs using cl-irc library Date: Thu Jan 1 03:09:15 2004 Author: krosenberg Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.32 net-nittin-irc/protocol.lisp:1.33 --- net-nittin-irc/protocol.lisp:1.32 Thu Dec 18 14:43:08 2003 +++ net-nittin-irc/protocol.lisp Thu Jan 1 03:09:15 2004 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.32 2003/12/18 19:43:08 krosenberg Exp $ +;;;; $Id: protocol.lisp,v 1.33 2004/01/01 08:09:15 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -121,15 +121,20 @@ (stream-error () (setf read-more-p nil))))) (defvar *process-count* 0) + +(defmethod start-process (function name) + #+allegro (mp:process-run-function name function) + #+cmu (mp:make-process function :name name) + #+lispworks (mp:process-run-function name nil function) + #+sb-thread (sb-thread:make-thread function)) + (defmethod start-background-message-handler ((connection connection)) "Read messages from the `connection', parse them and dispatch irc-message-event on them. Returns background process ID if available." (flet ((do-loop () (read-message-loop connection))) (let ((name (format nil "irc-hander-~D" (incf *process-count*)))) - #+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) - #+sb-thread (sb-thread:make-thread #'do-loop) + #+(or allegro cmu lispworks sb-thread) + (start-process #'do-loop name) #+(and sbcl (not sb-thread)) (sb-sys:add-fd-handler (sb-bsd-sockets:socket-file-descriptor (server-socket connection))

1 0

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

18 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv17171 Modified Files: protocol.lisp Log Message: fix typo in function name Date: Thu Dec 18 14:43:09 2003 Author: krosenberg Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.31 net-nittin-irc/protocol.lisp:1.32 --- net-nittin-irc/protocol.lisp:1.31 Thu Dec 18 14:28:29 2003 +++ net-nittin-irc/protocol.lisp Thu Dec 18 14:43:08 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.31 2003/12/18 19:28:29 krosenberg Exp $ +;;;; $Id: protocol.lisp,v 1.32 2003/12/18 19:43:08 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -137,7 +137,7 @@ (declare (ignore fd)) (read-message connection)))))) -(defun stop-backgound-message-handler (process) +(defun stop-background-message-handler (process) "Stops a background message handler process returned by the start function." #+cmu (mp:destroy-process process) #+allegro (mp:process-kill process)

1 0

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

18 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv8388 Modified Files: package.lisp protocol.lisp Log Message: add stop-background-message-handler function Date: Thu Dec 18 14:28:30 2003 Author: krosenberg Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.15 net-nittin-irc/package.lisp:1.16 --- net-nittin-irc/package.lisp:1.15 Tue Dec 16 18:27:25 2003 +++ net-nittin-irc/package.lisp Thu Dec 18 14:28:28 2003 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.15 2003/12/16 23:27:25 krosenberg Exp $ +;;;; $Id: package.lisp,v 1.16 2003/12/18 19:28:28 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -13,6 +13,7 @@ (:export :read-message-loop :read-message :start-background-message-handler + :stop-background-message-handler :send-message :server-name :no-such-reply Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.30 net-nittin-irc/protocol.lisp:1.31 --- net-nittin-irc/protocol.lisp:1.30 Tue Dec 16 18:32:26 2003 +++ net-nittin-irc/protocol.lisp Thu Dec 18 14:28:29 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.30 2003/12/16 23:32:26 krosenberg Exp $ +;;;; $Id: protocol.lisp,v 1.31 2003/12/18 19:28:29 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -123,7 +123,7 @@ (defvar *process-count* 0) (defmethod start-background-message-handler ((connection connection)) "Read messages from the `connection', parse them and dispatch -irc-message-event on them." +irc-message-event on them. Returns background process ID if available." (flet ((do-loop () (read-message-loop connection))) (let ((name (format nil "irc-hander-~D" (incf *process-count*)))) #+allegro (mp:process-run-function name #'do-loop) @@ -136,6 +136,13 @@ :input (lambda (fd) (declare (ignore fd)) (read-message connection)))))) + +(defun stop-backgound-message-handler (process) + "Stops a background message handler process returned by the start function." + #+cmu (mp:destroy-process process) + #+allegro (mp:process-kill process) + #+sb-thread (sb-thread:destroy-thread process) + #+lispworks (mp:process-kill process)) (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 18 Dec '03

18 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/example In directory common-lisp.net:/tmp/cvs-serv31020 Modified Files: cliki.lisp Log Message: s-b-m-h instead of a-a-m-h Date: Wed Dec 17 20:46:00 2003 Author: bmastenbrook Index: net-nittin-irc/example/cliki.lisp diff -u net-nittin-irc/example/cliki.lisp:1.8 net-nittin-irc/example/cliki.lisp:1.9 --- net-nittin-irc/example/cliki.lisp:1.8 Tue Dec 16 18:18:01 2003 +++ net-nittin-irc/example/cliki.lisp Wed Dec 17 20:46:00 2003 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.8 2003/12/16 23:18:01 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.9 2003/12/18 01:46:00 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. @@ -182,7 +182,7 @@ (mapcar #'(lambda (channel) (join *cliki-connection* channel)) channels) (add-hook *cliki-connection* 'irc::irc-privmsg-message 'msg-hook) (add-hook *cliki-connection* 'irc::irc-notice-message 'notice-hook) - #+sbcl (add-asynchronous-message-handler *cliki-connection*) + #+sbcl (start-background-message-handler *cliki-connection*) #-sbcl (read-message-loop *cliki-connection*)) (defun shuffle-hooks ()

1 0

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

18 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/example In directory common-lisp.net:/tmp/cvs-serv30814 Modified Files: clhs.lisp Log Message: Multiple attention prefixes, s-b-m-h instead of a-a-m-h, misc. changes Date: Wed Dec 17 20:45:39 2003 Author: bmastenbrook Index: net-nittin-irc/example/clhs.lisp diff -u net-nittin-irc/example/clhs.lisp:1.3 net-nittin-irc/example/clhs.lisp:1.4 --- net-nittin-irc/example/clhs.lisp:1.3 Mon Nov 17 09:04:28 2003 +++ net-nittin-irc/example/clhs.lisp Wed Dec 17 20:45:39 2003 @@ -1,4 +1,4 @@ -;;;; $Id: clhs.lisp,v 1.3 2003/11/17 14:04:28 bmastenbrook Exp $ +;;;; $Id: clhs.lisp,v 1.4 2003/12/18 01:45:39 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/example/clhs.lisp,v $ ;;;; clhs.lisp - an example IRC bot for net-nittin-irc @@ -20,7 +20,7 @@ (in-package :clhs) ;;; CLHS. This will be the default lookup. -(defparameter *hyperspec-pathname* #p"/home/chandler/public_html/HyperSpec/") +(defparameter *hyperspec-pathname* #p"/Users/chandler/Sites/HyperSpec/") (defparameter *hyperspec-map-file* (merge-pathnames "Data/Map_Sym.txt" *hyperspec-pathname*)) @@ -31,7 +31,7 @@ (defparameter *mop-root* "http://www.alu.org/mop/") -(defparameter *table* (make-hash-table :test 'equalp)) +(defvar *table* (make-hash-table :test 'equalp)) (defun add-clhs-section-to-table (&rest numbers) (let ((key (format nil "~{~d~^.~}" numbers)) @@ -142,30 +142,34 @@ it (format nil "Nothing was found for: ~A" str))) -(defparameter *clhs-attention-prefix* "clhs ") +(defparameter *clhs-attention-prefixes* '("clhs " "clhs: ")) + +(defun valid-clhs-message-1 (message prefix) + (if (eql (search prefix (trailing-argument message) :test #'char-equal) 0) + (and (not (find #\space (trailing-argument message) :start (length prefix))) + (length prefix)) + nil)) (defun valid-clhs-message (message) - (if (eql (search *clhs-attention-prefix* (trailing-argument message) :test #'char-equal) 0) - (not (find #\space (trailing-argument message) :start (length *clhs-attention-prefix*))) - nil)) + (some #'(lambda (e) (valid-clhs-message-1 message e)) *clhs-attention-prefixes*)) (defun msg-hook (message) (if (string-equal (first (arguments message)) *clhs-nickname*) - (if (valid-clhs-message message) - (privmsg *clhs-connection* (source message) (spec-lookup (subseq (trailing-argument message) (length *clhs-attention-prefix*)))) + (aif (valid-clhs-message message) + (privmsg *clhs-connection* (source message) (spec-lookup (subseq (trailing-argument message) it))) (privmsg *clhs-connection* (source message) (spec-lookup (trailing-argument message)))) - (if (valid-clhs-message message) - (privmsg *clhs-connection* (first (arguments message)) (spec-lookup (subseq (trailing-argument message) (length *clhs-attention-prefix*))))))) + (aif (valid-clhs-message message) + (privmsg *clhs-connection* (first (arguments message)) (spec-lookup (subseq (trailing-argument message) it)))))) (defun start-clhs-bot (nick server &rest channels) (populate-table) (setf *clhs-nickname* nick) (setf *clhs-connection* (connect :nickname *clhs-nickname* :server server)) (mapcar #'(lambda (channel) (join *clhs-connection* channel)) channels) - (add-hook *clhs-connection* 'irc::irc-privmsg-message #'msg-hook) - #+sbcl (add-asynchronous-message-handler *clhs-connection*) + (add-hook *clhs-connection* 'irc::irc-privmsg-message 'msg-hook) + #+sbcl (start-background-message-handler *clhs-connection*) #-sbcl (read-message-loop *clhs-connection*)) (defun shuffle-hooks () (irc::remove-hooks *clhs-connection* 'irc::irc-privmsg-message) - (add-hook *clhs-connection* 'irc::irc-privmsg-message #'msg-hook)) + (add-hook *clhs-connection* 'irc::irc-privmsg-message 'msg-hook))

1 0

[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-serv26938 Modified Files: protocol.lisp Log Message: fix typo Date: Tue Dec 16 18:32:26 2003 Author: krosenberg Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.29 net-nittin-irc/protocol.lisp:1.30 --- net-nittin-irc/protocol.lisp:1.29 Tue Dec 16 18:31:17 2003 +++ net-nittin-irc/protocol.lisp Tue Dec 16 18:32:26 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.29 2003/12/16 23:31:17 krosenberg Exp $ +;;;; $Id: protocol.lisp,v 1.30 2003/12/16 23:32:26 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -130,7 +130,7 @@ #+cmu (mp:make-process #'do-loop :name name) #+lispworks (mp:process-run-function name nil #'do-loop) #+sb-thread (sb-thread:make-thread #'do-loop) - #+(and sbcl (not sbcl-thread)) + #+(and sbcl (not sb-thread)) (sb-sys:add-fd-handler (sb-bsd-sockets:socket-file-descriptor (server-socket connection)) :input (lambda (fd)

1 0

[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-serv26733 Modified Files: protocol.lisp Log Message: fix typo Date: Tue Dec 16 18:31:17 2003 Author: krosenberg Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.28 net-nittin-irc/protocol.lisp:1.29 --- net-nittin-irc/protocol.lisp:1.28 Tue Dec 16 18:27:25 2003 +++ net-nittin-irc/protocol.lisp Tue Dec 16 18:31:17 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.28 2003/12/16 23:27:25 krosenberg Exp $ +;;;; $Id: protocol.lisp,v 1.29 2003/12/16 23:31:17 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -129,7 +129,7 @@ #+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) + #+sb-thread (sb-thread:make-thread #'do-loop) #+(and sbcl (not sbcl-thread)) (sb-sys:add-fd-handler (sb-bsd-sockets:socket-file-descriptor (server-socket connection))

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-serv24683 Modified Files: package.lisp protocol.lisp Log Message: remove read-message-loop-background, subsume add-asynchronous-message-handler Date: Tue Dec 16 18:27:25 2003 Author: krosenberg Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.14 net-nittin-irc/package.lisp:1.15 --- net-nittin-irc/package.lisp:1.14 Tue Dec 16 17:45:54 2003 +++ net-nittin-irc/package.lisp Tue Dec 16 18:27:25 2003 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.14 2003/12/16 22:45:54 krosenberg Exp $ +;;;; $Id: package.lisp,v 1.15 2003/12/16 23:27:25 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -12,8 +12,7 @@ (:nicknames :irc :cl-irc) (:export :read-message-loop :read-message - :read-message-loop-background - :add-asynchronous-message-handler + :start-background-message-handler :send-message :server-name :no-such-reply Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.27 net-nittin-irc/protocol.lisp:1.28 --- net-nittin-irc/protocol.lisp:1.27 Tue Dec 16 18:21:56 2003 +++ net-nittin-irc/protocol.lisp Tue Dec 16 18:27:25 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.27 2003/12/16 23:21:56 krosenberg Exp $ +;;;; $Id: protocol.lisp,v 1.28 2003/12/16 23:27:25 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -107,16 +107,6 @@ (let ((stream (server-stream connection))) (and (streamp stream) (open-stream-p stream)))) - -(defmethod add-asynchronous-message-handler ((connection connection)) - #+sbcl - (sb-sys:add-fd-handler (sb-bsd-sockets:socket-file-descriptor - (server-socket connection)) - :input (lambda (fd) - (declare (ignore fd)) - (read-message connection))) - #-sbcl - (error "add-asynchronous-message-handler is not supported now on non-SBCL")) (defmethod read-message ((connection connection)) (let ((read-more-p t)) @@ -130,18 +120,22 @@ message))) ; needed because of the "loop while" in read-message-loop (stream-error () (setf read-more-p nil))))) -(defvar *background-count* 0) -(defmethod read-message-loop-background ((connection connection)) +(defvar *process-count* 0) +(defmethod start-background-message-handler ((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*)))) + (let ((name (format nil "irc-hander-~D" (incf *process-count*)))) #+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)))) + #+(and sbcl (not sbcl-thread)) + (sb-sys:add-fd-handler (sb-bsd-sockets:socket-file-descriptor + (server-socket connection)) + :input (lambda (fd) + (declare (ignore fd)) + (read-message connection)))))) (defmethod read-message-loop ((connection connection)) (loop while (read-message connection)))

1 0