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

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Thu Jan 17 00:04:04 MSK 2008


Author: sergei
Date: 2008-01-17 00:04:03 +0300 (Thu, 17 Jan 2008)
New Revision: 1348

Modified:
   trunk/tkabber-plugins/ChangeLog
   trunk/tkabber-plugins/attline/attline.tcl
   trunk/tkabber-plugins/floatinglog/floatinglog.tcl
Log:
	* attline/attline.tcl: Removed tags ATLINE, made the line more thin,
	  optimized line redrawing, state clearing moved to
	  chat_close_post_hook (thanks to Konstantin Khomoutov).

	* attline/attline.tcl: Changed default line color from red to black.

	* floatinglog/floatinglog.tcl: Fixed bug with displaying message with
	  empty body (thanks to Ruslan Rakhmanin).


Modified: trunk/tkabber-plugins/ChangeLog
===================================================================
--- trunk/tkabber-plugins/ChangeLog	2008-01-15 18:19:54 UTC (rev 1347)
+++ trunk/tkabber-plugins/ChangeLog	2008-01-16 21:04:03 UTC (rev 1348)
@@ -1,3 +1,14 @@
+2008-01-16  Sergei Golovan <sgolovan at nes.ru>
+
+	* attline/attline.tcl: Removed tags ATLINE, made the line more thin,
+	  optimized line redrawing, state clearing moved to
+	  chat_close_post_hook (thanks to Konstantin Khomoutov).
+
+	* attline/attline.tcl: Changed default line color from red to black.
+
+	* floatinglog/floatinglog.tcl: Fixed bug with displaying message with
+	  empty body (thanks to Ruslan Rakhmanin).
+
 2007-12-31  Sergei Golovan <sgolovan at nes.ru>
 
 	* gmail/gmail.tcl: Removed opening notifications window at Tkabber

Modified: trunk/tkabber-plugins/attline/attline.tcl
===================================================================
--- trunk/tkabber-plugins/attline/attline.tcl	2008-01-15 18:19:54 UTC (rev 1347)
+++ trunk/tkabber-plugins/attline/attline.tcl	2008-01-16 21:04:03 UTC (rev 1348)
@@ -7,7 +7,7 @@
 package require msgcat
 
 option add *Chat.attentionLineHeight        1     widgetDefault
-option add *Chat.attentionLineColor         red   widgetDefault
+option add *Chat.attentionLineColor         black widgetDefault
 option add *Chat.attentionLinePadX          5     widgetDefault
 option add *Chat.attentionLinePadY          0     widgetDefault
 
@@ -50,13 +50,17 @@
     # must perform after the hook from 'log on open' plugin:
     hook::add open_chat_post_hook [mycmd draw_chat_history_separator] 101
 
+    hook::add close_chat_post_hook [mycmd cleanup]
+
     # must perform earlier than drawing of timestamp:
     hook::add draw_message_hook [mycmd on_draw_message] 5.5
 
     hook::add got_focus_hook  [mycmd on_focused]
     hook::add lost_focus_hook [mycmd on_lost_focus]
+}
 
-    bind Chat <Destroy> +[mycmd cleanup %W]
+proc attline::attline {cw} {
+    return $cw.attention_line
 }
 
 proc attline::unread {cw {val ""}} {
@@ -68,35 +72,45 @@
     }
 }
 
+proc attline::atbottom {cw {val ""}} {
+    variable state
+    if {$val == ""} {
+	return $state($cw,atbottom)
+    } else {
+	set state($cw,atbottom) $val
+    }
+}
+
+proc attline::isvisible {text index} {
+    expr {[llength [$text bbox $index]] > 0}
+}
+
 proc attline::setup_chat_win {chatid type} {
     variable state
     set cw [chat::chat_win $chatid]
     set iw [chat::input_win $chatid]
-    set winid [chat::winid $chatid]
 
-    set state($cw,mainwindow) $winid
-    set state($winid,chatwindow) $cw
+    set state($cw,mainwindow) [chat::winid $chatid]
 
     #unread $cw [expr {![has_focus $chatid]}]
     unread $cw false
+    atbottom $cw false
 
     bind $iw <<ChatSeeAttentionLine>> +[mycmd see_attention_line $cw]
 
     return
 }
 
