[Tkabber-dev] r1194 - in trunk/tkabber-plugins: . attline

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sat Aug 18 10:36:20 MSD 2007


Author: sergei
Date: 2007-08-18 10:36:20 +0400 (Sat, 18 Aug 2007)
New Revision: 1194

Modified:
   trunk/tkabber-plugins/ChangeLog
   trunk/tkabber-plugins/attline/attline.tcl
Log:
	* attline/attline.tcl: Code cleanup. Do not expire attention line if
	  it is already expired.


Modified: trunk/tkabber-plugins/ChangeLog
===================================================================
--- trunk/tkabber-plugins/ChangeLog	2007-08-18 06:32:27 UTC (rev 1193)
+++ trunk/tkabber-plugins/ChangeLog	2007-08-18 06:36:20 UTC (rev 1194)
@@ -1,3 +1,8 @@
+2007-08-18  Sergei Golovan <sgolovan at nes.ru>
+
+	* attline/attline.tcl: Code cleanup. Do not expire attention line if
+	  it is already expired.
+
 2007-08-17  Sergei Golovan <sgolovan at nes.ru>
 
 	* attline/*: Added new plguin which draws an attention line in chat

Modified: trunk/tkabber-plugins/attline/attline.tcl
===================================================================
--- trunk/tkabber-plugins/attline/attline.tcl	2007-08-18 06:32:27 UTC (rev 1193)
+++ trunk/tkabber-plugins/attline/attline.tcl	2007-08-18 06:36:20 UTC (rev 1194)
@@ -10,297 +10,291 @@
 option add *Chat.attentionLinePadY          0     widgetDefault
 
 namespace eval atline {
-	variable state
-	variable options
+    variable state
+    variable options
 
-	proc my what {
-		return [uplevel 1 namespace current]::$what
-	}
-	proc mycmd args {
-		lreplace $args 0 0 [my [lindex $args 0]]
-	}
+    proc my what {
+	return [uplevel 1 namespace current]::$what
+    }
+    proc mycmd args {
+	lreplace $args 0 0 [my [lindex $args 0]]
+    }
 
-	custom::defgroup Plugins [::msgcat::mc "Plugins options."] -group Tkabber
+    custom::defgroup Plugins [::msgcat::mc "Plugins options."] -group Tkabber
 
-	custom::defgroup {Attention Line} \
-		[::msgcat::mc "Attention Line chat plugin options.\
-			This plugin draws horizontal line separating\
-			read and unread messages in chat windows."] \
-		-group Plugins \
-		-group Chat
+    custom::defgroup {Attention Line} \
+	[::msgcat::mc "Attention Line chat plugin options.\
+		       This plugin draws horizontal line separating\
+		       read and unread messages in chat windows."] \
+	-group Plugins \
+	-group Chat
 
-	custom::defvar options(expires_after) 1000 \
-		[::msgcat::mc "Time (in milliseconds) after which unread messages\
-			in the currently active chat window are considered read and\
-			the attention line is considered expired."] \
-		-group {Attention Line} \
-		-type integer
+    custom::defvar options(expires_after) 1000 \
+	[::msgcat::mc "Time (in milliseconds) after which unread messages\
+		       in the currently active chat window are considered read\
+		       and the attention line is considered expired."] \
+	-group {Attention Line} \
+	-type integer
 
-	custom::defvar options(remove_expired) false \
-		[::msgcat::mc "Remove the attention line after it was expired\
-			from its chat window."] \
-		-group {Attention Line} \
-		-type boolean
+    custom::defvar options(remove_expired) false \
+	[::msgcat::mc "Remove the attention line after it was expired\
+		       from its chat window."] \
+	-group {Attention Line} \
+	-type boolean
 
-	hook::add open_chat_post_hook [my setup_chat_win]
-	# must perform after the hook from 'log on open' plugin:
-	hook::add open_chat_post_hook [my draw_chat_history_separator] 101
+    hook::add open_chat_post_hook [my setup_chat_win]
+    # must perform after the hook from 'log on open' plugin:
+    hook::add open_chat_post_hook [my draw_chat_history_separator] 101
 
-	# must perform earlier than drawing of timestamp:
-	hook::add draw_message_hook [my on_draw_message] 5.5
+    # must perform earlier than drawing of timestamp:
+    hook::add draw_message_hook [my on_draw_message] 5.5
 
-	hook::add got_focus_hook  [my on_focused]
-	hook::add lost_focus_hook [my on_lost_focus]
+    hook::add got_focus_hook  [my on_focused]
+    hook::add lost_focus_hook [my on_lost_focus]
+}
 
-	set accessor {
-		proc [namespace current]::%1$s {cw {val ""}} {
-			variable state
-			if {$val == ""} {
-				return $state($cw,%1$s)
-			} else {
-				set state($cw,%1$s) $val
-			}
-		}
-	}
-
-	eval [format $accessor unread]
-
-	unset accessor
+proc atline::unread {cw {val ""}} {
+    variable state
+    if {$val == ""} {
+	return $state($cw,unread)
+    } else {
+	set state($cw,unread) $val
+    }
 }
 
 proc atline::setup_chat_win {chatid type} {
-	variable state
-	set cw [chat::chat_win $chatid]
-	set iw [chat::input_win $chatid]
+    variable state
+    set cw [chat::chat_win $chatid]
+    set iw [chat::input_win $chatid]
 
-	set state($cw,mainwindow) [chat::winid $chatid]
+    set state($cw,mainwindow) [chat::winid $chatid]
 
-	#unread $cw [expr {![has_focus $chatid]}]
-	unread $cw false
+    #unread $cw [expr {![has_focus $chatid]}]
+    unread $cw false
 
-	bind $cw <Destroy> +[mycmd cleanup $cw %W]
+    bind $cw <Destroy> +[mycmd cleanup $cw %W]
 
-	bind $iw <<ChatSeeAttentionLine>> +[mycmd see_attention_line $cw]
+    bind $iw <<ChatSeeAttentionLine>> +[mycmd see_attention_line $cw]
 
-	return
+    return
 }
 
 proc atline::cleanup {w1 w2} {
-	if {![string equal $w1 $w2]} return
+    if {![string equal $w1 $w2]} return
 
-	cancel_atline_expiration $w1
+    cancel_atline_expiration $w1
 
-	variable state
-	array unset state $w1,*
+    variable state
+    array unset state $w1,*
 }
 
 proc atline::getopt {cw opt} {
-	variable state
+    variable state
 
-	chat::query_optiondb $state($cw,mainwindow) $opt
+    chat::query_optiondb $state($cw,mainwindow) $opt
 }
 
 proc atline::on_draw_message {chatid from type body x} {
-	if {[is_delayed $x]} return
+    if {[is_delayed $x]} return
 
-	set cw [chat::chat_win $chatid]
+    set cw [chat::chat_win $chatid]
 
-	if {![has_focus $chatid] && ![unread $cw]} {
-		unread $cw true
-		# TODO implement [redraw_...]
-		if {[drawn $cw]} {
-			debugmsg atline "deleting old"
-			delete_attention_line $cw
-		}
-		debugmsg atline "drawing"
-		draw_attention_line $cw
+    if {![has_focus $chatid] && ![unread $cw]} {
+	unread $cw true
+	# TODO implement [redraw_...]
+	if {[drawn $cw]} {
+	    debugmsg atline "deleting old"
+	    delete_attention_line $cw
 	}
+	debugmsg atline "drawing"
+	draw_attention_line $cw
+    }
 
-	return
+    return
 }
 
-proc atline::is_delayed xml {
-	foreach xelem $xml {
-		::jlib::wrapper:splitxml $xelem tag vars isempty chdata children
-		switch -- [::jlib::wrapper:getattr $vars xmlns] {
-			urn:xmpp:delay -
-			jabber:x:delay {
-				return 1
-			}
-		}
+proc atline::is_delayed {xml} {
+    foreach xelem $xml {
+	::jlib::wrapper:splitxml $xelem tag vars isempty chdata children
+	switch -- [::jlib::wrapper:getattr $vars xmlns] {
+	    urn:xmpp:delay -
+	    jabber:x:delay {
+		return 1
+	    }
 	}
-	return 0
+    }
+    return 0
 }
 
-proc atline::drawn cw {
-	expr {[$cw tag ranges ATLINE] != {}}
+proc atline::drawn {cw} {
+    expr {[$cw tag ranges ATLINE] != {}}
 }
 
 proc atline::draw_chat_history_separator {chatid type} {
-	if {[string equal $type chat]} {
-		set cw [chat::chat_win $chatid]
-		# Draw only if text widget isn't empty (has some history lines):
-		if {[$cw compare 1.0 < end-1c]} {
-			draw_attention_line [chat::chat_win $chatid]
-		}
+    if {[string equal $type chat]} {
+	set cw [chat::chat_win $chatid]
+	# Draw only if text widget isn't empty (has some history lines):
+	if {[$cw compare 1.0 < end-1c]} {
+	    draw_attention_line [chat::chat_win $chatid]
 	}
+    }
 
-	return
+    return
 }
 
-proc atline::draw_attention_line cw {
-	variable state
+proc atline::draw_attention_line {cw} {
+    variable state
 
-	if {[drawn $cw]} return
+    if {[drawn $cw]} return
 
-	set al $cw.attention_line
-	if {![winfo exists $al]} {
-		frame $al
-		bind $cw <Configure> +[mycmd reconfigure_attention_line $cw $al]
-		# Prevent destructed attention line from killing its parent
-		# in windowed mode when there's no explicit handler and the
-		# event is forwarded upstream:
-		bind $al <Destroy> +break
-	}
+    set al $cw.attention_line
+    if {![winfo exists $al]} {
+	frame $al
+	bind $cw <Configure> +[mycmd reconfigure_attention_line $cw $al]
+	# Prevent destructed attention line from killing its parent
+	# in windowed mode when there's no explicit handler and the
+	# event is forwarded upstream:
+	bind $al <Destroy> +break
+    }
 
-	set start [$cw index end-1c]
-	$cw window create end -window $al
-	$cw insert end \n
-	$cw tag add ATLINE $start end-1c
+    set start [$cw index end-1c]
+    $cw window create end -window $al
+    $cw insert end \n
+    $cw tag add ATLINE $start end-1c
 
-	reconfigure_attention_line $cw $al
+    reconfigure_attention_line $cw $al
 
-	debugmsg atline "drawn"
+    debugmsg atline "drawn"
 }
 
-proc atline::delete_attention_line cw {
-	if {![drawn $cw]} return
+proc atline::delete_attention_line {cw} {
+    if {![drawn $cw]} return
 
-	set state [$cw cget -state]
-	$cw configure -state normal
-	$cw delete ATLINE.first ATLINE.last
-	$cw configure -state $state
+    set state [$cw cget -state]
+    $cw configure -state normal
+    $cw delete ATLINE.first ATLINE.last
+    $cw configure -state $state
 
-	debugmsg atline "deleted"
+    debugmsg atline "deleted"
 }
 
-proc atline::see_attention_line cw {
-	if {![drawn $cw]} return
+proc atline::see_attention_line {cw} {
+    if {![drawn $cw]} return
 
-	$cw see ATLINE.first
+    $cw see ATLINE.first
 }
 
-proc atline::internal_width cw {
-	# We assume $cw is mapped...
-	expr { [winfo width $cw] - 2 * [$cw cget -borderwidth] }
+proc atline::internal_width {cw} {
+    # We assume $cw is mapped...
+    expr { [winfo width $cw] - 2 * [$cw cget -borderwidth] }
 }
 
 proc atline::reconfigure_attention_line {cw al} {
-	if {![winfo exists $al]} return
+    if {![winfo exists $al]} return
 
-	set padx [getopt $cw attentionLinePadX]
-	$al configure \
-		-background [getopt $cw attentionLineColor] \
-		-height     [getopt $cw attentionLineHeight] \
-		-width      [expr {[internal_width $cw] - 2 * $padx }]
-	$cw window configure ATLINE.first \
-		-padx       $padx \
-		-pady       [getopt $cw attentionLinePadY] \
+    set padx [getopt $cw attentionLinePadX]
+    $al configure \
+	-background [getopt $cw attentionLineColor] \
+	-height     [getopt $cw attentionLineHeight] \
+	-width      [expr {[internal_width $cw] - 2 * $padx }]
+    $cw window configure ATLINE.first \
+	-padx       $padx \
+	-pady       [getopt $cw attentionLinePadY] \
 }
 
-proc atline::has_focus chatid {
-	global usetabbar
+proc atline::has_focus {chatid} {
+    global usetabbar
 
-	if {$usetabbar} {
-		expr {![string equal [focus -displayof .] ""] \
-			&& [string equal [chat::winid $chatid] [ifacetk::nbpath [.nb raise]]]}
-	} else {
-		set fw [focus -displayof .]
-		expr {![string equal $fw ""] \
-			&& [string equal [winfo toplevel $fw] [chat::winid $chatid]]}
-	}
+    if {$usetabbar} {
+	expr {![string equal [focus -displayof .] ""] && \
+	    [string equal [chat::winid $chatid] [ifacetk::nbpath [.nb raise]]]}
+    } else {
+	set fw [focus -displayof .]
+	expr {![string equal $fw ""] && \
+	    [string equal [winfo toplevel $fw] [chat::winid $chatid]]}
+    }
 }
 
-proc atline::on_focused w {
-	set chatid [active_chatid $w]
-	if {$chatid == ""} return
+proc atline::on_focused {w} {
+    set chatid [active_chatid $w]
+    if {$chatid == ""} return
 
-	set cw [chat::chat_win $chatid]
-	debugmsg atline "focused; unread? [unread $cw]"
-	if {[unread $cw]} {
-		see_attention_line $cw
-		schedule_atline_expiration $cw
-	}
+    set cw [chat::chat_win $chatid]
+    debugmsg atline "focused; unread? [unread $cw]"
+    if {[unread $cw]} {
+	see_attention_line $cw
+	schedule_atline_expiration $cw
+    }
 }
 
-proc atline::on_lost_focus w {
-	set chatid [active_chatid $w]
-	if {$chatid == ""} return
+proc atline::on_lost_focus {w} {
+    set chatid [active_chatid $w]
+    if {$chatid == ""} return
 
-	set cw [chat::chat_win $chatid]
-	debugmsg atline "lost focus; unread? [unread $cw]"
-	if {[unread $cw]} {
-		cancel_atline_expiration $cw
-	} elseif {[drawn $cw]} {
-		delete_attention_line $cw
-		draw_attention_line $cw
-	}
+    set cw [chat::chat_win $chatid]
+    debugmsg atline "lost focus; unread? [unread $cw]"
+    if {[unread $cw]} {
+	cancel_atline_expiration $cw
+    } elseif {[drawn $cw]} {
+	delete_attention_line $cw
+	draw_attention_line $cw
+    }
 }
 
-proc atline::active_chatid w {
-	global usetabbar
-	variable ::chat::chat_id
+proc atline::active_chatid {w} {
+    global usetabbar
+    variable ::chat::chat_id
 
-	if {$usetabbar} {
-		# $w is always "." here...
-		set tab [.nb raise]
-		if {[string equal $tab ""]} return
-		set winid [ifacetk::nbpath $tab]
-	} else {
-		set winid $w
-	}
+    if {$usetabbar} {
+	# $w is always "." here...
+	set tab [.nb raise]
+	if {[string equal $tab ""]} return
+	set winid [ifacetk::nbpath $tab]
+    } else {
+	set winid $w
+    }
 
-	expr {
-		[info exists chat_id($winid)]
-		? $chat_id($winid)
-		: ""
-	}
+    expr {[info exists chat_id($winid)] ? $chat_id($winid) : ""}
 }
 
-proc atline::schedule_atline_expiration cw {
-	variable state
-	variable options
+proc atline::schedule_atline_expiration {cw} {
+    variable state
+    variable options
 
-	set exptime $options(expires_after)
+    set exptime $options(expires_after)
 
-	if {$exptime <= 0} {
-		# Immediate expiration:
-		unread $cw false
-		debugmsg atline "expired immediately"
-	}
+    if {$exptime <= 0} {
+	# Immediate expiration:
+	unread $cw false
+	debugmsg atline "expired immediately"
+	return
+    }
 
-	set state($cw,expiring) [after $exptime [mycmd expire_attention_line $cw]]
-	debugmsg atline "expiration scheduled for after $exptime"
+    set state($cw,expiring) [after $exptime [mycmd expire_attention_line $cw]]
+    debugmsg atline "expiration scheduled for after $exptime"
 }
 
-proc atline::cancel_atline_expiration cw {
-	variable state
-	if {[info exists state($cw,expiring)]} {
-		after cancel $state($cw,expiring)
-		unset state($cw,expiring)
-		debugmsg atline "expiration cancelled"
-	}
+proc atline::cancel_atline_expiration {cw} {
+    variable state
+    if {[info exists state($cw,expiring)]} {
+	after cancel $state($cw,expiring)
+	unset state($cw,expiring)
+	debugmsg atline "expiration cancelled"
+    }
 }
 
-proc atline::expire_attention_line cw {
-	variable state
-	variable options
+proc atline::expire_attention_line {cw} {
+    variable state
+    variable options
 
+    if {[info exists state($cw,expiring)]} {
 	unread $cw false
 	unset state($cw,expiring)
 	if {$options(remove_expired)} {
-		delete_attention_line $cw
+	    delete_attention_line $cw
 	}
 	debugmsg atline "expired"
+    }
 }
 
+# vim:ts=8:sw=4:sts=4:noet



More information about the Tkabber-dev mailing list