[Tkabber-dev] r892 - in trunk/tkabber: . ifacetk msgs plugins/general

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Tue Jan 30 22:25:46 MSK 2007


Author: sergei
Date: 2007-01-30 22:25:42 +0300 (Tue, 30 Jan 2007)
New Revision: 892

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/ifacetk/iface.tcl
   trunk/tkabber/messages.tcl
   trunk/tkabber/msgs/uk.msg
   trunk/tkabber/muc.tcl
   trunk/tkabber/plugins/general/headlines.tcl
Log:
	* ifacetk/iface.tcl: Fixed description.

	* messages.tcl: Enabled sending normal message to groupchat users.

	* muc.tcl: Fixed sometimes duplicated MUC menu entries.

	* plugins/general/headlines.tcl: Added search in headlines.

	* msgs/uk.msg: Updated (thanks to Artem Bondarenko).


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2007-01-29 13:22:55 UTC (rev 891)
+++ trunk/tkabber/ChangeLog	2007-01-30 19:25:42 UTC (rev 892)
@@ -1,3 +1,15 @@
+2007-01-30  Sergei Golovan  <sgolovan at nes.ru>
+
+	* ifacetk/iface.tcl: Fixed description.
+
+	* messages.tcl: Enabled sending normal message to groupchat users.
+
+	* muc.tcl: Fixed sometimes duplicated MUC menu entries.
+
+	* plugins/general/headlines.tcl: Added search in headlines.
+
+	* msgs/uk.msg: Updated (thanks to Artem Bondarenko).
+
 2007-01-27  Sergei Golovan  <sgolovan at nes.ru>
 
 	* datagathering.tcl: Made data form windows transient and made

Modified: trunk/tkabber/ifacetk/iface.tcl
===================================================================
--- trunk/tkabber/ifacetk/iface.tcl	2007-01-29 13:22:55 UTC (rev 891)
+++ trunk/tkabber/ifacetk/iface.tcl	2007-01-30 19:25:42 UTC (rev 892)
@@ -421,7 +421,7 @@
 \n[::msgcat::mc Common:]
     $::tk_modify-S\t\t\t[::msgcat::mc {Activate search panel}]
 \n[::msgcat::mc Chats:]
-    TAB\t\t\t[::msgcat::mc {Complete nicknames and /commands}]
+    TAB\t\t\t[::msgcat::mc {Complete nicknames and commands}]
     $::tk_modify-Up/Down\t\t[::msgcat::mc {Previous/Next history message}]
     Alt-E\t\t\t[::msgcat::mc {Show palette of emoticons}]
     $::tk_modify-Z\t\t\t[::msgcat::mc {Undo}]

Modified: trunk/tkabber/messages.tcl
===================================================================
--- trunk/tkabber/messages.tcl	2007-01-29 13:22:55 UTC (rev 891)
+++ trunk/tkabber/messages.tcl	2007-01-30 19:25:42 UTC (rev 892)
@@ -278,18 +278,16 @@
     destroy $w
 }
 
