[Tkabber-dev] r1044 - in trunk/tkabber: . plugins/chat plugins/search

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Mar 11 00:04:54 MSK 2007


Author: sergei
Date: 2007-03-11 00:04:54 +0300 (Sun, 11 Mar 2007)
New Revision: 1044

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/plugins/chat/histool.tcl
   trunk/tkabber/plugins/chat/logger.tcl
   trunk/tkabber/plugins/search/logger.tcl
   trunk/tkabber/plugins/search/spanel.tcl
Log:
	* plugins/search/spanel.tcl: Added few new options to search panel
	  (-allowclose, -twoway, -defaultdirection, thanks to Konstantin
	  Khomoutov).

	* plugins/chat/logger.tcl, plugins/search/logger.tcl: Added
	  possibility to open log window at a specific message by timestamp
	  (thanks to Konstantin Khomoutov).

	* plugins/chat/histool.tcl: Added full-text search in all stored
	  chatlogs (thanks to Konstantin Khomoutov).


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2007-03-10 19:29:19 UTC (rev 1043)
+++ trunk/tkabber/ChangeLog	2007-03-10 21:04:54 UTC (rev 1044)
@@ -26,6 +26,17 @@
 	  plugins/unix/systray.tcl, plugins/unix/tktray.tcl: Added extra
 	  checks for icon existence.
 
+	* plugins/search/spanel.tcl: Added few new options to search panel
+	  (-allowclose, -twoway, -defaultdirection, thanks to Konstantin
+	  Khomoutov).
+
+	* plugins/chat/logger.tcl, plugins/search/logger.tcl: Added
+	  possibility to open log window at a specific message by timestamp
+	  (thanks to Konstantin Khomoutov).
+
+	* plugins/chat/histool.tcl: Added full-text search in all stored
+	  chatlogs (thanks to Konstantin Khomoutov).
+
 2007-03-09  Sergei Golovan  <sgolovan at nes.ru>
 
 	* ifacetk/iface.tcl, splash.tcl, tkabber.tcl: Withdraw main window at

Modified: trunk/tkabber/plugins/chat/histool.tcl
===================================================================
--- trunk/tkabber/plugins/chat/histool.tcl	2007-03-10 19:29:19 UTC (rev 1043)
+++ trunk/tkabber/plugins/chat/histool.tcl	2007-03-10 21:04:54 UTC (rev 1044)
@@ -1,12 +1,12 @@
 # $Id$
-# "histool" -- "A History Tool" Tkabber plugin.
-# Offers additional possiblities to dig the available chat history.
-#
-# Written by Konstantin Khomoutov <flatworm at users.sourceforge.net>
-# See README for details.
-# See licence.terms for the terms of distribution.
+# History tool -- allows browsing and searching through Tkabber chat logs.
 
-option add Tkabber.histool.geometry "640x480" widgetDefault
+option add *ChatHistory.geometry          "640x480" widgetDefault
+#option add *ChatHistory.oddBackground     ""        widgetDefault
+#option add *ChatHistory.evenBackground    beige     widgetDefault
+option add *ChatHistory.headerForeground  blue      widgetDefault
+option add *ChatHistory.bodyForeground    ""        widgetDefault
+ 
 
 event add <<TreeDefaultNodeAction>> <KeyPress-Return>
 event add <<TreeDefaultNodeAction>> <Double-Button-1>
@@ -62,10 +62,10 @@
 	       -raisecmd [list [namespace current]::ltree_raise $nb]]
     ltree_create $p $loghier
 
-#    set p [$nb insert end ftsearch \
-#	       -text [::msgcat::mc "Full-text search"] \
-#	       -raisecmd [list [namespace current]::ftsearch_raise $nb]]
-#    ftsearch_create $p $loghier
+    set p [$nb insert end ftsearch \
+	       -text [::msgcat::mc "Full-text search"] \
+	       -raisecmd [list [namespace current]::ftsearch_raise $nb]]
+    ftsearch_create $p $loghier -mainwindow $w
 
     pack $nb -fill both -expand true
 
@@ -97,8 +97,9 @@
     # Setup searching:
 
     set sp [::plugins::search::spanel $w.spanel \
-		-searchcommand [list ::plugins::search::listbox::do_search $lbox] \
-		-closecommand  [list [namespace current]::jidlist_spanel_close $lbox]]
+	    -defaultdirection up \
+	    -searchcommand [list ::plugins::search::listbox::do_search $lbox] \
+	    -closecommand  [list [namespace current]::jidlist_spanel_close $lbox]]
 
     bind $lbox <<OpenSearchPanel>> \
 	 [list [namespace current]::jidlist_spanel_open $w $sp]
