# search.tcl --
# search/replace
#
# Copyright (c) 1996 by Sun Microsystems
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

proc Search_UI {win} {
    global search

    set t .search
    if [winfo exists $t] {
	wm deiconify $t
	raise $t
    } else {
	toplevel $t
	wm title $t "WebTk Search Window"
	wm iconname $t "Search"

	set search(html) 0
	set search(regexp) -exact
	set search(nocase) {}
	set search(replhtml) 0
	set search(again) 1

	set f [frame $t.but]
	pack $f -side top -fill x -pady 5 -padx 5
	button $f.quit -text Dismiss -command [list wm withdraw $t]
	button $f.help -text "Help" -command Search_Help
	label $f.status -textvariable search(status) -anchor w

	pack $f.quit $f.help -side right
	pack $f.status -side top -fill x

	label $t.url
	pack $t.url -side top -anchor w -padx 5

	set f [frame $t.find]
	pack $f -side top -fill x -pady 5 -padx 5
	button $f.next -text "Next" -command Search_Next
	button $f.prev -text "Previous" -command Search_Prev
	entry $f.entry -textvar search(find)
	pack $f.prev $f.next -side left
	pack $f.entry -side top -fill x
	bind $f.entry <Return> Search_Next

	set f [frame $t.fopt]
	pack $f -side top -fill x -pady 5 -padx 5
	label $f.label -text "Find Options:" -anchor e
	checkbutton $f.regexp -text "Pattern" -variable search(regexp) \
	    -onvalue -regexp -offvalue -exact
	checkbutton $f.nocase -text "Ignore case" -variable search(nocase) \
	    -onvalue -nocase -offvalue {}
	pack $f.label $f.nocase $f.regexp -side left

	set f [frame $t.repl]
	pack $f -side top -fill x -pady 5 -padx 5
	button $f.repl -text "Replace" -command Search_Replace
	button $f.replall -text "Replace All" -command Search_ReplaceAll
	entry $f.entry -textvar search(repl)
	pack $f.replall $f.repl -side left
	pack $f.entry -side top -fill x
	bind $f.entry <Return> Search_Replace

	set f [frame $t.ropt]
	pack $f -side top -fill x -pady 5 -padx 5
	label $f.label -text "Replace Options:" -anchor e
	checkbutton $f.again -text "Find after replace" -variable search(again) \
	    -onvalue 1 -offvalue 0
	checkbutton $f.html -text "HTML markup" -variable search(replhtml) \
	    -onvalue 1 -offvalue 0
	pack $f.label $f.again $f.html -side left

    }
    set search(t) $t
    set search(win) $win	;# target search
    upvar #0 HM$win var
    $t.url config -text $var(S_url)
    focus $t.find.entry
    Search_EditMode $win [Input_Edit $search(win)]
    SearchStatus ""
}
proc Search_EditMode {win editbool} {
    global search
    if ![info exists search(win)] {
	return
    }
    if {$win == $search(win)} {
	set t $search(t)
	if !$editbool {
	    $t.repl.repl config -state disabled
	    $t.repl.replall config -state disabled
	} else {
	    $t.repl.repl config -state normal
	    $t.repl.replall config -state normal
	}
    }
}
proc SearchStatus {string} {
    global search
    set search(status) $string
    Status $search(win) $string
}
proc Search_Next {} {
    global search
    set mark insert
    catch {set mark [$search(win) index sel.last]}
    Search_Find -forw $mark
}
proc Search_Prev {} {
    Search_Find -back insert
}
proc Search_Find {dir mark} {
    global search
    if {[string length $search(find)] == 0} {
	focus $search(t).find.entry
	SearchStatus "Enter search string"
	raise $search(t)
	return 0
    }
    if {$search(html)} {
	return [Search_Html]
    } else {
	set ix [eval {$search(win) search} \
		    $search(regexp) $search(nocase) $dir -count nchars -- \
		    {$search(find) $mark}]
	if {[string compare $ix {}] != 0} {
	    Text_MarkSet $search(win) insert $ix
	    Text_SelClear $search(win)
	    Text_TagAdd $search(win) sel insert "insert + $nchars c"
	    InputSetTags  $search(win) force
	    raise  $search(win)
	    $search(win) see insert
	    SearchStatus ok
	    return 1
	} else {
	    SearchStatus "Pattern not found"
	    return 0
	}
    }
}
proc Search_Replace {} {
    global search
    if ![SearchArgs] {
	return
    }
    Undo_Mark $search(win) Search_Replace
    SearchReplaceOne
    if {$search(again)} {
	Search_Next
    }
    Undo_Mark $search(win) Search_ReplaceEnd
}
proc Search_ReplaceAll {} {
    global search
    if ![SearchArgs] {
	return
    }
    Undo_Mark $search(win) Search_Replace
    set mark insert
    catch {set mark [$search(win) index sel.last]}
    set last [$search(win) index $mark]
    set start $last
    set wrap 0
    while {[Search_Next]} {
	if {$wrap && [$search(win) compare $start <= insert]} {
	    break
	}
	SearchReplaceOne
	if [$search(win) compare insert < $last] {
	    if {$wrap} {
		break
	    }
	    set wrap 1
	}
	set last [$search(win) index insert]
    }
    focus $search(win)
    Undo_Mark $search(win) Search_ReplaceEnd
}

proc SearchArgs {} {
    global search
    if {[string length $search(repl)] == 0} {
	focus $search(t).repl.entry
	SearchStatus "Enter replacement string"
	raise $search(t)
	return 0
    }
    if [catch {$search(win) index sel.first} ix] {
	SearchStatus "Find or select something to replace."
	return 0
    }
    return 1
}
proc SearchReplaceOne {} {
    global search
    upvar #0 HM$search(win) var
    Text_MarkSet $search(win) insert sel.first
    InputSetTags  $search(win) force
    Text_Delete  $search(win) sel.first sel.last
    if {$search(replhtml)} {
	Edit_PasteHtml $search(win) $search(repl)
    } else {
	Text_Insert $search(win) insert $search(repl) $var(inserttags)
    }
    Input_Dirty $search(win)
}
proc Search_Help {} {
    global WebTk
    Url_DisplayNew file:[file join $WebTk(html) search.html]
}
