Tk Source Code

Artifact eb7f2c34afcc2a1c0c07f7a248395a8cc787b0ba:

# this code was partly "stolen" from tkcon, and msgbox.tcl
# So thanks to Jeff Hobbs and the Tcl Community

proc ::tk_textFind { win args } {
    # create suffix to create a unique toplevel name
    set suffix [string map {{.} {}} $win]
    set suffix [string toupper $suffix 0 0]

    set specs {
	{-case "" "" "0"}
	{-direction "" "" "forwards"}
	{-highlightcolor "" "" "pink"}
	{-regexp "" "" "0"}
	{-parent "" "" .}
	{-nextcolor "" "" "blue"}
	{-searchstring "" "" ""}
	{-title "" "" " "}
    }

    set w ::tk::PrivFindDlg$suffix
    upvar $w data
    tclParseConfigSpec $w $specs "" $args
    # parray ::tk::PrivFindDlg$suffix

    if {![winfo exists $data(-parent)]} {
	error "bad window path name \"$data(-parent)\""
    }

    # create new window or raise existing
    #
    set widgets($suffix,win) .__tk__find$suffix
    set w .__tk__find$suffix

    if {[winfo exists $widgets($suffix,win)]} {
	focus $widgets($suffix,win)
	raise $widgets($suffix,win)
	return
    }

    toplevel $widgets($suffix,win) -class Find
    wm title $widgets($suffix,win) $data(-title)
    wm resizable $widgets($suffix,win) no no

    # Find dialog should be transient.
    # Code "stolen" from msgbox.tcl
    #
    if {[winfo viewable [winfo toplevel $data(-parent)]]} {
	wm transient $w $data(-parent)
    }

    if {[tk windowingsystem] eq "aqua"} {
	unsupported::MacWindowStyle style $w dBoxProc
    }

    # search string
    set inputf $widgets($suffix,win).f1
    frame $inputf -takefocus no

    set l1 $inputf.l1
    label $l1 -text [::msgcat::mc LblSearchString]
    set widgets($suffix,word) $inputf.word
    entry $widgets($suffix,word) -width 30 \
	    -textvariable ::tk::PrivFindDlg${suffix}(-searchstring)

    pack $l1 -side left
    pack $widgets($suffix,word) -side left

    # option frame
    set optf $widgets($suffix,win).f2
    frame $optf -takefocus no
    set widgets($suffix,caseOpt) $optf.caseChkBtn
    checkbutton $widgets($suffix,caseOpt) \
	    -text [mc ChkBtnFindCaseOpt] \
	    -variable ::tk::PrivFindDlg${suffix}(-case) \
	    -state normal
    set widgets($suffix,regexpOpt) $optf.regexpChkBtn
    checkbutton $widgets($suffix,regexpOpt) \
	    -text [mc ChkBtnFindRegexpOpt] \
	    -variable ::tk::PrivFindDlg${suffix}(-regexp) \
	    -state normal

    pack $widgets($suffix,caseOpt) $widgets($suffix,regexpOpt) \
	    -side top -anchor nw

    # direction frame
    set dirf $widgets($suffix,win).f3
    labelframe $dirf -takefocus no -text [::msgcat::mc LblDirection]

    set widgets($suffix,beginOpt) $dirf.beginCbx
    radiobutton $widgets($suffix,beginOpt) \
	    -text [mc RdoBtnFindDirOpt1] \
	    -variable ::tk::PrivFindDlg${suffix}(-direction) \
	    -value forwards \
	    -state normal
    set widgets($suffix,endOpt) $dirf.endCbx
    radiobutton $widgets($suffix,endOpt) \
	    -text [mc RdoBtnFindDirOpt2] \
	    -variable ::tk::PrivFindDlg${suffix}(-direction) \
	    -value backwards \
	    -state normal

    pack $widgets($suffix,beginOpt) $widgets($suffix,endOpt) \
	    -side top -anchor w -pady 5 -padx 5

    # button frame
    #
    set cmdf $widgets($suffix,win).f4
    frame $cmdf -takefocus no

    set widgets($suffix,find) $cmdf.find
    button $widgets($suffix,find) -text [mc BtnFind] \
	    -command [list ::tk::doFind $win ""]
    set widgets($suffix,findNext) $cmdf.findNext
    button $widgets($suffix,findNext) -text [mc BtnFindNext] \
	    -command [list ::tk::doFind $win findNext ]
    set widgets($suffix,Close) $cmdf.findClose
    button $widgets($suffix,Close) -text [mc BtnClose] \
	    -command [list destroy $widgets($suffix,win)]

    pack $widgets($suffix,find) $widgets($suffix,findNext) \
	    $widgets($suffix,Close) \
	    -side top -pady 5 -fill both -expand yes

    # show all frames
    grid $inputf -row 0 -column 0 -columnspan 2 -pady {10 5}
    grid $optf	 -row 1 -column 0 -sticky nw
    grid $dirf	 -row 1 -column 1 -padx 5 -pady {0 10}
    grid $cmdf	 -row 0 -column 2 -rowspan 2 -padx 10  -pady {10 0} -sticky s
}

proc ::tk::doFind { win cmd args } {
    # create suffix to create a unique toplevel name
    set suffix [string map {{.} {}} $win]
    set suffix [string toupper $suffix 0 0]

    set w ::tk::PrivFindDlg$suffix
    upvar $w data

    set search(begin) 1.0
    set search(end) end
    set search(op) +
    set search(first) first
    set search(rangecmd) nextrange
    set search(rangeidx) 1

    set opts ""
    lappend opts -$data(-direction)
    if {$data(-direction) eq  "backward"} {
	set search(begin) end
	set search(end) 1.0
	set search(op) -
	set search(first) last
	set search(rangecmd) prevrange
	set search(rangeidx) 0
    }

    if {!$data(-case)} {
	lappend opts -nocase
    }

    if {$data(-regexp)} {
	lappend opts -regexp
    }

    # empty string ? - nothing todo
    #
    if {$data(-searchstring) eq ""} {
	return
    }

    # clean previous search
    #
    $win tag remove find 1.0 end
    $win tag remove curfind 1.0 end

    $win mark set findmark $search(begin)
    while {[set ix [$win search {expand}$opts -count numc -- \
	    $data(-searchstring) findmark $search(end)]] ne ""} {
	catch {$win tag add find $ix ${ix}+${numc}c}
	catch {$win mark set findmark ${ix}$search(op)1c}
    }
    $win tag configure find -background $data(-highlightcolor)
    catch {$win see find.$search(first)}

    # we highlight the next occurence of the search string
    # and move the text window to it
    if {$cmd eq "findNext"} {
	$win tag configure curfind -background $data(-nextcolor)
	catch {set tmp "$data(last)$search(op)1c"} err
	if {[regexp -- {Error*} $err]} {
	    return
	}

	set range [list 0.0 end]

	catch {set range [$win tag $search(rangecmd) find $tmp]}
	if {[lindex $range 0] eq "0.0" && [lindex $range 1] eq "end"} {
	    catch {set range [$win tag $search(rangecmd) find $search(begin)]}
	}

	catch {$win see [lindex $range $search(rangeidx)]$search(op)1c}
	set data(last) [lindex $range 0]
	catch {$win tag add curfind [lindex $range 0] [lindex $range 1]}
    } else {
	catch {set data(last) find.$search(first)}
    }
}