@@ -149,10 +150,227 @@
     }
 }
 
-proc histool::ftsearch_create {w loghier} {
-    pack [label $w.tobedone -anchor w -text [::msgcat::mc "To be done..."]] -fill x
+proc histool::ftsearch_create {w lh args} {
+    variable loghier $lh
+    variable ftsearch
+
+    set sp $w.spanel
+    ::plugins::search::spanel $sp \
+	-allowclose no \
+	-twoway no \
+	-searchcommand [namespace current]::ftsearch_do_search
+    pack $sp -fill x
+
+    set sw [ScrolledWindow $w.sw]
+    set r [text $w.results -cursor "" -state disabled]
+    $sw setwidget $r
+    pack $sw -fill both -expand yes
+
+    set f [frame $w.cf -class Chat]
+    $r tag configure they -foreground [option get $f theyforeground Chat]
+    $r tag configure me -foreground [option get $f meforeground Chat]
+    $r tag configure server_lab \
+	-foreground [option get $f serverlabelforeground Chat]
+    $r tag configure server \
+	-foreground [option get $f serverforeground Chat]
+    destroy $f
+
+    bind $r <Double-Button-1> [namespace code {
+	ftsearch_open_log %W %x %y
+	break
+    }]
+
+    set ix [lsearch $args -mainwindow]
+    if {$ix >= 0} {
+	set mw [lindex $args [incr ix]]
+	if {$mw != ""} {
+	    set val [option get $mw oddBackground ChatHistory]
+	    if {$val != ""} { $r tag configure ODD -background $val }
+	    set val [option get $mw evenBackground ChatHistory]
+	    if {$val != ""} { $r tag configure EVEN -background $val }
+	    
+	    $r tag configure HEADER -foreground \
+		[option get $mw headerForeground ChatHistory]
+	    set val [option get $mw bodyForeground ChatHistory]
+	    if {$val != ""} { $r tag configure BODY -background $val }
+	}
+    }
+
+    set ftsearch(last) ""
+    set ftsearch(results) $r
+    set ftsearch(bg) EVEN
+
+    bind $w <Destroy> +[list [namespace current]::ftsearch_cleanup $w %W]
+
+    # Set search panel up:
+
+    # TODO remove when fixed elsewhere.
+    # See also [ftsearch_spanel_close]
+    $r mark set sel_start end
+    $r mark set sel_end   1.0
+
+    set asp [::plugins::search::spanel $w.auxspanel \
+	    -defaultdirection up \
+	    -searchcommand [list ::plugins::search::do_text_search $r] \
+	    -closecommand  [list [namespace current]::ftsearch_spanel_close $r $sp.sentry]]
+
+    bind $sp.sentry <<OpenSearchPanel>> \
+	 [list [namespace current]::ftsearch_spanel_open $w $asp]
 }
 
+proc histool::ftsearch_do_search {what dir} {
+    variable loghier
+    variable ftsearch
+
+    if {$what == ""} { return 0 }
+    if {[string equal $ftsearch(last) $what]} { return 1 }
+
+    set r $ftsearch(results)
+    $r delete 1.0 end
+
+    set found 0
+
+    foreach LA [lsort -index 0 $loghier] {
+	lassign $LA year months
+	foreach LB [lsort -index 0 $months] {
+	    lassign $LB month jids
+	    foreach jid $jids {
+		set fname [::logger::jid_to_filename $jid]
+		foreach msg [ftsearch_grep $what in $fname on $year-$month] {
+		    set found 1
+		    $r configure -state normal
+		    ftsearch_render_msg $r $year $month $jid $msg
+		    $r configure -state disabled
+		}
+	    }
+	}
+    }
+
+    set ftsearch(last) $what
+
+    return $found
+}
+
+proc histool::ftsearch_grep {what "in" where "on" month} {
+    set out {}
+
+    foreach msg [::logger::read_hist_from_file $where $month] {
+	lassign $msg & mts & mjid & mnick & mbody
+	if {[::plugins::search::match $what $mbody]} {
+	    lappend out $msg
+	} elseif {[::plugins::search::match $what $mnick]} {
+	    lappend out $msg
+	}
+	update
+    }
+
+    set out
+}
+
+proc histool::ftsearch_render_msg {t year month jid msg} {
+    variable ftsearch
+
+    set tags [list $ftsearch(bg) YEAR-$year MONTH-$month JID-$jid]
+
+    set mynick [get_group_nick $jid ""]
+
+    array set mparts $msg
+
+    set start [$t index {end - 1 char}]
+
+    set header $jid
+
+    if {[info exists mparts(timestamp)] && $mparts(timestamp) != ""} {
+	set ts [::logger::formatxmppts $mparts(timestamp)]
+	append header " \[$ts\]"
+	lappend tags TS-$mparts(timestamp)
+    }
+
+    if {[info exists mparts(jid)] && $mparts(jid) == ""} {
+	append header " " [::msgcat::mc "Client message"]
+    } elseif {[info exists mparts(nick)]} {
+	if {$mparts(nick) == ""} {
+	    append header " " [::msgcat::mc "Server message"]
+	} else {
+	    append header " " [::msgcat::mc "From:"] " " $mparts(nick)
+	}
+    }
+    $t insert end $header\n HEADER
+    $t insert end $mparts(body)\n BODY
+
+    set end [$t index {end - 1 char}]
+
+    foreach tag $tags {
+	$t tag add $tag $start $end
+    }
+
+    if {[string equal $ftsearch(bg) EVEN]} {
+	set ftsearch(bg) ODD
+    } else {
+	set ftsearch(bg) EVEN
+    }
+}
+
+proc histool::ftsearch_open_log {t x y} {
+    set year   ""
+    set month  ""
+    set ts     ""
+    set jid    ""
+
+    foreach tag [$t tag names @$x,$y] {
+	if {[string match YEAR-* $tag]} {
+	    set year [string range $tag 5 end]
+	}
+	if {[string match MONTH-* $tag]} {
+	    set month [string range $tag 6 end]
+	}
+	if {[string match TS-* $tag]} {
+	    set ts [string range $tag 3 end]
+	}
+	if {[string match JID-* $tag]} {
+	    set jid [string range $tag 4 end]
+	}
+    }
+
+    if {$jid == ""} return
+
+    set cmd [list ::logger::show_log $jid]
+
+    if {$year != "" && $month != ""} {
+	lappend cmd -when $year-$month
+	if {$ts != ""} {
+	    lappend cmd -timestamp $ts
+	}
+    }
+
+    eval $cmd
+}
+
+proc histool::ftsearch_spanel_open {w sp} {
+    pack $sp -in $w -side bottom -fill x
+}
+
+proc histool::ftsearch_spanel_close {t sentry w} {
+    # TODO remove when fixed elsewhere.
+    # See also [ftsearch_create]
+    $t tag remove search_highlight 0.0 end
+    $t mark set sel_start end                                               
+    $t mark set sel_end 0.0                                                 
+    
+    pack forget $w
+    focus $sentry
+}
+
+proc histool::ftsearch_cleanup {w1 w2} {
+    if {![string equal $w1 $w2]} return
+
+    variable ftsearch
+    variable loghier
+
+    array unset ftsearch
+    unset loghier
+}
+
 proc histool::ltree_for_node {t script} {
     set node [lindex [$t selection get] 0]
     if {[string equal $node ""]} return
@@ -180,6 +398,8 @@
 
 proc histool::ltree_step_up {t n} {
     set p [$t parent $n]
+    if {[string equal $p root]} return
+
     $t toggle $p
     $t selection set $p
 }
@@ -253,7 +473,7 @@
 proc histool::get_jids {loghier} {
     foreach LA $loghier {
 	foreach LB [lindex $LA 1] {
-	    foreach {jid fname} [lindex $LB 1] {
+	    foreach jid [lindex $LB 1] {
 		set jids($jid) ""
 	    }
 	}
@@ -262,3 +482,4 @@
     array names jids
 }
 
+# vim:ts=8:sw=4:sts=4:noet

Modified: trunk/tkabber/plugins/chat/logger.tcl
===================================================================
--- trunk/tkabber/plugins/chat/logger.tcl	2007-03-10 19:29:19 UTC (rev 1043)
+++ trunk/tkabber/plugins/chat/logger.tcl	2007-03-10 21:04:54 UTC (rev 1044)
@@ -239,7 +239,7 @@
 
 #############################################################################
 
-proc ::logger::show_log {jid args} {
+proc ::logger::create_log_viewer {lw jid args} {
     global font
     global tcl_platform
     global defaultnick
@@ -247,7 +247,6 @@
     foreach {key val} $args {
 	switch -- $key {
 	    -connection { set connid $val }
-	    -when { set when $val }
 	}
     }
     if {![info exists connid]} {
@@ -256,13 +255,6 @@
 
     set logfile [jid_to_filename $jid]
 
-    set lw [winid $jid]
-    debugmsg plugins "LOGGER: $lw"
-    if {[winfo exists $lw]} {
-	focus -force $lw
-	return
-    }
-
     set mynick [get_group_nick $jid ""]
 
     toplevel $lw -relief $::tk_relief -borderwidth $::tk_borderwidth -class Chat
@@ -273,10 +265,8 @@
     wm iconname $lw $title
 
     set lf [ScrolledWindow $lw.sw]
-    set l [text $lf.log -font $font -wrap word -takefocus 0]
+    set l [text $lw.log -font $font -wrap word -takefocus 0]
 
-    set cf [frame $lw.controls]
-
     set mf [frame $lw.mf]
     pack $mf -side top -fill x -expand no -padx 1m -pady 1m
     set mlabel [label $mf.mlabel -text [::msgcat::mc "Select month:"]]
@@ -301,35 +291,24 @@
     $l tag configure server \
        -foreground [option get $lw serverforeground Chat]
 
+    $l configure -state disabled
+
     set subdirs {}
     foreach sd [lsort -decreasing [get_subdirs $logfile]] {
 	lappend subdirs [describe_month $sd]
     }
     lappend subdirs [::msgcat::mc "All"]
-    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]
-    }
 
     set mcombo [ComboBox $mf.mcombo \
 			 -editable no \
 			 -exportselection no \
 			 -values $subdirs \
-			 -text $text \
+			 -text [lindex $subdirs 0] \
 			 -modifycmd [list \
 			    [namespace current]::change_month \
 					  $mf.mcombo $logfile $l $mynick]]
     pack $mcombo -side left
 
-    change_month $mf.mcombo $logfile $l $mynick
-
-    $lf.log see end
-    $lf.log configure -state disabled
-
     hook::run open_log_post_hook $connid $jid $lw
 
     wm deiconify $lw
@@ -337,6 +316,58 @@
 
 #############################################################################
 
+proc ::logger::show_log {jid args} {
+    set lw [winid $jid]
+    debugmsg plugins "LOGGER: $lw"
+
+    variable $lw
+    upvar 1 $lw state
+
+    if {![winfo exists $lw]} {
+	create_log_viewer $lw $jid $args
+    } else {
+	focus -force $lw
+    }
+
+    foreach {key val} $args {
+	switch -- $key {
+	    -when { set when $val }
+	    -timestamp { set timestamp $val }
+	}
+    }
+
+    set logfile [jid_to_filename $jid]
+    set mynick [get_group_nick $jid ""]
+
+    set log $lw.log
+    set cbox $lw.mf.mcombo
+
+    set subdirs [$cbox cget -values]
+    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]
+    }
+
+    $cbox configure -text $text
+
+    change_month $cbox $logfile $log $mynick
+
+    if {[info exists timestamp]} {
+	set pos [lindex [$log tag ranges TS-$timestamp] 0]
+	if {$pos == ""} { set pos end }
+    } else {
+	set pos end
+    }
+
+    $log see $pos
+}
+
+#############################################################################
+
 proc ::logger::get_subdirs {logfile} {
     variable options
 
@@ -356,13 +387,20 @@
 
 proc ::logger::draw_messages {l hist mynick} {
     $l configure -state normal
-    $l delete 0.0 end
+    $l delete 1.0 end
 
     add_messages $l $hist $mynick
 }
 
 #############################################################################
 
+proc ::logger::formatxmppts {xmppts} {
+    set seconds [clock scan $xmppts -gmt 1]
+    clock format $seconds -format {%Y-%m-%d %X}
+}
+
+#############################################################################
+
 proc ::logger::add_messages {l hist mynick} {
     $l configure -state normal
 
@@ -371,8 +409,8 @@
 	if {[catch {array set tmp $vars}]} continue
 
 	if {[info exists tmp(timestamp)]} {
-	    set seconds [clock scan $tmp(timestamp) -gmt 1]
-	    $l insert end [clock format $seconds -format {[%Y-%m-%d %X]}]
+	    $l insert end \[[formatxmppts $tmp(timestamp)]\] \
+		[list TS-$tmp(timestamp)]
 	}
 	if {[info exists tmp(jid)] && $tmp(jid) == ""} {
 	    # synthesized message

Modified: trunk/tkabber/plugins/search/logger.tcl
===================================================================
--- trunk/tkabber/plugins/search/logger.tcl	2007-03-10 19:29:19 UTC (rev 1043)
+++ trunk/tkabber/plugins/search/logger.tcl	2007-03-10 21:04:54 UTC (rev 1044)
@@ -18,7 +18,7 @@
 }
 
 proc search::logger::setup_panel {connid jid w} {
-    set tw $w.sw.log
+    set tw $w.log
 
     $tw mark set sel_start end
     $tw mark set sel_end 0.0

Modified: trunk/tkabber/plugins/search/spanel.tcl
===================================================================
--- trunk/tkabber/plugins/search/spanel.tcl	2007-03-10 19:29:19 UTC (rev 1043)
+++ trunk/tkabber/plugins/search/spanel.tcl	2007-03-10 21:04:54 UTC (rev 1044)
@@ -9,7 +9,6 @@
 
 namespace eval search {}
 
-# TODO (?) add -defdir option to specify def. search dir
 # TODO (?) require searchcmd to return a list:
 #      [search_result wrapped_around]
 #      and signalize wrap-around condition to the user
@@ -19,13 +18,16 @@
 # -searchcommand
 # -opencommand
 # -closecommand
+# -allowclose
+# -twoway
+# -defaultdirection
 #
-# May be?
-# -defdir (what direction does Return search)
-#
 proc search::spanel {w args} {
-    set opencmd ""
-    set closecmd ""
+    set opencmd   ""
+    set closecmd  ""
+    set canclose  1
+    set twoway    1
+    set primary   0
     foreach {key val} $args {
 	switch -- $key {
 	    -searchcommand {
@@ -37,6 +39,19 @@
 	    -closecommand {
 		set closecmd $val
 	    }
+	    -allowclose {
+		set canclose $val
+	    }
+	    -twoway {
+		set twoway $val
+	    }
+	    -defaultdirection {
+		switch -- $val {
+		    up   { set primary 0 }
+		    down { set primary 1 }
+		    default { error "Invaild default search direcrion: $val" }
+		}
+	    }
 	}
     }
 
@@ -57,28 +72,60 @@
 						    [double% $opencmd]]]
 
     set sbox [ButtonBox $w.sbox -spacing 0]
-    $sbox add -text [::msgcat::mc "Search up"] \
-	      -command [namespace code [list spanel_search $sentry $searchcmd up $bg]]
-    $sbox add -text [::msgcat::mc "Search down"] \
-	      -command [namespace code [list spanel_search $sentry $searchcmd down $bg]]
+    if {$twoway} {
+	set lbl [::msgcat::mc "Search up"]
+    } else {
+	set lbl [::msgcat::mc "Search"]
+    }
+    $sbox add -text $lbl \
+	      -command [namespace code [list spanel_search $w $searchcmd up $bg]]
+    if {$twoway} {
+	$sbox add -text [::msgcat::mc "Search down"] \
+	      -command [namespace code [list spanel_search $w $searchcmd down $bg]]
+    }
     pack $sbox -side left -padx 1m
 
     set cbox [ButtonBox $w.cbox -spacing 0]
     $cbox add -text [::msgcat::mc "Close"] \
 	      -command [namespace code [list spanel_close $w $closecmd]]
-    pack $cbox -side right -padx 1m
+    if {$canclose} {
+	pack $cbox -side right -padx 1m
+    }
 
-    bind $sentry <Key-Return> [double% [list $sbox invoke 0]]
-    bind $sentry <Shift-Key-Return> [double% [list $sbox invoke 1]]
-    bind $sentry <Escape> [double% [list $cbox invoke 0]]
-    bind $sentry <Escape> +break ;# prevent forwarding upstream
+    bind $sentry <Key-Return> [double% [list $sbox invoke $primary]]
+    bind $sentry <Shift-Key-Return> [double% [list $sbox invoke [expr {!$primary}]]]
 
+    if {$canclose} {
+	bind $sentry <Escape> [double% [list $cbox invoke 0]]
+	bind $sentry <Escape> +break ;# prevent forwarding upstream
+    }
+
     set w
 }
 
-proc search::spanel_search {sentry searchcmd dir dbg} {
-    set found [eval $searchcmd [list [$sentry get] $dir]]
+proc search::spanel_search {w searchcmd dir dbg} {
+    set sentry $w.sentry
+    set sbox   $w.sbox
+    set cbox   $w.cbox
 
+    $sentry configure -state disabled
+    $sbox   configure -state disabled
+    $cbox   configure -state disabled
+    update idletasks
+
+    set failed [catch {
+	eval $searchcmd [list [$sentry get] $dir]
+    } found]
+
+    $sentry configure -state normal
+    $sbox   configure -state normal
+    $cbox   configure -state normal
+    update idletasks
+
+    if {$failed} {
+	return -code error $found
+    }
+
     if {$found} {
 	set bg $dbg
     } else {
@@ -104,3 +151,4 @@
     }
 }
 
+# vim:ts=8:sw=4:sts=4:noet



More information about the Tkabber-dev mailing list