March 2005 - cl-irc-cvs@common-lisp.net - mailman3.common-lisp.net

[Cl-irc-cvs] CVS update: cl-irc/protocol.lisp cl-irc/event.lisp
by ehuelsmann＠common-lisp.net 27 Mar '05

27 Mar '05

Update of /project/cl-irc/cvsroot/cl-irc In directory common-lisp.net:/tmp/cvs-serv25096 Modified Files: protocol.lisp event.lisp Log Message: Extend mode tracking: Handle response to a MODE request on a channel Date: Sun Mar 27 23:40:31 2005 Author: ehuelsmann Index: cl-irc/protocol.lisp diff -u cl-irc/protocol.lisp:1.21 cl-irc/protocol.lisp:1.22 --- cl-irc/protocol.lisp:1.21 Sun Mar 27 22:27:18 2005 +++ cl-irc/protocol.lisp Sun Mar 27 23:40:30 2005 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.21 2005/03/27 20:27:18 ehuelsmann Exp $ +;;;; $Id: protocol.lisp,v 1.22 2005/03/27 21:40:30 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -220,6 +220,7 @@ irc-kick-message irc-nick-message irc-mode-message + irc-rpl_channelmodeis-message ctcp-time-message ctcp-source-message ctcp-finger-message Index: cl-irc/event.lisp diff -u cl-irc/event.lisp:1.8 cl-irc/event.lisp:1.9 --- cl-irc/event.lisp:1.8 Sun Mar 27 22:27:18 2005 +++ cl-irc/event.lisp Sun Mar 27 23:40:30 2005 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.8 2005/03/27 20:27:18 ehuelsmann Exp $ +;;;; $Id: event.lisp,v 1.9 2005/03/27 21:40:30 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $ ;;;; See LICENSE for licensing information. @@ -185,6 +185,27 @@ (defmethod default-hook ((message irc-quit-message)) (let ((connection (connection message))) (remove-user-everywhere connection (find-user connection (source message))))) + +(defmethod default-hook ((message irc-rpl_channelmodeis-message)) + (destructuring-bind + (target &rest arguments) + ;; ignore the my own nick which is the first message argument + (rest (arguments message)) + (let* ((connection (connection message)) + (target (find-channel connection target)) + (mode-changes + (when target + (parse-mode-arguments connection target arguments + :server-p (user connection))))) + (dolist (change mode-changes) + (destructuring-bind + (op mode-name value) + change + (unless (has-mode-p target mode-name) + (add-mode target mode-name + (make-mode connection target mode-name))) + (funcall (if (char= #\+ op) #'set-mode #'unset-mode) + target mode-name value)))))) (defmethod default-hook ((message irc-mode-message)) (destructuring-bind

1 0

[Cl-irc-cvs] CVS update: cl-irc/protocol.lisp cl-irc/event.lisp
by ehuelsmann＠common-lisp.net 27 Mar '05

27 Mar '05

Update of /project/cl-irc/cvsroot/cl-irc In directory common-lisp.net:/tmp/cvs-serv20592 Modified Files: protocol.lisp event.lisp Log Message: Extend mode tracking: set absolute mode values for ban, except and invite lists. * event.lisp (generate-maskmode-hooks): New. Macro to define hooks for ban, except and invitelist messages and their endlist companions. (): Use generate-maskmode-hooks to generate hooks for ban, except and invite list messages. (default-hook [irc-rpl_namreply-message]): Register which users were sent in the namreply list. (default-hook [irc-rpl_endofnames-message]): Remove users which were not in the namreply-list. Before, only missing users were added, now spurious ones will be deleted too. * protocol.lisp (add-default-hooks): Add hooks for new messages. Date: Sun Mar 27 22:27:18 2005 Author: ehuelsmann Index: cl-irc/protocol.lisp diff -u cl-irc/protocol.lisp:1.20 cl-irc/protocol.lisp:1.21 --- cl-irc/protocol.lisp:1.20 Mon Mar 21 23:32:35 2005 +++ cl-irc/protocol.lisp Sun Mar 27 22:27:18 2005 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.20 2005/03/21 22:32:35 ehuelsmann Exp $ +;;;; $Id: protocol.lisp,v 1.21 2005/03/27 20:27:18 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -202,9 +202,16 @@ (defmethod add-default-hooks ((connection connection)) (dolist (message '(irc-rpl_isupport-message irc-rpl_whoisuser-message + irc-rpl_banlist-message + irc-rpl_endofbanlist-message + irc-rpl_exceptlist-message + irc-rpl_endofexceptlist-message + irc-rpl_invitelist-message + irc-rpl_endofinvitelist-message irc-rpl_list-message irc-rpl_topic-message irc-rpl_namreply-message + irc-rpl_endofnames-message irc-ping-message irc-join-message irc-topic-message Index: cl-irc/event.lisp diff -u cl-irc/event.lisp:1.7 cl-irc/event.lisp:1.8 --- cl-irc/event.lisp:1.7 Sun Mar 20 17:55:36 2005 +++ cl-irc/event.lisp Sun Mar 27 22:27:18 2005 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.7 2005/03/20 16:55:36 ehuelsmann Exp $ +;;;; $Id: event.lisp,v 1.8 2005/03/27 20:27:18 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $ ;;;; See LICENSE for licensing information. @@ -20,6 +20,47 @@ of the IRC message to keep the connection, channel and user objects in sync.")) +(defmacro generate-maskmode-hooks (listmsg-class endmsg-class + tmp-symbol mode-symbol) + `(progn + (defmethod default-hook ((message ,listmsg-class)) + (destructuring-bind + (target channel-name mask set-by time-set) + (arguments message) + (declare (ignore target set-by time-set)) + ;; note: the structure currently does not allow for logging + ;; set-by and time-set: the MODE message handling currently + ;; does not allow that. + (let ((channel (find-channel (connection message) channel-name))) + (when channel + (unless (has-mode-p channel ',tmp-symbol) + ;; start with a new list, replacing the old value later + (add-mode channel ',tmp-symbol + (make-instance 'list-value-mode + :value-type :non-user))) + ;; use package-local symbol to prevent conflicts + (set-mode channel ',tmp-symbol mask))))) + + (defmethod default-hook ((message ,endmsg-class)) + (let ((channel (find-channel (connection message) + (car (arguments message))))) + (when channel + (let ((mode (has-mode-p channel ',tmp-symbol))) + (when mode + ;; replace list + (add-mode channel ',mode-symbol mode) + (remove-mode channel ',tmp-symbol)))))))) + +(generate-maskmode-hooks irc-rpl_banlist-message + irc-rpl_endofbanlist-message + banlist-in-progress :ban) +(generate-maskmode-hooks irc-rpl_exceptlist-message + irc-rpl_endofexceptlist-message + exceptlist-in-progress :except) +(generate-maskmode-hooks irc-rpl_invitelist-message + irc-rpl_endofinvitelist-message + invitelist-in-progress :invite) + (defmethod default-hook ((message irc-rpl_isupport-message)) (let* ((capabilities (cdr (arguments message))) (connection (connection message)) @@ -72,13 +113,17 @@ (defmethod default-hook ((message irc-rpl_namreply-message)) (let* ((connection (connection message)) (channel (find-channel connection (car (last (arguments message)))))) + (unless (has-mode-p channel 'namreply-in-progress) + (add-mode channel 'namreply-in-progress + (make-instance 'list-value-mode :value-type :user))) (dolist (nickname (tokenize-string (trailing-argument message))) (let ((user (find-or-make-user connection (canonicalize-nickname connection nickname)))) (unless (equal user (user connection)) (add-user connection user) - (add-user channel user)) + (add-user channel user) + (set-mode channel 'namreply-in-progress user)) (let* ((mode-char (getf (nick-prefixes connection) (elt nickname 0))) (mode-name (when mode-char @@ -91,6 +136,19 @@ (make-mode connection channel mode-name)) user)))))))) + +(defmethod default-hook ((message irc-rpl_endofnames-message)) + (let* ((channel (find-channel (connection message) + (second (arguments message)))) + (mode (get-mode channel 'namreply-in-progress)) + (channel-users)) + (remove-mode channel 'namreply-in-progress) + (maphash #'(lambda (nick user-obj) + (declare (ignore nick)) + (pushnew user-obj channel-users)) (users channel)) + (dolist (user (remove-if #'(lambda (x) + (member x mode)) channel-users)) + (remove-user channel user)))) (defmethod default-hook ((message irc-ping-message)) (pong (connection message) (trailing-argument message)))

1 0

[Cl-irc-cvs] CVS update: cl-irc/variable.lisp
by ehuelsmann＠common-lisp.net 27 Mar '05

27 Mar '05

Update of /project/cl-irc/cvsroot/cl-irc In directory common-lisp.net:/tmp/cvs-serv17080 Modified Files: variable.lisp Log Message: Rename 2 modes. They go by the names 'except' and 'invite' in the protocol. Date: Sun Mar 27 21:21:29 2005 Author: ehuelsmann Index: cl-irc/variable.lisp diff -u cl-irc/variable.lisp:1.5 cl-irc/variable.lisp:1.6 --- cl-irc/variable.lisp:1.5 Sun Mar 20 17:55:36 2005 +++ cl-irc/variable.lisp Sun Mar 27 21:21:28 2005 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.5 2005/03/20 16:55:36 ehuelsmann Exp $ +;;;; $Id: variable.lisp,v 1.6 2005/03/27 19:21:28 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -74,8 +74,8 @@ (#\l . :limit) (#\k . :key) (#\b . :ban) - (#\e . :ban-except) - (#\I . :invite-except))) + (#\e . :except) + (#\I . :invite))) (defparameter *char-to-user-modes-map* '((#\a . :away)

1 0

[Cl-irc-cvs] CVS update: public_html/index.html
by ehuelsmann＠common-lisp.net 24 Mar '05

24 Mar '05

Update of /project/cl-irc/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv9544 Modified Files: index.html Log Message: Update site with latest releases. Date: Fri Mar 25 00:26:42 2005 Author: ehuelsmann Index: public_html/index.html diff -u public_html/index.html:1.2 public_html/index.html:1.3 --- public_html/index.html:1.2 Mon Jan 5 15:22:39 2004 +++ public_html/index.html Fri Mar 25 00:26:42 2005 @@ -5,7 +5,7 @@ <body> <div class="header"> - <h1>cl-irc 0.5.0</h1> + <h1>cl-irc 0.7.0</h1> </div> <div class="body"> @@ -27,6 +27,8 @@ <h2>News</h2> <div class="level"> + <li>Version 0.7.0 released (RPL_ISUPPORT, many small tweaks and fixes)</li> + <li>Version 0.6.0 released (interim release while common-lisp.net was down)</li> <li>Version 0.5.0 released (package rename and minor changes)</li> <li>Version 0.4.0 released (some documentation, beginnings of a test suite, better performance)</li> </div>

1 0

[Cl-irc-cvs] CVS update: cl-irc/protocol.lisp cl-irc/package.lisp
by ehuelsmann＠common-lisp.net 21 Mar '05

21 Mar '05

Update of /project/cl-irc/cvsroot/cl-irc In directory common-lisp.net:/tmp/cvs-serv16287 Modified Files: protocol.lisp package.lisp Log Message: Cleanup. * package.lisp: Remove exported but undefined symbols. * protocol.lisp: Remove deprecated method. Date: Mon Mar 21 23:32:35 2005 Author: ehuelsmann Index: cl-irc/protocol.lisp diff -u cl-irc/protocol.lisp:1.19 cl-irc/protocol.lisp:1.20 --- cl-irc/protocol.lisp:1.19 Mon Mar 21 20:41:42 2005 +++ cl-irc/protocol.lisp Mon Mar 21 23:32:35 2005 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.19 2005/03/21 19:41:42 ehuelsmann Exp $ +;;;; $Id: protocol.lisp,v 1.20 2005/03/21 22:32:35 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -749,14 +749,6 @@ (do-property-list (prop val (modes channel)) (when (and val (eq (value-type val) :user)) (unset-mode channel prop user)))) - -(defmethod remove-channel ((channel channel) (user user)) - "Remove `channel' from `user'." - (warn - (concatenate 'string - "use of depricated API (remove-channel channel user): " - "(remove-channel user channel) is now preferred")) - (remove-channel user channel)) (defmethod remove-channel ((user user) (channel channel)) "Remove `channel' from `user'." Index: cl-irc/package.lisp diff -u cl-irc/package.lisp:1.6 cl-irc/package.lisp:1.7 --- cl-irc/package.lisp:1.6 Sun Mar 20 17:55:36 2005 +++ cl-irc/package.lisp Mon Mar 21 23:32:35 2005 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.6 2005/03/20 16:55:36 ehuelsmann Exp $ +;;;; $Id: package.lisp,v 1.7 2005/03/21 22:32:35 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -15,7 +15,6 @@ :start-background-message-handler :stop-background-message-handler :socket-connect - :send-message :server-name :no-such-reply :irc-mode @@ -41,9 +40,6 @@ :server-stream :client-stream :channels - :configuration - :dangling-users - :channel-list :add-hook :remove-hook :remove-hooks

1 0

[Cl-irc-cvs] CVS update: cl-irc/protocol.lisp
by ehuelsmann＠common-lisp.net 21 Mar '05

21 Mar '05

Update of /project/cl-irc/cvsroot/cl-irc In directory common-lisp.net:/tmp/cvs-serv6182 Modified Files: protocol.lisp Log Message: Don't apply 'key' to 'value'. Date: Mon Mar 21 20:41:42 2005 Author: ehuelsmann Index: cl-irc/protocol.lisp diff -u cl-irc/protocol.lisp:1.18 cl-irc/protocol.lisp:1.19 --- cl-irc/protocol.lisp:1.18 Mon Mar 21 19:14:32 2005 +++ cl-irc/protocol.lisp Mon Mar 21 20:41:42 2005 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.18 2005/03/21 18:14:32 ehuelsmann Exp $ +;;;; $Id: protocol.lisp,v 1.19 2005/03/21 19:41:42 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -77,8 +77,8 @@ (defmethod has-value-p ((mode single-value-mode) value &key (key #'identity) (test #'equal)) (funcall test - (funcall key (value mode)) - (funcall key value))) + value + (funcall key (value mode)))) ;; mode class for holding lists of values

1 0

[Cl-irc-cvs] CVS update: cl-irc/parse-message.lisp
by ehuelsmann＠common-lisp.net 21 Mar '05

21 Mar '05

Update of /project/cl-irc/cvsroot/cl-irc In directory common-lisp.net:/tmp/cvs-serv1647 Modified Files: parse-message.lisp Log Message: Revert accidental commit. Date: Mon Mar 21 19:15:52 2005 Author: ehuelsmann Index: cl-irc/parse-message.lisp diff -u cl-irc/parse-message.lisp:1.5 cl-irc/parse-message.lisp:1.6 --- cl-irc/parse-message.lisp:1.5 Mon Mar 21 19:14:32 2005 +++ cl-irc/parse-message.lisp Mon Mar 21 19:15:52 2005 @@ -1,4 +1,4 @@ -;;;; $Id: parse-message.lisp,v 1.5 2005/03/21 18:14:32 ehuelsmann Exp $ +;;;; $Id: parse-message.lisp,v 1.6 2005/03/21 18:15:52 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/parse-message.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -151,12 +151,12 @@ (ctcp (ctcp-message-type trailing-argument))) (when command (cond -;; (nil ;(irc-error-reply-p command) -;; ;; Disable for now, as it prevents adding hooks for some useful -;; ;; error types -;; (progn -;; (setf command (find-reply-name (parse-integer command))) -;; (setf class 'irc-error-reply))) + (nil ;(irc-error-reply-p command) + ;; Disable for now, as it prevents adding hooks for some useful + ;; error types + (progn + (setf command (find-reply-name (parse-integer command))) + (setf class 'irc-error-reply))) ((numeric-reply-p command) (progn (setf command (find-reply-name (parse-integer command)))

1 0

[Cl-irc-cvs] CVS update: cl-irc/parse-message.lisp cl-irc/protocol.lisp cl-irc/utility.lisp
by ehuelsmann＠common-lisp.net 21 Mar '05

21 Mar '05

Update of /project/cl-irc/cvsroot/cl-irc In directory common-lisp.net:/tmp/cvs-serv1050 Modified Files: parse-message.lisp protocol.lisp utility.lisp Log Message: Explicitly use a boolean-value-mode class instead of hiding the same behaviour in single-value-mode. Date: Mon Mar 21 19:14:33 2005 Author: ehuelsmann Index: cl-irc/parse-message.lisp diff -u cl-irc/parse-message.lisp:1.4 cl-irc/parse-message.lisp:1.5 --- cl-irc/parse-message.lisp:1.4 Sat Jan 1 15:25:17 2005 +++ cl-irc/parse-message.lisp Mon Mar 21 19:14:32 2005 @@ -1,4 +1,4 @@ -;;;; $Id: parse-message.lisp,v 1.4 2005/01/01 14:25:17 ehuelsmann Exp $ +;;;; $Id: parse-message.lisp,v 1.5 2005/03/21 18:14:32 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/parse-message.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -151,12 +151,12 @@ (ctcp (ctcp-message-type trailing-argument))) (when command (cond - (nil ;(irc-error-reply-p command) - ;; Disable for now, as it prevents adding hooks for some useful - ;; error types - (progn - (setf command (find-reply-name (parse-integer command))) - (setf class 'irc-error-reply))) +;; (nil ;(irc-error-reply-p command) +;; ;; Disable for now, as it prevents adding hooks for some useful +;; ;; error types +;; (progn +;; (setf command (find-reply-name (parse-integer command))) +;; (setf class 'irc-error-reply))) ((numeric-reply-p command) (progn (setf command (find-reply-name (parse-integer command))) Index: cl-irc/protocol.lisp diff -u cl-irc/protocol.lisp:1.17 cl-irc/protocol.lisp:1.18 --- cl-irc/protocol.lisp:1.17 Sun Mar 20 17:55:36 2005 +++ cl-irc/protocol.lisp Mon Mar 21 19:14:32 2005 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.17 2005/03/20 16:55:36 ehuelsmann Exp $ +;;;; $Id: protocol.lisp,v 1.18 2005/03/21 18:14:32 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -45,12 +45,29 @@ (setf (value mode) nil)) +;; mode class for holding boolean values + +(defclass boolean-value-mode (irc-mode) ()) + +(defmethod set-mode-value ((mode boolean-value-mode) value) + (declare (ignore value)) + (setf (value mode) t)) + +(defmethod unset-mode-value ((mode boolean-value-mode) value) + (declare (ignore value)) + (setf (value mode) nil)) + +(defmethod has-value-p ((mode boolean-value-mode) value + &key key test) + (declare (ignore value key test)) + (value mode)) + ;; mode class for holding single values (defclass single-value-mode (irc-mode) ()) (defmethod set-mode-value ((mode single-value-mode) value) - (setf (value mode) (or value t))) + (setf (value mode) value)) (defmethod unset-mode-value ((mode single-value-mode) value) (when (or (null value) Index: cl-irc/utility.lisp diff -u cl-irc/utility.lisp:1.5 cl-irc/utility.lisp:1.6 --- cl-irc/utility.lisp:1.5 Sun Mar 20 17:55:36 2005 +++ cl-irc/utility.lisp Mon Mar 21 19:14:32 2005 @@ -1,4 +1,4 @@ -;;;; $Id: utility.lisp,v 1.5 2005/03/20 16:55:36 ehuelsmann Exp $ +;;;; $Id: utility.lisp,v 1.6 2005/03/21 18:14:32 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/utility.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -208,7 +208,7 @@ ;; C type mode from CHANMODES (t nil nil single-value-mode) ;; D type mode from CHANMODES - (nil nil nil single-value-mode)))) + (nil nil nil boolean-value-mode)))) (do ((mode (pop modes-list) (pop modes-list)) (mode-desc (pop mode-descs) (pop mode-descs))) ((null mode-desc) mode-desc-recs)

1 0