-proc message::send_dialog_item {state m connid jid} {
+proc message::send_dialog_item {m connid jid} {
     $m add command -label [::msgcat::mc "Send message..."] \
-	-state $state \
 	-command [list message::send_dialog \
 		       -to $jid -connection $connid]
 }
 
-hook::add roster_jid_popup_menu_hook {message::send_dialog_item normal} 15
-hook::add message_dialog_menu_hook {message::send_dialog_item normal} 15
-hook::add search_popup_menu_hook {message::send_dialog_item normal} 15
-hook::add roster_create_groupchat_user_menu_hook \
-    {message::send_dialog_item disabled} 15
+hook::add roster_jid_popup_menu_hook message::send_dialog_item 15
+hook::add message_dialog_menu_hook message::send_dialog_item 15
+hook::add search_popup_menu_hook message::send_dialog_item 15
+hook::add roster_create_groupchat_user_menu_hook message::send_dialog_item 15
 
 package require sha1
 

Modified: trunk/tkabber/msgs/uk.msg
===================================================================
--- trunk/tkabber/msgs/uk.msg	2007-01-29 13:22:55 UTC (rev 891)
+++ trunk/tkabber/msgs/uk.msg	2007-01-30 19:25:42 UTC (rev 892)
@@ -2,11 +2,10 @@
 
 # ukrainian messages file
 # writed by levsha at jabber.net.ua. Last change 10.03.2006
-# updated by uzver at jabber.kiev.ua Last change 30.12.2006
+# updated by uzver at jabber.kiev.ua Last change 28.01.2007
 # Vypravleno i dopovneno pereklad na Tkabber 0.9.9
-# Pereklady na plaginy budut` dodani u vidpovidni teky /msgs kozhnohgo plaginu
+# Pereklady na plaginy dodani u vidpovidni teky /msgs kozhnohgo plaginu
 # charset - UTF8
-# Z NOVYM ROKOM PANOVE!
 
 ::msgcat::mcset uk "#" "№"
 ::msgcat::mcset uk "Aborted" "Перервано"
@@ -581,7 +580,7 @@
 ::msgcat::mcset uk "/me has set the subject to: %s" "/me змінив(ла) тему на: %s"
 ::msgcat::mcset uk "Mechanism too weak" "Занадто слабкий механізм"
 ::msgcat::mcset uk "Message" "Повідомлення"
-::msgcat::mcset uk "Message and Headline options." "Параметри повідомлень і новин ."
+::msgcat::mcset uk "Message and Headline options." "Параметри повідомлень і новин."
 ::msgcat::mcset uk "Message archive" "Архів повідомлень"
 ::msgcat::mcset uk "Message body" "Тіло повідомлення"
 ::msgcat::mcset uk "Message delivered to %s" "Повідомлення доставлене %s"
@@ -1478,13 +1477,13 @@
 ::msgcat::mcset uk "%s has entered" "%s увійшов"
 ::msgcat::mcset uk "Generate status messages when occupants enter/exit MUC compatible conference rooms." "Генерувати статусні повідомлення, коли учасники заходять/залишають сумісні з MUC конференції."
 ::msgcat::mcset uk "and" "і"
-::msgcat::mcset uk "doesn't want to be disturbed" "Не хоче, щоб його турбували"
-::msgcat::mcset uk "is available" "Доступний"
-::msgcat::mcset uk "is away" "Відійшов"
-::msgcat::mcset uk "is extended away" "Відійшов давно"
-::msgcat::mcset uk "is free to chat" "Вільний для чату"
-::msgcat::mcset uk "is invisible" "Невидимий"
-::msgcat::mcset uk "is unavailable" "Недоступний"
+::msgcat::mcset uk "doesn't want to be disturbed" "не хоче, щоб його турбували"
+::msgcat::mcset uk "is available" "доступний"
+::msgcat::mcset uk "is away" "відійшов"
+::msgcat::mcset uk "is extended away" "відійшов давно"
+::msgcat::mcset uk "is free to chat" "вільний для чату"
+::msgcat::mcset uk "is invisible" "невидимий"
+::msgcat::mcset uk "is unavailable" "недоступний"
 ::msgcat::mcset uk "Tkabber emoticons theme. To make new theme visible for Tkabber put it to some subdirectory of ~/.tkabber/emoticons." "Смалики для Ткаббера. Щоб нові теми були доступними для Ткаббера, то покладіть їх до підтеки ~/.tkabber/emoticons."
 ::msgcat::mcset uk "Fetch nickname" "Отримати псевдонім"
 ::msgcat::mcset uk "Fetch user nicknames" "Отримати псевдоніми користувача"
@@ -1514,6 +1513,34 @@
 ::msgcat::mcset uk "October" "Жовтень"
 ::msgcat::mcset uk "Please, be patient while chats history is being converted to new format" "Будь-ласка, зачекайте поки історія буде зконвертована у новий формат" 
 ::msgcat::mcset uk "September" "Вересень"
+::msgcat::mcset uk "Show TkCon console" "Показати ТКконсоль"
+::msgcat::mcset uk "Could not start ispell server. Check your ispell path and dictionary name. Ispell is disabled now" "Невдалий запуск ispell сервера. Перевірте шлях до ispell і назву словника. Ispell вимкнено"
+::msgcat::mcset uk "Enable spellchecker in text input windows." "Увімкнути перевірку правопису в полях вводу текста."
+::msgcat::mcset uk "Uses:" "Використовує:"
+::msgcat::mcset uk "Timeout" "Таймаут"
+::msgcat::mcset uk "Edit MUC ignore rules" "Редагувати правила ігнору для групових чатів"
+::msgcat::mcset uk "Error loading MUC ignore rules, purged." "Помилка завантаження правил ігнору для групових чатів, очищено."
+::msgcat::mcset uk "Ignore chat messages" "Ігнорувати повідомлення чату"
+::msgcat::mcset uk "Ignore groupchat messages" "Ігнорувати повідомлення в груповому чаті"
+::msgcat::mcset uk "Ignoring groupchat and chat messages from selected occupants of multi-user conference rooms." "Ігнорування повідомлень в груповому і звичайному чаті з обраних учасників групових чатів." 
+::msgcat::mcset uk "MUC Ignore" "Ігнорування в групових чатах"
+::msgcat::mcset uk "MUC Ignore Rules" "Правила ігнорування в групових чатах"
+::msgcat::mcset uk "Occupant ignoring" "Ігнорування учасника"
+::msgcat::mcset uk "Ping server using (urn:xmpp:ping) requests." "Пінгувати сервер використовуючи запити типу (urn:xmpp:ping)."
+::msgcat::mcset uk "Reconnect to server if it does not reply (with result or with error) to ping (urn:xmpp:ping) request in specified time interval (in seconds)." "Перез'єднатися з сервером у разі відсутності відповіді (з результатом чи з помилкою) на запити типу пінг (urn:xmpp:ping) через N секунд"
+::msgcat::mcset uk "Reply to ping (urn:xmpp:ping) requests." "Відповідь на запити типу пінг (urn:xmpp:ping)."
+::msgcat::mcset uk "Attention" "Увага"
+::msgcat::mcset uk "Please stand by..." "Будь-ласка, заждіть"
+::msgcat::mcset uk "Please, be patient while Tkabber configuration directory is being transferred to the new location" "Будь-ласка, зачекайте доки тека з налаштуваннями Ткаббера буде переміщення на нове місце"
+::msgcat::mcset uk "Tkabber configuration directory transfer failed with:\n%s\n Tkabber will use the old directory:\n%s" "Переміщення теки з налаштуваннями Ткаббера невдалося з:\n%s\n Ткаббер буде використовувати стару теку:\n%s"
+::msgcat::mcset uk "Your new Tkabber config directory is now:\n%s\nYou can delete the old one:\n%s" "Зараз ваші налаштування Ткаббера знаходяться в теці:\n%s\nВи можете видалити попередню теку з налаштуваннями:\n%s"
+::msgcat::mcset uk "Copy JID to clipboard" "Копіювати JID до буферу обміна"
+::msgcat::mcset uk "Activate search panel" "Активувати панель пошуку"
+::msgcat::mcset uk "Common:" "Загальний:"
+::msgcat::mcset uk "Complete nicknames and commands" "Доповнити псевдоніми і команди"
+::msgcat::mcset uk "Middle mouse button" "Середня кнопка мишки"
+::msgcat::mcset uk "Show palette of emoticons" "Показувати палітру іконок емоцій"
+::msgcat::mcset uk "When set, all changes to the ignore rules are applied only until Tkabber is closed; they are not saved and thus will be not restored at the next run." "Коли встановлено, то всі зміни в правила ігнорувань діють до моменту вимкнення Ткаббера; вони не зберігаються, а отже - не будуть відновлені при слідуючому запуску."
 
 namespace eval :: {
 proc load_ukrainian_procs {} {

Modified: trunk/tkabber/muc.tcl
===================================================================
--- trunk/tkabber/muc.tcl	2007-01-29 13:22:55 UTC (rev 891)
+++ trunk/tkabber/muc.tcl	2007-01-30 19:25:42 UTC (rev 892)
@@ -105,6 +105,10 @@
 
     trace variable ::muc::muc_compatible($jid) w \
 	[list muc::add_conference_menu_items $m $chatid $idx]
+
+    bind $m <Destroy> [list trace vdelete ::muc::muc_compatible($jid) w \
+			    [list muc::add_conference_menu_items $m $chatid $idx]]
+
 }
     
 hook::add chat_create_conference_menu_hook muc::create_conference_menu_items 37

Modified: trunk/tkabber/plugins/general/headlines.tcl
===================================================================
--- trunk/tkabber/plugins/general/headlines.tcl	2007-01-29 13:22:55 UTC (rev 891)
+++ trunk/tkabber/plugins/general/headlines.tcl	2007-01-30 19:25:42 UTC (rev 892)
@@ -124,25 +124,43 @@
 
     frame $dw.date
     label $dw.date.label -anchor w -text [::msgcat::mc "Date:"]
-    label $dw.date.ts -font $font -anchor w
+    entry $dw.date.ts -font $font \
+		      -takefocus 0 \
+		      -highlightthickness 0 \
+		      -relief flat
     pack $dw.date -fill x
     pack $dw.date.label -side left
-    pack $dw.date.ts -side left
+    pack $dw.date.ts -side left -fill x -expand yes
 
     frame $dw.from
     label $dw.from.label -anchor w -text [::msgcat::mc "From:"]
-    label $dw.from.jid -font $font -anchor w
+    entry $dw.from.jid -font $font \
+		       -takefocus 0 \
+		       -highlightthickness 0 \
+		       -relief flat
     pack $dw.from -fill x
     pack $dw.from.label -side left
-    pack $dw.from.jid -side left
+    pack $dw.from.jid -side left -fill x -expand yes
 
     frame $dw.subject
     label $dw.subject.lsubj -anchor w -text [::msgcat::mc "Subject:"]
-    label $dw.subject.subj -font $font -anchor w
+    text $dw.subject.subj -font $font \
+			  -height 1 \
+			  -takefocus 0 \
+			  -highlightthickness 0 \
+			  -relief flat \
+			  -state disabled \
+			  -background [option get $dw.subject background Frame]
     pack $dw.subject -fill x
     pack $dw.subject.lsubj -side left
-    pack $dw.subject.subj -side left
+    pack $dw.subject.subj -side left -fill x -expand yes
 
+    foreach ent [list $dw.date.ts $dw.from.jid] {
+	if {[catch {$ent configure -state readonly}]} {
+	    $ent configure -state disabled
+	}
+    }
+
     if {![info exists options(seencolor)]} {
 	if {[cequal $tcl_platform(platform) unix]} {
 	    set options(seencolor) [option get $hw disabledForeground JBrowser]
@@ -183,12 +201,14 @@
 
     bind $hw.body <ButtonPress-1> [list focus %W]
 
-    bind $hw.body <Key-Up>    [list Tree::_keynav up    $tw]
-    bind $hw.body <Key-Down>  [list Tree::_keynav down  $tw]
-    bind $hw.body <Key-Left>  [list Tree::_keynav left  $tw]
-    bind $hw.body <Key-Right> [list Tree::_keynav right $tw]
+    foreach ww [list $hw.body $dw.date.ts $dw.from.jid $dw.subject.subj] {
+	bind $ww <Key-Up>    [list Tree::_keynav up    $tw]
+	bind $ww <Key-Down>  [list Tree::_keynav down  $tw]
+	bind $ww <Key-Left>  [list Tree::_keynav left  $tw]
+	bind $ww <Key-Right> [list Tree::_keynav right $tw]
+    }
 
-    hook::run open_headlines_post_hook $hw
+    hook::run open_headlines_post_hook $hw $tw $uw $dw
 }
 
 #############################################################################
@@ -330,11 +350,26 @@
 	set date [clock format $props(seconds)]
 	set url $props(url)
     }
-    
-    $wdate configure -text $date
-    $wfrom configure -text $from
-    $wsubj configure -text $subj
-    
+
+    foreach {w s} [list $wdate $date \
+			$wfrom $from] {
+	$w configure -state normal
+	$w delete 0 end
+	$w insert 0 $s
+	if {[catch {$w configure -state readonly}]} {
+	    $w configure -state disabled
+	}
+    }
+
+    $wsubj configure -state normal
+    $wsubj delete 0.0 end
+    $wsubj insert 0.0 $subj
+
+    $wsubj mark set sel_start end
+    $wsubj mark set sel_end 0.0
+
+    $wsubj configure -state disabled
+
     $wbody configure -state normal
     $wbody delete 0.0 end
     ::richtext::render_message $wbody "$body\n\n" ""
@@ -344,6 +379,10 @@
 			   [winfo parent $tw] $node] \
 			-title [::msgcat::mc "Read on..."]
     }
+
+    $wbody mark set sel_start end
+    $wbody mark set sel_end 0.0
+
     $wbody configure -state disabled
 }
 
@@ -883,4 +922,290 @@
 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
+}
+
+##########################################################################
+



More information about the Tkabber-dev mailing list