[Tkabber-dev] r1002 - in trunk/tkabber: . plugins/general plugins/search

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Mar 4 14:07:55 MSK 2007


Author: sergei
Date: 2007-03-04 14:07:50 +0300 (Sun, 04 Mar 2007)
New Revision: 1002

Added:
   trunk/tkabber/plugins/search/headlines.tcl
   trunk/tkabber/plugins/search/spanel.tcl
Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/plugins/general/headlines.tcl
   trunk/tkabber/plugins/search/browser.tcl
   trunk/tkabber/plugins/search/chat.tcl
   trunk/tkabber/plugins/search/custom.tcl
   trunk/tkabber/plugins/search/logger.tcl
   trunk/tkabber/plugins/search/rawxml.tcl
   trunk/tkabber/plugins/search/search.tcl
Log:
	* plugins/search/*: Added unified search panel interface (thanks to
	  Konstantin Khomoutov). Use this interface for searching in all
	  Tkabber windows.

	* plugins/general/headlines.tcl: Moved search functions to
	  plugins/search/headlines.tcl.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2007-03-04 10:32:59 UTC (rev 1001)
+++ trunk/tkabber/ChangeLog	2007-03-04 11:07:50 UTC (rev 1002)
@@ -11,6 +11,13 @@
 
 	* plugins/chat/logger.tcl: Fixed bug with showing empty history.
 
+	* plugins/search/*: Added unified search panel interface (thanks to
+	  Konstantin Khomoutov). Use this interface for searching in all
+	  Tkabber windows.
+
+	* plugins/general/headlines.tcl: Moved search functions to
+	  plugins/search/headlines.tcl.
+
 2007-03-03  Sergei Golovan  <sgolovan at nes.ru>
 
 	* plugins/general/headlines.tcl: Bugfix. Removed trailing linefeed

Modified: trunk/tkabber/plugins/general/headlines.tcl
===================================================================
--- trunk/tkabber/plugins/general/headlines.tcl	2007-03-04 10:32:59 UTC (rev 1001)
+++ trunk/tkabber/plugins/general/headlines.tcl	2007-03-04 11:07:50 UTC (rev 1002)
@@ -931,290 +931,4 @@
 hook::add save_session_hook [namespace current]::headlines::save_session
 
 #############################################################################
-#############################################################################
 
-namespace eval headlines::search {}
-
-proc headlines::search::open_panel {sf w dw} {
-    set sentry $sf.search
-
-    pack $sf -side bottom -anchor w -fill x -before $dw.sw
-    focus $sentry
-
-    update idletasks
-    $w.body see end
-}
-
-#############################################################################
-
-proc headlines::search::close_panel {sf w tw} {
-    $w.body tag remove search_highlight 0.0 end
-    pack forget $sf
-    focus $tw
-}
-
-#############################################################################
-
-proc headlines::search::setup_panel {w tw uw dw} {
-    set body $w.body
-
-    $body mark set sel_start end
-    $body mark set sel_end 0.0
-
-    set sf [frame $w.search]
-
-    set sentry \
-	[entry $sf.search \
-	       -validate all \
-	       -validatecommand [list plugins::search::validate_entry %W %P]]
-    pack $sentry -padx 1m -side left
-
-    set sbox [ButtonBox $sf.sbox -spacing 0]
-    $sbox add -text [::msgcat::mc "Search up"] \
-         -command [list [namespace current]::do_search $w $tw $uw $dw $sentry 1]
-    $sbox add -text [::msgcat::mc "Search down"] \
-         -command [list [namespace current]::do_search $w $tw $uw $dw $sentry 0]
-    pack $sbox -side left -padx 1m
-    
-    set cbox [ButtonBox $sf.cbox -spacing 0]
-    $cbox add -text [::msgcat::mc "Close"] \
-         -command [list [namespace current]::close_panel $sf $w $tw]
-    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 [namespace current]::close_panel $sf $w $tw]]
-
-    foreach ww [list $tw.c $w.body $dw.date.ts $dw.from.jid $dw.subject.subj] {
-	bind $ww <<OpenSearchPanel>> \
-	     [double% [list [namespace current]::open_panel $sf $w $dw]]
-    }
-}
-
-hook::add open_headlines_post_hook \
-	  [namespace current]::headlines::search::setup_panel
-
-#############################################################################
-
-proc headlines::search::do_search {hw tw uw dw sentry back} {
-    set searchpattern [$sentry get]
-    if {![string length $searchpattern]} {
-	return 0
-    }
-
-    if {$back} {
-	set start_node [lindex [$tw selection get] 0]
-	if {$start_node == ""} {
-	    set start_node root
-	}
-	set node [search_up $hw $tw $uw $dw $start_node $sentry]
-    } else {
-	set start_node [lindex [$tw selection get] end]
-	if {$start_node == ""} {
-	    set start_node root
-	}
-	set node [search_down $hw $tw $uw $dw $start_node $sentry]
-    }
-
-    if {$node != ""} {
-	plugins::search::panel_colorize_entry $sentry background 
-	return 1
-    } else {
-	plugins::search::panel_colorize_entry $sentry noMatchesBackground
-	return 0
-    }
-}
-
-##########################################################################
-
-proc headlines::search::search_up {hw tw uw dw node sentry} {
-    set what [$sentry get]
-    if {![string length $what]} {
-	return ""
-    }
-
-    set body $hw.body
-    set subj $dw.subject.subj
-
-    # Try to search in current article
-    if {[search_in_article_up $body $subj $sentry]} {
-	return $node
-    }
-
-    set n [plugins::search::bwtree::prev_node $tw $node]
-    while {1} {
-	if {($n != "root") && \
-		![catch { array set props [$tw itemcget $n -data] }] && \
-		[info exists props(type)] && \
-		$props(type) == "article"} {
-
-	    set subjtext [string map [list "\n" " "] $props(text)]
-	    set bodytext "$props(body)\n\n[::msgcat::mc {Read on...}]"
-	    if {[plugins::search::match $what $subjtext] || \
-		   [plugins::search::match $what $bodytext]} {
-		plugins::search::bwtree::search_hilite $tw $n
-		if {[search_in_article_up $body $subj $sentry]} {
-		    return $n
-		}
-	    }
-	}
-	if {$n == $node} break
-	set n [plugins::search::bwtree::prev_node $tw $n]
-    }
-    return ""
-}
-
-#############################################################################
-
-proc headlines::search::search_in_article_up {body subj sentry} {
-    set what [$sentry get]
-    if {![string length $what]} {
-	return ""
-    }
-
-    catch {
-	set bfirst [$body index search_highlight.first]
-	set blast [$body index search_highlight.last]
-    }
-    catch {
-	set sfirst [$subj index search_highlight.first]
-	set slast [$subj index search_highlight.last]
-    }
-
-    if {![info exists sfirst]} {
-	# Try to find pattern in article body
-
-	plugins::search::do_text_search $body $sentry 1
-	if {![catch {
-		  set bfirst1 [$body index search_highlight.first]
-		  set blast1 [$body index search_highlight.last]
-	      }]} {
-	    if {![info exists bfirst]} {
-		return 1
-	    }
-	    if {[$body compare $bfirst1 < $bfirst] || \
-		 ([$body compare $bfirst1 == $bfirst] && [$body compare $blast1 < $blast])} {
-		return 1
-	    }
-	    $body tag remove search_highlight 0.0 end
-	}
-
-	$subj mark set sel_start end
-	$subj mark set sel_end 0.0
-    }
-    # Then try to find pattern in the subject
-    plugins::search::do_text_search $subj $sentry 1
-    if {![catch {
-	      set sfirst1 [$subj index search_highlight.first]
-	      set slast1 [$subj index search_highlight.last]
-	  }]} {
-	if {![info exists sfirst]} {
-	    return 1
-	}
-	if {[$subj compare $sfirst1 < $sfirst] || \
-	     ([$subj compare $sfirst1 == $sfirst] && [$subj compare $slast1 < $slast])} {
-	    return 1
-	}
-	$subj tag remove search_highlight 0.0 end
-    }
-    return 0
-}
-
-#############################################################################
-
-proc headlines::search::search_down {hw tw uw dw node sentry} {
-    set what [$sentry get]
-    if {![string length $what]} {
-	return ""
-    }
-
-    set body $hw.body
-    set subj $dw.subject.subj
-
-    # Try to search in current article
-    if {[search_in_article_down $body $subj $sentry]} {
-	return $node
-    }
-
-    set n [plugins::search::bwtree::next_node $tw $node]
-    while {1} {
-	if {($n != "root") && \
-		![catch { array set props [$tw itemcget $n -data] }] && \
-		[info exists props(type)] && \
-		$props(type) == "article"} {
-
-	    set subjtext [string map [list "\n" " "] $props(text)]
-	    set bodytext "$props(body)\n\n[::msgcat::mc {Read on...}]"
-	    if {[plugins::search::match $what $subjtext] || \
-		   [plugins::search::match $what $bodytext]} {
-		plugins::search::bwtree::search_hilite $tw $n
-		if {[search_in_article_down $body $subj $sentry]} {
-		    return $n
-		}
-	    }
-	}
-	if {$n == $node} break
-	set n [plugins::search::bwtree::next_node $tw $n]
-    }
-    return ""
-}
-
-#############################################################################
-
-proc headlines::search::search_in_article_down {body subj sentry} {
-    set what [$sentry get]
-    if {![string length $what]} {
-	return ""
-    }
-
-    catch {
-	set bfirst [$body index search_highlight.first]
-	set blast [$body index search_highlight.last]
-    }
-    catch {
-	set sfirst [$subj index search_highlight.first]
-	set slast [$subj index search_highlight.last]
-    }
-
-    if {![info exists bfirst]} {
-	# Try to find pattern in article subject
-
-	plugins::search::do_text_search $subj $sentry 0
-	if {![catch {
-		  set sfirst1 [$subj index search_highlight.first]
-		  set slast1 [$subj index search_highlight.last]
-	      }]} {
-	    if {![info exists sfirst]} {
-		return 1
-	    }
-	    if {[$subj compare $sfirst1 > $sfirst] || \
-		 ([$subj compare $sfirst1 == $sfirst] && [$subj compare $slast1 > $slast])} {
-		return 1
-	    }
-	    $subj tag remove search_highlight 0.0 end
-	}
-
-	$body mark set sel_start end
-	$body mark set sel_end 0.0
-    }
-    # Then try to find pattern in the body
-    plugins::search::do_text_search $body $sentry 0
-    if {![catch {
-	      set bfirst1 [$body index search_highlight.first]
-	      set blast1 [$body index search_highlight.last]
-	  }]} {
-	if {![info exists bfirst]} {
-	    return 1
-	}
-	if {[$body compare $bfirst1 > $bfirst] || \
-	     ([$body compare $bfirst1 == $bfirst] && [$body compare $blast1 > $blast])} {
-	    return 1
-	}
-	$body tag remove search_highlight 0.0 end
-    }
-    return 0
-}
-
-##########################################################################
-

Modified: trunk/tkabber/plugins/search/browser.tcl
===================================================================
--- trunk/tkabber/plugins/search/browser.tcl	2007-03-04 10:32:59 UTC (rev 1001)
+++ trunk/tkabber/plugins/search/browser.tcl	2007-03-04 11:07:50 UTC (rev 1002)
@@ -7,45 +7,21 @@
     hook::add open_disco_post_hook [namespace current]::setup_panel
 }
 
-proc search::browser::open_panel {w sw sf} {
-    set sentry $sf.search
-	
+proc search::browser::open_panel {sw sf} {
     pack $sf -side bottom -anchor w -fill x -before $sw
-    focus $sentry
 }
 
-proc search::browser::close_panel {sf tw} {
+proc search::browser::close_panel {tw sf} {
     pack forget $sf
     focus $tw
 }
 
 proc search::browser::setup_panel {w sw tw} {
-    set sf [frame $w.search]
+    set sf [plugins::search::spanel $w.search \
+		-searchcommand [list [namespace parent]::bwtree::do_search $tw] \
+		-closecommand [list [namespace current]::close_panel $tw]]
 
-    set sentry \
-	[entry $sf.search \
-	       -validate all \
-	       -validatecommand [list [namespace parent]::validate_entry %W %P]]
-    pack $sentry -padx 1m -side left
-
-    set sbox [ButtonBox $sf.sbox -spacing 0]
-    $sbox add -text [::msgcat::mc "Search up"] \
-         -command [list [namespace parent]::bwtree::do_search $tw $sentry 1]
-    $sbox add -text [::msgcat::mc "Search down"] \
-         -command [list [namespace parent]::bwtree::do_search $tw $sentry 0]
-    pack $sbox -side left -padx 1m
-    
-    set cbox [ButtonBox $sf.cbox -spacing 0]
-    $cbox add -text [::msgcat::mc "Close"] \
-         -command [list [namespace current]::close_panel $sf $tw]
-    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 [namespace current]::close_panel $sf $tw]]
-
     bind $tw.c <<OpenSearchPanel>> \
-	[double% [list [namespace current]::open_panel $w $sw $sf]]
+	[double% [list [namespace current]::open_panel $sw $sf]]
 }
 

Modified: trunk/tkabber/plugins/search/chat.tcl
===================================================================
--- trunk/tkabber/plugins/search/chat.tcl	2007-03-04 10:32:59 UTC (rev 1001)
+++ trunk/tkabber/plugins/search/chat.tcl	2007-03-04 11:07:50 UTC (rev 1002)
@@ -6,17 +6,13 @@
     hook::add open_chat_post_hook [namespace current]::setup_panel
 }
 
-proc search::chat::open_panel {sf chatw} {
-    set sentry $sf.search
-
+proc search::chat::open_panel {chatw sf} {
     pack $sf -side bottom -anchor w -fill x -before [winfo parent $chatw].csw
-    focus $sentry
-
     update idletasks
     $chatw see end
 }
 
-proc search::chat::close_panel {sf chatid} {
+proc search::chat::close_panel {chatid sf} {
     set cw [chat::winid $chatid]
     set chatw [chat::chat_win $chatid]
 
@@ -32,32 +28,11 @@
     $chatw mark set sel_start end
     $chatw mark set sel_end 0.0
 
-    set sf [frame [winfo parent $chatw].search]
+    set sf [plugins::search::spanel [winfo parent $chatw].search \
+		-searchcommand [list [namespace parent]::do_text_search $chatw] \
+		-closecommand [list [namespace current]::close_panel $chatid]]
 
-    set sentry \
-	[entry $sf.search \
-	       -validate all \
-	       -validatecommand [list [namespace parent]::validate_entry %W %P]]
-    pack $sentry -padx 1m -side left
-
-    set sbox [ButtonBox $sf.sbox -spacing 0]
-    $sbox add -text [::msgcat::mc "Search up"] \
-         -command [list [namespace parent]::do_text_search $chatw $sentry 1]
-    $sbox add -text [::msgcat::mc "Search down"] \
-         -command [list [namespace parent]::do_text_search $chatw $sentry 0]
-    pack $sbox -side left -padx 1m
-    
-    set cbox [ButtonBox $sf.cbox -spacing 0]
-    $cbox add -text [::msgcat::mc "Close"] \
-         -command [list [namespace current]::close_panel $sf $chatid]
-    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 [namespace current]::close_panel $sf $chatid]]
-
     bind $cw.input <<OpenSearchPanel>> \
-	[double% [list [namespace current]::open_panel $sf $chatw]]
+	[double% [list [namespace current]::open_panel $chatw $sf]]
 }
 

Modified: trunk/tkabber/plugins/search/custom.tcl
===================================================================
--- trunk/tkabber/plugins/search/custom.tcl	2007-03-04 10:32:59 UTC (rev 1001)
+++ trunk/tkabber/plugins/search/custom.tcl	2007-03-04 11:07:50 UTC (rev 1002)
@@ -6,17 +6,13 @@
     hook::add open_custom_post_hook [namespace current]::setup_panel
 }
 
-proc search::custom::open_panel {sf w} {
-    set sentry $sf.search
-
+proc search::custom::open_panel {w sf} {
     pack $sf -side bottom -anchor w -fill x -before $w.sw
-    focus $sentry
-
     update idletasks
     $w.fields see end
 }
 
-proc search::custom::close_panel {sf w} {
+proc search::custom::close_panel {w sf} {
     $w.fields tag remove search_highlight 0.0 end
     pack forget $sf
     focus $w.fields
@@ -28,32 +24,11 @@
     $fields mark set sel_start end
     $fields mark set sel_end 0.0
 
-    set sf [frame $w.search]
+    set sf [plugins::search::spanel $w.search \
+		-searchcommand [list [namespace parent]::do_text_search $fields] \
+		-closecommand [list [namespace current]::close_panel $w]]
 
-    set sentry \
-	[entry $sf.search \
-	       -validate all \
-	       -validatecommand [list [namespace parent]::validate_entry %W %P]]
-    pack $sentry -padx 1m -side left
-
-    set sbox [ButtonBox $sf.sbox -spacing 0]
-    $sbox add -text [::msgcat::mc "Search up"] \
-         -command [list [namespace parent]::do_text_search $fields $sentry 1]
-    $sbox add -text [::msgcat::mc "Search down"] \
-         -command [list [namespace parent]::do_text_search $fields $sentry 0]
-    pack $sbox -side left -padx 1m
-    
-    set cbox [ButtonBox $sf.cbox -spacing 0]
-    $cbox add -text [::msgcat::mc "Close"] \
-         -command [list [namespace current]::close_panel $sf $w]
-    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 [namespace current]::close_panel $sf $w]]
-
     bind $fields <<OpenSearchPanel>> \
-	[double% [list [namespace current]::open_panel $sf $w]]
+	[double% [list [namespace current]::open_panel $w $sf]]
 }
 

Added: trunk/tkabber/plugins/search/headlines.tcl
===================================================================
--- trunk/tkabber/plugins/search/headlines.tcl	                        (rev 0)
+++ trunk/tkabber/plugins/search/headlines.tcl	2007-03-04 11:07:50 UTC (rev 1002)
@@ -0,0 +1,240 @@
+# $Id$
+#############################################################################
+
+namespace eval headlines::search {}
+
+proc headlines::search::open_panel {w dw sf} {
+    pack $sf -side bottom -anchor w -fill x -before $dw.sw
+    update idletasks
+    $w.body see end
+}
+
+#############################################################################
+
+proc headlines::search::close_panel {w tw sf} {
+    $w.body tag remove search_highlight 0.0 end
+    pack forget $sf
+    focus $tw
+}
+
+#############################################################################
+
+proc headlines::search::setup_panel {w tw uw dw} {
+    set body $w.body
+
+    $body mark set sel_start end
+    $body mark set sel_end 0.0
+
+    set sf [plugins::search::spanel $w.search \
+		-searchcommand [list [namespace current]::do_search $w $tw $uw $dw] \
+		-closecommand [list [namespace current]::close_panel $w $tw]]
+
+    foreach ww [list $tw.c $w.body $dw.date.ts $dw.from.jid $dw.subject.subj] {
+	bind $ww <<OpenSearchPanel>> \
+	     [double% [list [namespace current]::open_panel $w $dw $sf]]
+    }
+}
+
+hook::add open_headlines_post_hook \
+	  [namespace current]::headlines::search::setup_panel
+
+#############################################################################
+
+proc headlines::search::do_search {hw tw uw dw pattern dir} {
+    if {![string length $pattern]} {
+	return 0
+    }
+
+    if {$dir == "up"} {
+	set start_node [lindex [$tw selection get] 0]
+	if {$start_node == ""} {
+	    set start_node root
+	}
+	set node [search_up $hw $tw $uw $dw $start_node $pattern]
+    } else {
+	set start_node [lindex [$tw selection get] end]
+	if {$start_node == ""} {
+	    set start_node root
+	}
+	set node [search_down $hw $tw $uw $dw $start_node $pattern]
+    }
+
+    if {$node != ""} {
+	return 1
+    } else {
+	return 0
+    }
+}
+
+##########################################################################
+
+proc headlines::search::search_up {hw tw uw dw node pattern} {
+    set body $hw.body
+    set subj $dw.subject.subj
+
+    # Try to search in current article
+    if {[search_in_article_up $body $subj $pattern]} {
+	return $node
+    }
+
+    set n [plugins::search::bwtree::prev_node $tw $node]
+    while {1} {
+	if {($n != "root") && \
+		![catch { array set props [$tw itemcget $n -data] }] && \
+		[info exists props(type)] && \
+		$props(type) == "article"} {
+
+	    set subjtext [string map [list "\n" " "] $props(text)]
+	    set bodytext "$props(body)\n\n[::msgcat::mc {Read on...}]"
+	    if {[plugins::search::match $pattern $subjtext] || \
+		   [plugins::search::match $pattern $bodytext]} {
+		plugins::search::bwtree::search_hilite $tw $n
+		if {[search_in_article_up $body $subj $pattern]} {
+		    return $n
+		}
+	    }
+	}
+	if {$n == $node} break
+	set n [plugins::search::bwtree::prev_node $tw $n]
+    }
+    return ""
+}
+
+#############################################################################
+
+proc headlines::search::search_in_article_up {body subj pattern} {
+    catch {
+	set bfirst [$body index search_highlight.first]
+	set blast [$body index search_highlight.last]
+    }
+    catch {
+	set sfirst [$subj index search_highlight.first]
+	set slast [$subj index search_highlight.last]
+    }
+
+    if {![info exists sfirst]} {
+	# Try to find pattern in article body
+
+	plugins::search::do_text_search $body $pattern up
+	if {![catch {
+		  set bfirst1 [$body index search_highlight.first]
+		  set blast1 [$body index search_highlight.last]
+	      }]} {
+	    if {![info exists bfirst]} {
+		return 1
+	    }
+	    if {[$body compare $bfirst1 < $bfirst] || \
+		 ([$body compare $bfirst1 == $bfirst] && [$body compare $blast1 < $blast])} {
+		return 1
+	    }
+	    $body tag remove search_highlight 0.0 end
+	}
+
+	$subj mark set sel_start end
+	$subj mark set sel_end 0.0
+    }
+    # Then try to find pattern in the subject
+    plugins::search::do_text_search $subj $pattern up
+    if {![catch {
+	      set sfirst1 [$subj index search_highlight.first]
+	      set slast1 [$subj index search_highlight.last]
+	  }]} {
+	if {![info exists sfirst]} {
+	    return 1
+	}
+	if {[$subj compare $sfirst1 < $sfirst] || \
+	     ([$subj compare $sfirst1 == $sfirst] && [$subj compare $slast1 < $slast])} {
+	    return 1
+	}
+	$subj tag remove search_highlight 0.0 end
+    }
+    return 0
+}
+
+#############################################################################
+
+proc headlines::search::search_down {hw tw uw dw node pattern} {
+    set body $hw.body
+    set subj $dw.subject.subj
+
+    # Try to search in current article
+    if {[search_in_article_down $body $subj $pattern]} {
+	return $node
+    }
+
+    set n [plugins::search::bwtree::next_node $tw $node]
+    while {1} {
+	if {($n != "root") && \
+		![catch { array set props [$tw itemcget $n -data] }] && \
+		[info exists props(type)] && \
+		$props(type) == "article"} {
+
+	    set subjtext [string map [list "\n" " "] $props(text)]
+	    set bodytext "$props(body)\n\n[::msgcat::mc {Read on...}]"
+	    if {[plugins::search::match $pattern $subjtext] || \
+		   [plugins::search::match $pattern $bodytext]} {
+		plugins::search::bwtree::search_hilite $tw $n
+		if {[search_in_article_down $body $subj $pattern]} {
+		    return $n
+		}
+	    }
+	}
+	if {$n == $node} break
+	set n [plugins::search::bwtree::next_node $tw $n]
+    }
+    return ""
+}
+
+#############################################################################
+
+proc headlines::search::search_in_article_down {body subj pattern} {
+    catch {
+	set bfirst [$body index search_highlight.first]
+	set blast [$body index search_highlight.last]
+    }
+    catch {
+	set sfirst [$subj index search_highlight.first]
+	set slast [$subj index search_highlight.last]
+    }
+
+    if {![info exists bfirst]} {
+	# Try to find pattern in article subject
+
+	plugins::search::do_text_search $subj $pattern down
+	if {![catch {
+		  set sfirst1 [$subj index search_highlight.first]
+		  set slast1 [$subj index search_highlight.last]
+	      }]} {
+	    if {![info exists sfirst]} {
+		return 1
+	    }
+	    if {[$subj compare $sfirst1 > $sfirst] || \
+		 ([$subj compare $sfirst1 == $sfirst] && [$subj compare $slast1 > $slast])} {
+		return 1
+	    }
+	    $subj tag remove search_highlight 0.0 end
+	}
+
+	$body mark set sel_start end
+	$body mark set sel_end 0.0
+    }
+    # Then try to find pattern in the body
+    plugins::search::do_text_search $body $pattern down
+    if {![catch {
+	      set bfirst1 [$body index search_highlight.first]
+	      set blast1 [$body index search_highlight.last]
+	  }]} {
+	if {![info exists bfirst]} {
+	    return 1
+	}
+	if {[$body compare $bfirst1 > $bfirst] || \
+	     ([$body compare $bfirst1 == $bfirst] && [$body compare $blast1 > $blast])} {
+	    return 1
+	}
+	$body tag remove search_highlight 0.0 end
+    }
+    return 0
+}
+
+##########################################################################
+


Property changes on: trunk/tkabber/plugins/search/headlines.tcl
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Revision
Name: svn:eol-style
   + native

Modified: trunk/tkabber/plugins/search/logger.tcl
===================================================================
--- trunk/tkabber/plugins/search/logger.tcl	2007-03-04 10:32:59 UTC (rev 1001)
+++ trunk/tkabber/plugins/search/logger.tcl	2007-03-04 11:07:50 UTC (rev 1002)
@@ -6,17 +6,13 @@
     hook::add open_log_post_hook [namespace current]::setup_panel
 }
 
-proc search::logger::open_panel {sf w tw} {
-    set sentry $sf.search
-
+proc search::logger::open_panel {w tw sf} {
     pack $sf -side bottom -anchor w -fill x -before $w.sw
-    focus $sentry
-
     update idletasks
     $tw see end
 }
 
-proc search::logger::close_panel {sf tw} {
+proc search::logger::close_panel {tw sf} {
     $tw tag remove search_highlight 0.0 end
     pack forget $sf
 }
@@ -27,32 +23,11 @@
     $tw mark set sel_start end
     $tw mark set sel_end 0.0
 
-    set sf [frame $w.search]
+    set sf [plugins::search::spanel $w.search \
+		-searchcommand [list [namespace parent]::do_text_search $tw] \
+		-closecommand [list [namespace current]::close_panel $tw]]
 
-    set sentry \
-	[entry $sf.search \
-	       -validate all \
-	       -validatecommand [list [namespace parent]::validate_entry %W %P]]
-    pack $sentry -padx 1m -side left
-
-    set sbox [ButtonBox $sf.sbox -spacing 0]
-    $sbox add -text [::msgcat::mc "Search up"] \
-         -command [list [namespace parent]::do_text_search $tw $sentry 1]
-    $sbox add -text [::msgcat::mc "Search down"] \
-         -command [list [namespace parent]::do_text_search $tw $sentry 0]
-    pack $sbox -side left -padx 1m
-    
-    set cbox [ButtonBox $sf.cbox -spacing 0]
-    $cbox add -text [::msgcat::mc "Close"] \
-         -command [list [namespace current]::close_panel $sf $tw]
-    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 [namespace current]::close_panel $sf $tw]]
-
     bind $w <<OpenSearchPanel>> \
-	[double% [list [namespace current]::open_panel $sf $w $tw]]
+	[double% [list [namespace current]::open_panel $w $tw $sf]]
 }
 

Modified: trunk/tkabber/plugins/search/rawxml.tcl
===================================================================
--- trunk/tkabber/plugins/search/rawxml.tcl	2007-03-04 10:32:59 UTC (rev 1001)
+++ trunk/tkabber/plugins/search/rawxml.tcl	2007-03-04 11:07:50 UTC (rev 1002)
@@ -6,17 +6,13 @@
     hook::add open_rawxml_post_hook [namespace current]::setup_panel
 }
 
-proc search::rawxml::open_panel {sf w} {
-    set sentry $sf.search
-
+proc search::rawxml::open_panel {w sf} {
     pack $sf -side bottom -anchor w -fill x -before $w.sw
-    focus $sentry
-
     update idletasks
     $w.dump see end
 }
 
-proc search::rawxml::close_panel {sf w} {
+proc search::rawxml::close_panel {w sf} {
     $w.dump tag remove search_highlight 0.0 end
     pack forget $sf
     focus $w.input
@@ -28,32 +24,11 @@
     $dump mark set sel_start end
     $dump mark set sel_end 0.0
 
-    set sf [frame [winfo parent $dump].search]
+    set sf [plugins::search::spanel [winfo parent $dump].search \
+		-searchcommand [list [namespace parent]::do_text_search $dump] \
+		-closecommand [list [namespace current]::close_panel $w]]
 
-    set sentry \
-	[entry $sf.search \
-	       -validate all \
-	       -validatecommand [list [namespace parent]::validate_entry %W %P]]
-    pack $sentry -padx 1m -side left
-
-    set sbox [ButtonBox $sf.sbox -spacing 0]
-    $sbox add -text [::msgcat::mc "Search up"] \
-         -command [list [namespace parent]::do_text_search $dump $sentry 1]
-    $sbox add -text [::msgcat::mc "Search down"] \
-         -command [list [namespace parent]::do_text_search $dump $sentry 0]
-    pack $sbox -side left -padx 1m
-    
-    set cbox [ButtonBox $sf.cbox -spacing 0]
-    $cbox add -text [::msgcat::mc "Close"] \
-         -command [list [namespace current]::close_panel $sf $w]
-    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 [namespace current]::close_panel $sf $w]]
-
     bind $w.input <<OpenSearchPanel>> \
-	[double% [list [namespace current]::open_panel $sf $w]]
+	[double% [list [namespace current]::open_panel $w $sf]]
 }
 

Modified: trunk/tkabber/plugins/search/search.tcl
===================================================================
--- trunk/tkabber/plugins/search/search.tcl	2007-03-04 10:32:59 UTC (rev 1001)
+++ trunk/tkabber/plugins/search/search.tcl	2007-03-04 11:07:50 UTC (rev 1002)
@@ -3,7 +3,6 @@
 ##########################################################################
 
 option add *highlightSearchBackground        PaleGreen1    widgetDefaul
-option add *noMatchesBackground		     pink          widgetDefaul
 
 ##########################################################################
 
@@ -46,25 +45,6 @@
     return 1
 }
 
-proc search::panel_colorize_entry {e color_resource} {
-    variable default_bg
-
-    if {![info exists default_bg]} {
-	set default_bg [lindex [$e configure -background] 4]
-    }
-
-    if {$color_resource == "default"} {
-	set bg $default_bg
-    } else {
-	set bg [option get $e $color_resource {}]
-	if {$bg == {}} {
-	    set bg $default_bg
-	}
-    }
-
-    $e configure -background $bg
-}
-
 ##########################################################################
 # Search in text widget
 
@@ -86,15 +66,14 @@
 		\"   \\"} $pattern
 }
 
-proc search::do_text_search {txt entr back} {
+proc search::do_text_search {txt pattern dir} {
     variable options
 	
-    set searchpattern [$entr get]
-    if {![string length $searchpattern]} {
+    if {![string length $pattern]} {
 	return 0
     }
 
-    if {$back} {
+    if {$dir == "up"} {
 	set search_from sel_start
 	set search_to   0.0
 	set search_dir  -backwards
@@ -116,7 +95,7 @@
 	}
 	glob {
 	    set exact -regexp
-	    set searchpattern [glob2regexp $searchpattern]
+	    set pattern [glob2regexp $pattern]
 	}
 	default {
 	    set exact -exact
@@ -124,18 +103,17 @@
     }
 
     if {[catch { eval [list $txt] search $search_dir $case $exact -- \
-			   [list $searchpattern $search_from] } index]} {
+			   [list $pattern $search_from] } index]} {
 	set index {}
     }
 
     if {![string length $index]} {
-	panel_colorize_entry $entr noMatchesBackground
  	return 0
     } else {
 	$txt tag remove search_highlight 0.0 end
 	if {$exact == "-regexp"} {
 	    set line [$txt get $index "$index lineend"]
-	    eval regexp $case -- [list $searchpattern $line] match
+	    eval regexp $case -- [list $pattern $line] match
 	    $txt tag add search_highlight $index "$index + [string length $match] chars"
 	    if {[string length $match] == 0} {
 		set nohighlight 1
@@ -143,8 +121,8 @@
 		set nohighlight 0
 	    }
 	} else {
-	    $txt tag add search_highlight $index "$index + [string length $searchpattern] chars"
-	    if {[string length $searchpattern] == 0} {
+	    $txt tag add search_highlight $index "$index + [string length $pattern] chars"
+	    if {[string length $pattern] == 0} {
 		set nohighlight 1
 	    } else {
 		set nohighlight 0
@@ -156,7 +134,7 @@
 	    $txt mark set sel_start search_highlight.first
 	    $txt mark set sel_end search_highlight.last
 	    $txt see $index
-	    panel_colorize_entry $entr background
+	    return 1
 	}
     }
 }
@@ -277,13 +255,12 @@
 
 ##########################################################################
 
-proc search::bwtree::do_search {tw sentry back} {
-    set searchpattern [$sentry get]
-    if {![string length $searchpattern]} {
+proc search::bwtree::do_search {tw pattern dir} {
+    if {![string length $pattern]} {
 	return 0
     }
 
-    if {$back} {
+    if {$dir == "up"} {
 	set start_node [lindex [$tw selection get] 0]
 	if {$start_node == ""} {
 	    set start_node root
@@ -291,7 +268,7 @@
 	set node [search_node $tw \
 			      [namespace current]::prev_node \
 			      $start_node \
-			      $searchpattern]
+			      $pattern]
     } else {
 	set start_node [lindex [$tw selection get] end]
 	if {$start_node == ""} {
@@ -300,15 +277,13 @@
 	set node [search_node $tw \
 			      [namespace current]::next_node \
 			      $start_node \
-			      $searchpattern]
+			      $pattern]
     }
 
     if {$node != ""} {
 	search_hilite $tw $node
-	[namespace parent]::panel_colorize_entry $sentry background 
 	return 1
     } else {
-	[namespace parent]::panel_colorize_entry $sentry noMatchesBackground
 	return 0
     }
 }

Added: trunk/tkabber/plugins/search/spanel.tcl
===================================================================
--- trunk/tkabber/plugins/search/spanel.tcl	                        (rev 0)
+++ trunk/tkabber/plugins/search/spanel.tcl	2007-03-04 11:07:50 UTC (rev 1002)
@@ -0,0 +1,106 @@
+# $Id$
+# Generic horizontal search panel.
+
+##########################################################################
+
+option add *noMatchesBackground		     pink          widgetDefaul
+
+##########################################################################
+
+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
+
+#
+# Recognized options:
+# -searchcommand
+# -opencommand
+# -closecommand
+#
+# May be?
+# -defdir (what direction does Return search)
+#
+proc search::spanel {w args} {
+    set opencmd ""
+    set closecmd ""
+    foreach {key val} $args {
+	switch -- $key {
+	    -searchcommand {
+		set searchcmd $val
+	    }
+	    -opencommand {
+		set opencmd $val
+	    }
+	    -closecommand {
+		set closecmd $val
+	    }
+	}
+    }
+
+    if {![info exists searchcmd]} {
+	error "missing mandatory option: -searchcmd"
+    }
+
+    frame $w
+
+    set sentry [entry $w.sentry \
+		    -validate all \
+		    -validatecommand [namespace code {validate_entry %W %P}]]
+    pack $sentry -padx 1m -side left
+
+    set bg [lindex [$sentry configure -background] 4]
+
+    bind $w <Map> [namespace code [list spanel_open [double% $w] \
+						    [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]]
+    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
+
+    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
+
+    set w
+}
+
+proc search::spanel_search {sentry searchcmd dir dbg} {
+    set found [eval $searchcmd [list [$sentry get] $dir]]
+
+    if {$found} {
+	set bg $dbg
+    } else {
+	set bg [option get $sentry noMatchesBackground ""]
+	if {$bg == ""} {
+	    set bg $dbg
+	}
+    }
+
+    $sentry configure -background $bg
+}
+
+proc search::spanel_open {w opencmd} {
+    if {$opencmd != ""} {
+	eval $opencmd [list $w]
+    }
+    focus $w.sentry
+}
+
+proc search::spanel_close {w closecmd} {
+    if {$closecmd != ""} {
+	eval $closecmd [list $w]
+    }
+}
+


Property changes on: trunk/tkabber/plugins/search/spanel.tcl
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Revision
Name: svn:eol-style
   + native



More information about the Tkabber-dev mailing list