#!/bin/sh
# the next line restarts using wish\
exec wish8.0 "$0" "$@" 
if {![info exist vTcl(sourcing)]} {

}

############################
# code to load stock fonts


if {![info exist vTcl(sourcing)]} {
set vTcl(fonts,counter) 0
proc vTcl:font:add_font {font_descr font_type newkey} {

     global vTcl

     incr vTcl(fonts,counter)
     set newfont [eval font create $font_descr]

     lappend vTcl(fonts,objects) $newfont

     # each font has its unique key so that when a project is
     # reloaded, the key is used to find the font description

     if {$newkey == ""} {
          set newkey vTcl:font$vTcl(fonts,counter)
     }

     set vTcl(fonts,$newfont,type)                      $font_type
     set vTcl(fonts,$newfont,key)                       $newkey
     set vTcl(fonts,$vTcl(fonts,$newfont,key),object)   $newfont

     # in case caller needs it
     return $newfont
}

proc vTcl:font:get_font {key} {

	global vTcl

	return $vTcl(fonts,$key,object)
}

vTcl:font:add_font \
    "-family helvetica -size 12 -weight normal -slant roman -underline 0 -overstrike 0" \
    stock \
    vTcl:font1
vTcl:font:add_font \
    "-family helvetica -size 12 -weight normal -slant roman -underline 1 -overstrike 0" \
    stock \
    underline
vTcl:font:add_font \
    "-family courier -size 12 -weight normal -slant roman -underline 0 -overstrike 0" \
    stock \
    vTcl:font3
vTcl:font:add_font \
    "-family times -size 12 -weight normal -slant roman -underline 0 -overstrike 0" \
    stock \
    vTcl:font4
vTcl:font:add_font \
    "-family helvetica -size 12 -weight bold -slant roman -underline 0 -overstrike 0" \
    stock \
    vTcl:font5
vTcl:font:add_font \
    "-family courier -size 12 -weight bold -slant roman -underline 0 -overstrike 0" \
    stock \
    vTcl:font6
vTcl:font:add_font \
    "-family times -size 12 -weight bold -slant roman -underline 0 -overstrike 0" \
    stock \
    vTcl:font7
vTcl:font:add_font \
    "-family lucida -size 18 -weight normal -slant roman -underline 0 -overstrike 0" \
    stock \
    vTcl:font8
vTcl:font:add_font \
    "-family lucida -size 18 -weight normal -slant italic -underline 0 -overstrike 0" \
    stock \
    vTcl:font9
}
############################
# code to load user fonts

#############################################################################
# Visual Tcl v1.22 Project
#

#################################
# GLOBAL VARIABLES
#
global reString; 
global searchString; 
global widget; 
set w $widget(codetext)
#################################
# USER DEFINED PROCEDURES
#

proc {highlight} {w} {
proc textToggle {cmd1} {
          catch {eval $cmd1}
      }
    if {[winfo depth $w] > 1} {
            textToggle "$w tag configure search -background  red -foreground white" 
    } else {
            textToggle "$w tag configure search -background  black -foreground white" 
    }
}

proc {textReplace} {w sstring dstring} {
$w tag remove search 0.0 end
    if {$sstring == ""} {
	return
    }
    set cur 1.0
    set length [string length $sstring]
    if {$length!=0} {
       while 1 {
       	   
	   set cur [$w search -count length $sstring $cur end]
	   #puts stdout $length
	   #set cur to be the first search index,and length is seted to
	   #the num of the pattern 
	   if {$cur == ""} {
	     break
	   }
	   #if find nothing the same as pattern ,break out
	   $w delete $cur "$cur + $length char"
	   $w insert $cur "$dstring"
	   set cur [$w index "$cur + [string length $dstring] char"]
        }
    }
}

proc {textSearch} {w string tag} {
$w tag remove search 0.0 end
    if {$string == ""} {
	return
    }
    set cur 1.0
    set length [string length $string]
    if {$length!=0} {
    		set cur [$w search -count length $string $cur end]
    		if {$cur == ""} {
    		tk_messageBox -message "No Matchable string finded!"
	    	return
	    	}
        while 1 {
            
	    set cur [$w search -count length $string $cur end]
	    #puts stdout $length
	    #set cur to be the first search index,and length is seted to
	    #the num of the pattern 
	    if {$cur == ""} {
	    break
	    }
	    #if find nothing the same as pattern ,break out
	    $w tag add $tag $cur "$cur + $length char"
	    set cur [$w index "$cur + $length char"]
       }
    }
}

