Attachment "tkchat-search.diff" to
ticket [627521ffff]
added by
pascalscheffers
2002-10-23 22:07:58.
--- tkchat.tcl.cvs Wed Oct 23 16:53:07 2002
+++ tkchat.tcl Wed Oct 23 16:50:37 2002
@@ -67,6 +67,15 @@
"%user% looks at the clock and dashes out the door" \
"%user% macht wie eine Banane ..." \
]
+
+ #for searching through the message buffer:
+ # - The previous search command (so I know when to reset
+ # the searchOffset
+ variable searchString ""
+ # - When repeating a search of the same term, we must know the last
+ # offset to start from there
+ variable searchOffset end
+
}
set ::DEBUG 1
@@ -1787,6 +1796,65 @@
}
+proc ::tkchat::doSearch { msg } {
+ #search in chat window, msg should be *exactly* what the user typed,
+ #including '/?'
+
+ if { [regexp {^/\?(.+)} $msg -> newSearch] } {
+ if { ![string equal $newSearch $::tkchat::searchString] } {
+ #new search string differs from the previous, new search!
+
+ set ::tkchat::searchString $newSearch
+ set ::tkchat::searchOffset end
+
+ #clear all current search marks:
+ set marks [.txt tag ranges found]
+ for { set i 0 } { $i < [llength $marks] } { incr i 2 } {
+ .txt tag remove found [lindex $marks $i] [lindex $marks [expr $i+1]]
+ }
+
+ }
+ }
+
+ #do we need to search at all?
+ if { ![string equal $::tkchat::searchString ""] } {
+
+ set foundAt [.txt search -count foundLength \
+ -regexp \
+ -backwards \
+ -nocase -- \
+ $::tkchat::searchString \
+ $::tkchat::searchOffset]
+
+ if { ![string equal $foundAt ""] } {
+ #yes, the expression was found
+
+ set foundLine [lindex [split $foundAt .] 0]
+ set foundChar [lindex [split $foundAt .] 1]
+
+ .txt tag add found $foundAt \
+ "$foundLine.[expr $foundChar + $foundLength]"
+
+ .txt see $foundAt
+
+ #figure out the previous character:
+ if { $foundChar == 0 } {
+ #decrement line no, not char pos.
+ set ::tkchat::searchOffset "[expr $foundLine -1].99999"
+ } else {
+ #decrement char pos:
+ set ::tkchat::searchOffset "$foundLine.[expr $foundChar - 1]"
+ }
+ } else {
+ if { [string equal $::tkchat::searchOffset end] } {
+ addSystem "Bummer. Could not find '$::tkchat::searchString'"
+ }
+ }
+ }
+
+}
+
+
proc ::tkchat::userPost {} {
global Options
if {[winfo ismapped .eMsg]} {
@@ -1819,6 +1887,18 @@
"^/macros?$" {
tkchat::EditMacros
}
+ "^/\\?" {
+ doSearch $msg
+ }
+ "^/!" {
+ #reset search and move to end
+ set marks [.txt tag ranges found]
+ for { set i 0 } { $i < [llength $marks] } { incr i 2 } {
+ .txt tag remove found [lindex $marks $i] [lindex $marks [expr $i+1]]
+ }
+ set ::tkchat::searchOffset end
+ .txt see end
+ }
default {
# might be server command - pass it on
msgSend $msg
@@ -2157,7 +2237,7 @@
}]
}
grid x $f.allWeb $f.allInv $f.allMine x -padx 1 -pady 1
- foreach {idx str} {MainBG Background MainFG Foreground} {
+ foreach {idx str} {MainBG Background MainFG Foreground SearchBG Searchbackgr} {
buildRow $f $idx $str
}
grid [label $f.online -text "Online Users" -font SYS] - - -
@@ -2219,6 +2299,7 @@
# update colors
.txt config -bg "#[getColor MainBG]" -fg "#[getColor MainFG]"
.names config -bg "#[getColor MainBG]" -fg "#[getColor MainFG]"
+ .txt tag configure found -background "#[getColor SearchBG]"
foreach nk $Options(NickList) {
.txt tag config NICK-$nk -foreground "#[getColor $nk]"
}
@@ -2832,7 +2913,7 @@
set Options(URL) $::tkchat::HOST/cgi-bin/chat.cgi
set Options(URL2) $::tkchat::HOST/cgi-bin/chat2.cgi
set Options(URLlogs) $::tkchat::HOST/tchat/logs
- foreach {name clr} { MainBG FFFFFF MainFG 000000 } {
+ foreach {name clr} { MainBG FFFFFF MainFG 000000 SearchBG FF8C44} {
set Options(Color,$name,Web) $clr
set Options(Color,$name,Inv) [invClr $clr]
set Options(Color,$name,Mine) $clr
