[Tkabber-dev] r987 - in trunk/tkabber: . ifacetk plugins/chat

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Wed Feb 28 21:54:54 MSK 2007


Author: sergei
Date: 2007-02-28 21:54:51 +0300 (Wed, 28 Feb 2007)
New Revision: 987

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/chats.tcl
   trunk/tkabber/ifacetk/iface.tcl
   trunk/tkabber/muc.tcl
   trunk/tkabber/plugins/chat/logger.tcl
   trunk/tkabber/privacy.tcl
Log:
	* plugins/chat/logger.tcl: Don't strip resource from JID when showing
	  chat log (if the user is in roster then resource is removed earlier,
	  otherwise the resource is nesessary to get private chat log with
	  conference users). Also, made possible showing a certain month log
	  instead of the latest (thanks to Konstantin Khomoutov).

	* chats.tcl: Fixed Alt-Prior and Alt-Next binding in chat input
	  windows.

	* ifacetk/iface.tcl: Don't count server messages in tab headers.

	* privacy.tcl, ifacetk/iface.tcl, muc.tcl: Added blocking all messages
	  to/from users, which aren't in the roster. Also, added special
	  privacy rule for conferences, to allow joining them even if they
	  aren't in the roster.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2007-02-27 17:59:26 UTC (rev 986)
+++ trunk/tkabber/ChangeLog	2007-02-28 18:54:51 UTC (rev 987)
@@ -1,3 +1,21 @@
+2007-02-28  Sergei Golovan  <sgolovan at nes.ru>
+
+	* plugins/chat/logger.tcl: Don't strip resource from JID when showing
+	  chat log (if the user is in roster then resource is removed earlier,
+	  otherwise the resource is nesessary to get private chat log with
+	  conference users). Also, made possible showing a certain month log
+	  instead of the latest (thanks to Konstantin Khomoutov).
+
+	* chats.tcl: Fixed Alt-Prior and Alt-Next binding in chat input
+	  windows.
+
+	* ifacetk/iface.tcl: Don't count server messages in tab headers.
+
+	* privacy.tcl, ifacetk/iface.tcl, muc.tcl: Added blocking all messages
+	  to/from users, which aren't in the roster. Also, added special
+	  privacy rule for conferences, to allow joining them even if they
+	  aren't in the roster.
+
 2007-02-27  Sergei Golovan  <sgolovan at nes.ru>
 
 	* plugins/general/remote.tcl, trans/pl.msg, trans/uk.msg,

Modified: trunk/tkabber/chats.tcl
===================================================================
--- trunk/tkabber/chats.tcl	2007-02-27 17:59:26 UTC (rev 986)
+++ trunk/tkabber/chats.tcl	2007-02-28 18:54:51 UTC (rev 987)
@@ -529,6 +529,10 @@
     bind $cw.input <Meta-Next> $next_binding
     bind $cw.input <Alt-Prior> $prior_binding
     bind $cw.input <Alt-Next> $next_binding
+    bind $cw.input <Meta-Prior> +break
+    bind $cw.input <Meta-Next> +break
+    bind $cw.input <Alt-Prior> +break
+    bind $cw.input <Alt-Next> +break
 
     bind $cw <Destroy> [list chat::close_window [double% $chatid]]
 

Modified: trunk/tkabber/ifacetk/iface.tcl
===================================================================
--- trunk/tkabber/ifacetk/iface.tcl	2007-02-27 17:59:26 UTC (rev 986)
+++ trunk/tkabber/ifacetk/iface.tcl	2007-02-28 18:54:51 UTC (rev 987)
@@ -264,6 +264,10 @@
 				 -command {privacy::edit_special_list invisible}] \
 			    [list command [string trim [::msgcat::mc "Edit ignore list "]] {} {} {} \
 				 -command {privacy::edit_special_list ignore}] \