proc {main} {} {
wm protocol .top17 WM_DELETE_WINDOW {
textSearch $w \"\" search
highlight $w
destroy .top17
}
}

proc {Window} {args} {
global vTcl
    set cmd [lindex $args 0]
    set name [lindex $args 1]
    set newname [lindex $args 2]
    set rest [lrange $args 3 end]
    if {$name == "" || $cmd == ""} {return}
    if {$newname == ""} {
        set newname $name
    }
    set exists [winfo exists $newname]
    switch $cmd {
        show {
            if {$exists == "1" && $name != "."} {wm deiconify $name; return}
            if {[info procs vTclWindow(pre)$name] != ""} {
                eval "vTclWindow(pre)$name $newname $rest"
            }
            if {[info procs vTclWindow$name] != ""} {
                eval "vTclWindow$name $newname $rest"
            }
            if {[info procs vTclWindow(post)$name] != ""} {
                eval "vTclWindow(post)$name $newname $rest"
            }
        }
        hide    { if $exists {wm withdraw $newname; return} }
        iconify { if $exists {wm iconify $newname; return} }
        destroy { if $exists {destroy $newname; return} }
    }
}


#################################
# VTCL GENERATED GUI PROCEDURES
#

proc vTclWindow. {base {container 0}} {
    if {$base == ""} {
        set base .
    }
    ###################
    # CREATING WIDGETS
    ###################
    if {!$container} {
    wm focusmodel $base passive
    wm geometry $base 200x200+0+0
    wm maxsize $base 1028 746
    wm minsize $base 115 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm withdraw $base
    wm title $base "vt"
    }
    ###################
    # SETTING GEOMETRY
    ###################
}

proc vTclWindow.top17 {base {container 0}} {
    if {$base == ""} {
        set base .top17
    }
    if {[winfo exists $base] && (!$container)} {
        wm deiconify $base; return
    }
    ###################
    # CREATING WIDGETS
    ###################
    if {!$container} {
    toplevel $base -class Toplevel \
        -menu "$base.m17" 
    wm transient $base .codeEditor
    wm focusmodel $base passive
    wm geometry $base 398x96+316+241
    wm maxsize $base 398 96
    wm minsize $base 398 96
    wm overrideredirect $base 0
    wm resizable $base 0 0
    wm deiconify $base
    wm title $base "Find and Replace"
    }
    label $base.lab18 \
        -borderwidth 0 -relief sunken -text {Find what:} 
    frame $base.fra19 \
        -borderwidth 2 -relief flat
    entry $base.fra19.ent19 \
        -relief groove -textvariable searchString 
    button $base.but20 \
        \
        -command {
        textSearch $w $searchString search
        highlight $w
        } \
        -relief groove -text Find 
    label $base.lab22 \
        -borderwidth 1 -text {Replace with:}
    frame $base.fra20 \
        -borderwidth 2 -relief flat
    entry $base.fra20.ent23 \
        -relief groove -textvariable reString 
    button $base.but24 \
        -command {
        	textReplace $w $searchString $reString
        	} \
        -relief groove -text {Replace All} 
    button $base.but26 \
        \
        -command {
        	textSearch $w \"\" search
                highlight $w
                destroy .top17} \
        -relief groove -text Close 
    menu $base.m17 \
        -cursor {} 
    ###################
    # SETTING GEOMETRY
    ###################
    place $base.lab18 \
        -x 10 -y 20 -width 63 -height 17 -anchor nw -bordermode ignore 
    place $base.fra19 \
        -x 90 -y 20 -width 210 -height 25 -anchor nw -bordermode ignore 
    pack $base.fra19.ent19 \
    	-in $base.fra19 -anchor e -expand 1 -side right -fill both -pady 1 
    place $base.but20 \
        -x 310 -y 10 -width 75 -height 23 -anchor nw -bordermode ignore 
    place $base.lab22 \
        -x 10 -y 55 -width 69 -height 17 -anchor nw -bordermode ignore
    place $base.fra20 \
        -x 90 -y 50 -width 210 -height 25 -anchor nw -bordermode ignore  
    pack $base.fra20.ent23 \
    	-in $base.fra20 -anchor e -expand 1 -side right -fill both -pady 1 
    place $base.but24 \
        -x 310 -y 37 -width 75 -height 23 -anchor nw -bordermode ignore 
    place $base.but26 \
        -x 310 -y 64 -width 75 -height 23 -anchor nw -bordermode ignore 
}

Window show .
Window show .top17

main 
