[Cl-irc-cvs] CVS update: cl-irc/parse-message.lisp cl-irc/protocol.lisp cl-irc/utility.lisp

[Erik Huelsmann]

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)