+			    [list command [string trim [::msgcat::mc "Edit conference list "]] {} {} {} \
+				 -command {privacy::edit_special_list conference}] \
+			    [list checkbutton [::msgcat::mc "Accept messages from roster users only"] {} {} {} \
+				 -variable privacy::options(accept_from_roster_only)] \
 			    [list checkbutton [::msgcat::mc "Activate lists at startup"] {} {} {} \
 				 -variable privacy::options(activate_at_startup)] \
 			    {separator} \
@@ -1122,7 +1126,7 @@
 	set jid [chat::get_jid $chatid]
 	set myjid [chat::our_jid $chatid]
 	set mynick [chat::get_nick [chat::get_connid $chatid] $myjid $type]
-	if {![cequal $myjid $from]} {
+	if {![cequal $jid $from] && ![cequal $myjid $from]} {
 	    incr number_msg($chatid)
 	}
 	if {![cequal $jid $from] && ![cequal $myjid $from] && \

Modified: trunk/tkabber/muc.tcl
===================================================================
--- trunk/tkabber/muc.tcl	2007-02-27 17:59:26 UTC (rev 986)
+++ trunk/tkabber/muc.tcl	2007-02-28 18:54:51 UTC (rev 987)
@@ -1308,6 +1308,8 @@
 
     set group [tolower_node_and_domain $group]
 
+    privacy::add_to_special_list $connid conference [server_from_jid $group]
+
     set chatid [chat::chatid $connid $group]
     set_our_groupchat_nick $chatid $nick
 

Modified: trunk/tkabber/plugins/chat/logger.tcl
===================================================================
--- trunk/tkabber/plugins/chat/logger.tcl	2007-02-27 17:59:26 UTC (rev 986)
+++ trunk/tkabber/plugins/chat/logger.tcl	2007-02-28 18:54:51 UTC (rev 987)
@@ -227,26 +227,30 @@
 
 #############################################################################
 
+proc ::logger::describe_month {year-month} {
+    variable d2m
+
+    lassign [split ${year-month} -] year month
+    return "$d2m($month) $year"
+}
+
+#############################################################################
+
 proc ::logger::show_log {jid args} {
     global font
     global tcl_platform
     global defaultnick
-    variable d2m
 
     foreach {key val} $args {
 	switch -- $key {
 	    -connection { set connid $val }
+	    -when { set when $val }
 	}
     }
     if {![info exists connid]} {
 	set connid [lindex [jlib::connections] 0]
     }
 
-    set nas [node_and_server_from_jid $jid]
-    if {![chat::is_groupchat [chat::chatid $connid $nas]]} {
-	set jid $nas
-    }
-
     set logfile [jid_to_filename $jid]
 
     set lw [winid $jid]
@@ -296,17 +300,25 @@
 
     set subdirs {}
     foreach sd [lsort -decreasing [get_subdirs $logfile]] {
-	lassign [split $sd -] year month
-	lappend subdirs "$d2m($month) $year"
+	lappend subdirs [describe_month $sd]
     }
+    if {[info exists when]} {
+	set text [describe_month $when]
+	if {[lsearch -exact $subdirs $text] < 0} {
+	    error "no log entries for: $when"
+	}
+    } else {
+	set text [lindex $subdirs 0]
+    }
     lappend subdirs [::msgcat::mc "All"]
 
     set mcombo [ComboBox $mf.mcombo \
 			 -editable no \
 			 -exportselection no \
 			 -values $subdirs \
-			 -text [lindex $subdirs 0] \
-			 -modifycmd [list [namespace current]::change_month \
+			 -text $text \
+			 -modifycmd [list \
+			    [namespace current]::change_month \
 					  $mf.mcombo $logfile $l $mynick]]
     pack $mcombo -side left
 

Modified: trunk/tkabber/privacy.tcl
===================================================================
--- trunk/tkabber/privacy.tcl	2007-02-27 17:59:26 UTC (rev 986)
+++ trunk/tkabber/privacy.tcl	2007-02-28 18:54:51 UTC (rev 987)
@@ -7,32 +7,41 @@
     variable options
 
     array set req_messages \
-	[list ignore    [::msgcat::mc "Requesting ignore list: %s"] \
-	      invisible [::msgcat::mc "Requesting invisible list: %s"] \
-	      visible   [::msgcat::mc "Requesting visible list: %s"]]
+	[list ignore     [::msgcat::mc "Requesting ignore list: %s"] \
+	      invisible  [::msgcat::mc "Requesting invisible list: %s"] \
+	      visible    [::msgcat::mc "Requesting visible list: %s"] \
+	      conference [::msgcat::mc "Requesting converence list: %s"]]
 
     array set send_messages \
-	[list ignore    [::msgcat::mc "Sending ignore list: %s"] \
-	      invisible [::msgcat::mc "Sending invisible list: %s"] \
-	      visible   [::msgcat::mc "Sending visible list: %s"]]
+	[list ignore     [::msgcat::mc "Sending ignore list: %s"] \
+	      invisible  [::msgcat::mc "Sending invisible list: %s"] \
+	      visible    [::msgcat::mc "Sending visible list: %s"] \
+	      conference [::msgcat::mc "Sending conference list: %s"]]
 
     array set edit_messages \
-	[list ignore    [::msgcat::mc "Edit ignore list"] \
-	      invisible [::msgcat::mc "Edit invisible list"] \
-	      visible   [::msgcat::mc "Edit visible list"]]
+	[list ignore     [::msgcat::mc "Edit ignore list"] \
+	      invisible  [::msgcat::mc "Edit invisible list"] \
+	      visible    [::msgcat::mc "Edit visible list"] \
+	      conference [::msgcat::mc "Edit conference list"]]
 
     array set menu_messages \
-	[list ignore    [::msgcat::mc "Ignore list"] \
-	      invisible [::msgcat::mc "Invisible list"] \
-	      visible   [::msgcat::mc "Visible list"]]
+	[list ignore     [::msgcat::mc "Ignore list"] \
+	      invisible  [::msgcat::mc "Invisible list"] \
+	      visible    [::msgcat::mc "Visible list"] \
+	      conference [::msgcat::mc "Conference list"]]
 
     custom::defgroup Privacy \
 	[::msgcat::mc "Blocking communication (XMPP privacy lists) options."] \
 	-group Tkabber
 
+    custom::defvar options(accept_from_roster_only) 0 \
+	[::msgcat::mc "Accept messages from users, which are in the roster, only."] \
+	-type boolean -group Privacy \
+	-command [list [namespace current]::activate_privacy_lists]
+
     custom::defvar options(activate_at_startup) 1 \
-	[::msgcat::mc "Activate visible/invisible/ignore lists before sending\
-		       initial presence."] \
+	[::msgcat::mc "Activate visible/invisible/ignore/conference lists\
+		       before sending initial presence."] \
 	-type boolean -group Privacy
 }
 
@@ -721,7 +730,7 @@
 
 ###############################################################################
 #
-# Visible, invisible, ignore list block
+# Visible, invisible, ignore, conference list block
 #
 
 proc privacy::edit_special_list {name args} {
@@ -859,6 +868,11 @@
 	    set action allow
 	    set postitems $newitems
 	}
+	conference {
+	    set children {}
+	    set action allow
+	    set postitems {}
+	}
     }
 
     set items1 {}
@@ -904,22 +918,57 @@
 
     switch -- $name {
 	ignore {
-	    join_lists $connid "i-am-visible-list" {ignore-list invisible-list} \
-		{allow {}}
-	    join_lists $connid "i-am-invisible-list" {ignore-list visible-list} \
-		[list deny [list [jlib::wrapper:createtag presence-out]]]
+	    join_lists $connid "i-am-visible-list" \
+		       {ignore-list invisible-list conference-list} \
+		       {allow {} {}}
+	    join_lists $connid "i-am-visible-roster-list" \
+		       {ignore-list invisible-list conference-list} \
+		       {deny {type subscription value none} {}}
+	    join_lists $connid "i-am-invisible-list" \
+		       {ignore-list visible-list conference-list} \
+		       [list deny {} [list [jlib::wrapper:createtag presence-out]]]
+	    join_lists $connid "i-am-invisible-roster-list" \
+		       {ignore-list visible-list conference-list} \
+		       [list deny {type subscription value none} {} \
+			     deny {} [list [jlib::wrapper:createtag presence-out]]]
 	}
 	invisible {
-	    join_lists $connid "i-am-visible-list" {ignore-list invisible-list} \
-		[list allow [list]]
+	    join_lists $connid "i-am-visible-list" \
+		       {ignore-list invisible-list conference-list} \
+		       {allow {} {}}
+	    join_lists $connid "i-am-visible-roster-list" \
+		       {ignore-list invisible-list conference-list} \
+		       {deny {type subscription value none} {}}
 	}
 	visible {
-	    join_lists $connid "i-am-invisible-list" {ignore-list visible-list} \
-		[list deny [list [jlib::wrapper:createtag presence-out]]]
+	    join_lists $connid "i-am-invisible-list" \
+		       {ignore-list visible-list conference-list} \
+		       [list deny {} [list [jlib::wrapper:createtag presence-out]]]
+	    join_lists $connid "i-am-invisible-roster-list" \
+		       {ignore-list visible-list conference-list} \
+		       [list deny {type subscription value none} {} \
+			     deny {} [list [jlib::wrapper:createtag presence-out]]]
 	}
+	conference {
+	    join_lists $connid "i-am-visible-list" \
+		       {ignore-list invisible-list conference-list} \
+		       {allow {} {}}
+	    join_lists $connid "i-am-visible-roster-list" \
+		       {ignore-list invisible-list conference-list} \
+		       {deny {type subscription value none} {}}
+	    join_lists $connid "i-am-invisible-list" \
+		       {ignore-list visible-list conference-list} \
+		       [list deny {} [list [jlib::wrapper:createtag presence-out]]]
+	    join_lists $connid "i-am-invisible-roster-list" \
+		       {ignore-list visible-list conference-list} \
+		       [list deny {type subscription value none} {} \
+			     deny {} [list [jlib::wrapper:createtag presence-out]]]
+	}
     }
 
-    # TODO: wait for iq reply before sending presence?
+    # ejabberd behaves correctly and applies privacy lists before
+    # routing any subsequent packet, so we haven't to wait for iq reply
+    # before sending presence. What about other servers?
     if {$userstatus == "invisible"} {
 	set status available
     } else {
@@ -938,7 +987,7 @@
 }
 
 
-proc privacy::join_lists {connid name lists fallback args} {
+proc privacy::join_lists {connid name lists fallbacks args} {
     variable litems
 
     set items {}
@@ -963,9 +1012,12 @@
 	    incr i
 	}
     }
-    lappend items [jlib::wrapper:createtag item \
-		       -vars [list action [lindex $fallback 0] order $i] \
-		       -subtags [lindex $fallback 1]]
+    foreach {action vars subtags} $fallbacks {
+	lappend items [jlib::wrapper:createtag item \
+			   -vars [concat [list action $action order $i] $vars] \
+			   -subtags $subtags]
+    }
+
     eval { send_list_iq $name $items -connection $connid } $args
 }
 
@@ -1062,20 +1114,33 @@
 
 ###############################################################################
 #
-# During connect try to activate "i-am-visible-list" privacy list
+# During connect try to activate "i-am-visible-list" or
+# "i-am-visible-roster-list" privacy list
 # If it's not found then create and activate it
 # If activation or creation fails then terminate connect with error message
 #
 
+proc privacy::activate_privacy_lists {args} {
+    foreach connid [jlib::connections] {
+	activate_privacy_list 0 $connid
+    }
+}
+
 proc privacy::activate_privacy_list {depth connid} {
     variable options
     variable answer
 
-    if {!$options(activate_at_startup)} return
+    if {$options(accept_from_roster_only)} {
+	set listname "i-am-visible-roster-list"
+	set listfallback {deny {type subscription value none} {}}
+    } else {
+	set listname "i-am-visible-list"
+	set listfallback {allow {} {}}
+    }
 
     set_status [::msgcat::mc "Waiting for activating privacy list"]
     debugmsg privacy "requested privacy list activation"
-    send_default_or_active_list "i-am-visible-list" active \
+    send_default_or_active_list $listname active \
 	-command [list [namespace current]::get_answer $connid] \
 	-connection $connid
 
@@ -1107,14 +1172,14 @@
 			# TODO: error message
 			return
 		    }
-		    # There's no "i-am-visible-list" privacy list
+		    # There's no required privacy list
 		    # Create it
 		    set_status \
 			[::msgcat::mc "Creating default privacy list"]
 
-		    join_lists $connid "i-am-visible-list" \
-			{ignore-list invisible-list} \
-			[list allow [list]] \
+		    join_lists $connid $listname \
+			{ignore-list invisible-list conference-list} \
+			$listfallback \
 			-command [list [namespace current]::get_answer \
 				       $connid]
 
@@ -1197,8 +1262,16 @@
     clear_answer $connid
 }
 
