[beirc-cvs] CVS update: beirc/application.lisp

[Max-Gerd Retzlaff]

Update of /project/beirc/cvsroot/beirc
In directory common-lisp.net:/tmp/cvs-serv30389

Modified Files:
	application.lisp 
Log Message:
NICKNAME-TO-IGNORE-TRANSLATOR, NICKNAME-TO-FOCUS-TRANSLATOR, and
NICKNAME-TO-UNFOCUS-TRANSLATOR have now :TESTERs; so you can only
FOCUS someone if he/she/it is not focused yet, and UNFOCUS only if
the enitity is currently focused.

There is also a NICKNAME-TO-UNIGNORE-TRANSLATOR now. Useful to
UNIGNORE via the /names list.

Date: Mon Oct  3 00:40:55 2005
Author: mretzlaff

Index: beirc/application.lisp
diff -u beirc/application.lisp:1.28 beirc/application.lisp:1.29
--- beirc/application.lisp:1.28	Sun Oct  2 23:57:19 2005
+++ beirc/application.lisp	Mon Oct  3 00:40:54 2005
@@ -453,7 +453,23 @@
               :gesture :menu
               :menu t
               :documentation "Ignore this user"
-              :pointer-documentation "Ignore this user")
+              :pointer-documentation "Ignore this user"
+              :tester ((object)
+                       (not (find object (slot-value *application-frame* 'ignored-nicks)
+                                  :test 'string-equal))))
+
+    (object)
+  (list object))
+
+(define-presentation-to-command-translator nickname-to-unignore-translator
+    (nickname com-unignore beirc
+              :gesture :menu
+              :menu t
+              :documentation "Unignore this user"
+              :pointer-documentation "Unignore this user"
+              :tester ((object)
+                       (find object (slot-value *application-frame* 'ignored-nicks)
+                             :test 'string-equal)))
     (object)
   (list object))
 
@@ -462,7 +478,10 @@
               :gesture :menu
               :menu t
               :documentation "Focus this user"
-              :pointer-documentation "Focus this user")
+              :pointer-documentation "Focus this user"
+              :tester ((object)
+                       (not (find object (current-focused-nicks)
+                                  :test 'string-equal))))
     (object)
   (list object))
 
@@ -471,7 +490,10 @@
               :gesture :menu
               :menu t
               :documentation "Unfocus this user"
-              :pointer-documentation "Unfocus this user")
+              :pointer-documentation "Unfocus this user"
+              :tester ((object)
+                       (find object (current-focused-nicks)
+                             :test 'string-equal)))
     (object)
   (list object))
 
@@ -562,10 +584,9 @@
     (nickname hostmask beirc
               :tester ((object context-type)
                        (declare (ignore object))
-                        (presentation-subtypep context-type 'hostmask)))
+                       (presentation-subtypep context-type 'hostmask)))
     (object)
   (format nil "*!*@~A" (irc:hostname (irc:find-user (current-connection *application-frame*) object))))
-
 
 (define-beirc-command (com-join :name t) ((channel 'channel :prompt "channel"))
   (raise-receiver (intern-receiver channel *application-frame* :channel channel))