-proc attline::cleanup winid {
+proc attline::cleanup {chatid} {
     variable state
 
-    if {![info exists state($winid,chatwindow)]} return
+    set cw [chat::chat_win $chatid]
 
-    set cw $state($winid,chatwindow)
-    cancel_atline_expiration $cw
+    cancel_attline_expiration $cw
 
-    catch {unset state($cw,expiring)}
-    catch {unset state($cw,mainwindow)}
-    catch {unset state($cw,unread)}
-    catch {unset state($winid,chatwindow)}
+    unset state($cw,mainwindow)
+    unset state($cw,unread)
+    unset state($cw,atbottom)
 }
 
 proc attline::getopt {cw opt} {
@@ -112,14 +126,13 @@
 
     if {![has_focus $chatid] && ![unread $cw]} {
 	unread $cw true
-	# TODO implement [redraw_...]
 	if {[drawn $cw]} {
-	    debugmsg attline "deleting old"
-	    delete_attention_line $cw
+	    redraw_attention_line $cw
+	} else {
+	    draw_attention_line $cw
 	}
-	debugmsg attline "drawing"
-	draw_attention_line $cw
     }
+    atbottom $cw false
 
     return
 }
@@ -138,7 +151,7 @@
 }
 
 proc attline::drawn {cw} {
-    expr {[$cw tag ranges ATLINE] != {}}
+    winfo exists [attline $cw]
 }
 
 proc attline::draw_chat_history_separator {chatid type} {
@@ -146,7 +159,7 @@
 	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]
+	    draw_attention_line $cw
 	}
     }
 
@@ -154,24 +167,16 @@
 }
 
 proc attline::draw_attention_line {cw} {
-    variable state
+    set al [attline $cw]
 
-    if {[drawn $cw]} return
+    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
 
     reconfigure_attention_line $cw $al
 
@@ -179,22 +184,45 @@
 }
 
 proc attline::delete_attention_line {cw} {
-    if {![drawn $cw]} return
-
     set state [$cw cget -state]
     $cw configure -state normal
-    $cw delete ATLINE.first ATLINE.last
+    $cw delete [attline $cw]
     $cw configure -state $state
 
     debugmsg attline "deleted"
 }
 
-proc attline::see_attention_line {cw} {
-    if {![drawn $cw]} return
+proc attline::redraw_attention_line {cw} {
+    set state [$cw cget -state]
+    $cw configure -state normal
 
-    $cw see ATLINE.first
+    set al [attline $cw]
+    set ix [$cw index $al]
+
+    if {[atbottom $cw]} {
+	debugmsg attline "at bottom, won't redraw"
+	return
+    }
+
+    $cw window configure $ix -window {}
+    $cw delete $ix
+
+    $cw window create end -window $al
+
+    reconfigure_attention_line $cw $al
+
+    $cw configure -state $state
+
+    debugmsg attline "redrawn"
 }
 
+proc attline::see_attention_line {cw} {
+    set al [attline $cw]
+    if {[winfo exists $al] && ![isvisible $cw $al]} {
+	$cw see $al
+    }
+}
+
 proc attline::internal_width {cw} {
     # We assume $cw is mapped...
     expr { [winfo width $cw]
@@ -205,14 +233,14 @@
 }
 
 proc attline::reconfigure_attention_line {cw al} {
-    if {![winfo exists $al] || [catch {$cw index ATLINE.first}]} 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 \
+    $cw window configure $al \
 	-padx       $padx \
 	-pady       [getopt $cw attentionLinePadY] \
 }
@@ -238,7 +266,7 @@
     debugmsg attline "focused; unread? [unread $cw]"
     if {[unread $cw]} {
 	see_attention_line $cw
-	schedule_atline_expiration $cw
+	schedule_attline_expiration $cw
     }
 }
 
@@ -249,14 +277,14 @@
     set cw [chat::chat_win $chatid]
     debugmsg attline "lost focus; unread? [unread $cw]"
     if {[unread $cw]} {
-	cancel_atline_expiration $cw
+	cancel_attline_expiration $cw
     } elseif {[drawn $cw]} {
-	delete_attention_line $cw
-	draw_attention_line $cw
+	redraw_attention_line $cw
+	atbottom $cw true
     }
 }
 
-proc attline::schedule_atline_expiration {cw} {
+proc attline::schedule_attline_expiration {cw} {
     variable state
     variable options
 
@@ -273,7 +301,7 @@
     debugmsg attline "expiration scheduled for after $exptime"
 }
 
-proc attline::cancel_atline_expiration {cw} {
+proc attline::cancel_attline_expiration {cw} {
     variable state
     if {[info exists state($cw,expiring)]} {
 	after cancel $state($cw,expiring)

Modified: trunk/tkabber-plugins/floatinglog/floatinglog.tcl
===================================================================
--- trunk/tkabber-plugins/floatinglog/floatinglog.tcl	2008-01-15 18:19:54 UTC (rev 1347)
+++ trunk/tkabber-plugins/floatinglog/floatinglog.tcl	2008-01-16 21:04:03 UTC (rev 1348)
@@ -298,9 +298,10 @@
 			$connid [double% $from] [double% $type]]
 	}
     }
-
-    after [expr {$options(livetime) * 1000}] \
-	  [namespace current]::del_text "$message_name"
+    if {$text != ""} {
+	after [expr {$options(livetime) * 1000}] \
+	      [namespace current]::del_text "$message_name"
+    }
 }
 
 proc floatinglog::process_status {text} {



More information about the Tkabber-dev mailing list