+proc privacy::activate_privacy_list_at_startup {connid} {
+    variable options
+
+    if {$options(activate_at_startup)} {
+	activate_privacy_list 0 $connid
+    }
+}
+
 hook::add connected_hook \
-    [list [namespace current]::privacy::activate_privacy_list 0] 5
+    [namespace current]::privacy::activate_privacy_list_at_startup 5
 
 proc privacy::get_answer {connid res child} {
     variable answer
@@ -1249,7 +1322,7 @@
 
 	$mm add checkbutton -label $menu_messages($name) \
 	    -variable [namespace current]::cboxes($connid,$name,$rjid) \
-	    -command [list [namespace current]::add_to_special_list \
+	    -command [list [namespace current]::update_special_list \
 			   $connid $name $rjid]
     }
 
@@ -1268,9 +1341,20 @@
 
 ###############################################################################
 
+proc privacy::update_special_list {connid name jid} {
+    variable cboxes
+
+    if {[info exists cboxes($connid,$name,$jid)] && $cboxes($connid,$name,$jid)} {
+	add_to_special_list $connid $name $jid
+    } else {
+	remove_from_special_list $connid $name $jid
+    }
+}
+
+###############################################################################
+
 proc privacy::add_to_special_list {connid name jid} {
     variable special_list
-    variable cboxes
 
     if {![info exists special_list($connid,$name)]} {
 	set special_list($connid,$name) {}
@@ -1278,17 +1362,26 @@
 
     set idx [lsearch -exact $special_list($connid,$name) $jid]
 
-    if {[info exists cboxes($connid,$name,$jid)] && \
-	    ($cboxes($connid,$name,$jid) && $idx < 0)} {
+    if {$idx < 0} {
 	send_special_list $connid $name \
 			  [linsert $special_list($connid,$name) 0 $jid]
-	return
     }
-    if {![info exists cboxes($connid,$name,$jid)] || \
-	    (!$cboxes($connid,$name,$jid) && $idx >= 0)} {
+}
+
+###############################################################################
+
+proc privacy::remove_from_special_list {connid name jid} {
+    variable special_list
+
+    if {![info exists special_list($connid,$name)]} {
+	set special_list($connid,$name) {}
+    }
+
+    set idx [lsearch -exact $special_list($connid,$name) $jid]
+
+    if {$idx >= 0} {
 	send_special_list $connid $name \
 			  [lreplace $special_list($connid,$name) $idx $idx]
-	return
     }
 }
 
@@ -1319,6 +1412,9 @@
 		    ignore-list {
 			reload_special_list $connid ignore
 		    }
+		    conference-list {
+			reload_special_list $connid conference
+		    }
 		}
 	    }
 	}
@@ -1349,7 +1445,7 @@
 ###############################################################################
 
 proc privacy::get_list_vars {connid} {
-    foreach name {invisible visible ignore} {
+    foreach name {invisible visible ignore conference} {
 	reload_special_list $connid $name
     }
 }



More information about the Tkabber-dev mailing list