#!/usr/local/bin/wish8.3

. configure -bg black

wm geometry . 756x368+60+3

text .text_widget -yscrollcommand ".scroll set" \
-font {Helvetica 12} \
-highlightbackground black \
-bg black \
-fg white \
-insertbackground yellow \
-insertwidth 5 \
-wrap word

#Get the window size and report to the user.
#This is useful for changing the automatic size of the window.
bind .text_widget <Alt-g> {set window_info [wm geometry .]; \
tk_messageBox -type ok \
 -title Message -message $window_info}

scrollbar .scroll -command ".text_widget yview" \
-bg black \
-highlightbackground black \
-activebackground gray60 \
-troughcolor gray60
 
pack .scroll -side right -fill y
pack .text_widget -expand yes -fill both

global filedata savefile
wm protocol . WM_DELETE_WINDOW {close_clean}

proc close_clean {} {
global filedata savefile
catch [close $filedata; close $savefile]
exit
}

bind . <Control-c> {tk_textCut .text_widget}
bind . <Alt-c> {tk_textCopy .text_widget}
#Control-p is already bound by Tk in the text widget.
bind . <Alt-p> {tk_textPaste .text_widget}

bind . <Control-q> {close_clean}
bind . <End> {run_tags}
bind . <Alt-e> {open "|./$argv"}
bind . <Alt-s> {.text_widget tag add sel 1.0 end}

#WORKON
bind . <Control-f> {
destroy .findbox
global search
set search search_is_active

#This is used to get the pointer position, for later on placing the find dialog box.
set X [winfo pointerx .]
set Y [winfo pointery .]
 
toplevel .findbox
bind .findbox <Control-c> {set search "search_is_inactive"; destroy .findbox}
wm geometry .findbox +$X+$Y
wm protocol .findbox WM_DELETE_WINDOW {set search "search_is_inactive"; destroy .findbox}

entry .findbox.find_this -font {Helvetica 18} \
-textvariable find_this_string -bg black \
-fg white -insertbackground yellow \
-insertwidth 5
pack .findbox.find_this

bind .findbox.find_this <Return> {search_text "$find_this_string" find_tag; find_search}

#I hope the user actually uses a window manager.

after 1 {raise_find_box}
 }
#ENDP

#This does weird stuff in MS Windows.
proc raise_find_box {} {

catch [raise .findbox .text_widget]
after 1 {raise_find_box}
}


#
# Search for pattern, highlight, and blink text.
#

proc find_search {} {
global search
if {$search == "search_is_active"} {

.text_widget tag configure find_tag \
-background yellow -foreground blue

after 500 {.text_widget tag configure find_tag \
-background blue -foreground yellow}

after 1000 {find_search}
} 
# I hate using if {} else {}, because it makes life a pain.
#This way I know exactly what should be in the variable.
if {$search == "search_is_inactive"} {
#puts "In find_search else"

.text_widget tag configure find_tag -background black -foreground white

.text_widget tag delete find_tag

after 1 {run_tags}
}

}

#
# Open an existing file or create a new file.
#

if [file exists $argv] {

#For Windows paths this will need to regsub to remove the slash and convert it.  
#I played with with regsub and couldn't figure it out in 30 minutes, so I left it and started using tcsh instead.
#The bad part about this is that if you are calling Ged from the registry association, 
#because the argument for the path will not work in Windows.
global filedata
set filedata [open $argv]
.text_widget insert end [read $filedata]
close $filedata

} else {

#Apparently if puts is run without a console it causes a resource leak.
#After learning about the resource leak problem I decided to have the title display things like this.
#puts "File does not exist, so I created a new file."
wm title . "File does not exist, so I created a new file."
set newfile [open $argv w]
close $newfile
} 

#I need to add the ability to check for a space, or newline after the string, 
#to make sure that the string is something like this: text rather than search_text.
#In the tags below the search_text procedure I solved part of it.
proc search_text {string tagname} {
.text_widget tag remove search 0.0 end
if {$string == ""} {
return
}
set cur 1.0
while 1 {
set cur [.text_widget search -count length -- $string  $cur end]
if {$cur == ""} {
break
}
.text_widget tag add $tagname $cur "$cur + $length char"
set cur [.text_widget index "$cur + $length char"]
}
}

set file_number_saved 0

bind . <Control-s> {

global save_file
set save_file [open $argv w]
puts -nonewline $save_file [.text_widget get 1.0 end-1c]
#The close is very important!
#The file will be ruined if it is not closed.
close $save_file

set file_number_saved [expr $file_number_saved + 1]

if {$file_number_saved == 1} {wm title . "Saved $argv $file_number_saved time"; update}
if {$file_number_saved > 1} {wm title . "Saved $argv $file_number_saved times"; update}

}

#This runs the syntax highlighting during the startup.
after 100 {run_tags}

#This is called at the beginning, or when the user presses end.
proc run_tags {} {
global argv

.text_widget configure -cursor watch
wm title . "Searching through $argv to highlight tags..."
update

#Having a space at the end of the argument ensures that we don't highlight something like entry_blah.
search_text "entry " entry_tag
.text_widget tag configure entry_tag -foreground MediumPurple2

search_text "destroy " destroy_tag
.text_widget tag configure destroy_tag -foreground red

search_text "scrollbar " scrollbar_tag 
.text_widget tag configure scrollbar_tag -foreground MediumPurple2

search_text "tk_textPaste" tk_textPaste_tag 
.text_widget tag configure tk_textPaste_tag -foreground MediumPurple2

search_text "tk_textCut" tk_textCut_tag 
.text_widget tag configure tk_textCut_tag -foreground MediumPurple2

search_text "tk_textCopy" tk_textCopy_tag 
.text_widget tag configure tk_textCopy_tag -foreground MediumPurple2

search_text "puts " puts_tag
.text_widget tag configure puts_tag -foreground tan

search_text "printf " printf_tag
.text_widget tag configure printf_tag -foreground tan

search_text "int " int_tag
.text_widget tag configure int_tag -foreground tan

search_text "static " static_tag
.text_widget tag configure static_tag -foreground tan

search_text "extern " extern_tag
.text_widget tag configure extern_tag -foreground tan

search_text "strcpy " strcpy_tag
.text_widget tag configure strcpy_tag -foreground tan

search_text "char " char_tag
.text_widget tag configure char_tag -foreground tan

search_text "-troughcolor " troughcolor_tag
.text_widget tag configure troughcolor_tag -foreground DarkOrange1

search_text "-insertbackground " insertbackground_tag
.text_widget tag configure insertbackground_tag -foreground DarkOrange1

search_text "-activebackground " activebackground_tag
.text_widget tag configure activebackground_tag -foreground DarkOrange1

search_text "-textvariable " textvariable_tag
.text_widget tag configure textvariable_tag -foreground DarkOrange1

search_text "-bg " bg_tag
.text_widget tag configure bg_tag -foreground DarkOrange1

search_text "-fg " fg_tag
.text_widget tag configure fg_tag -foreground DarkOrange1

search_text "-insertwidth " insertwidth_tag
.text_widget tag configure insertwidth_tag -foreground DarkOrange1

search_text "proc " proc_tag
.text_widget tag configure proc_tag -foreground red

search_text "while " while_tag
.text_widget tag configure while_tag -foreground red

search_text "if " if_tag
.text_widget tag configure if_tag -foreground red

search_text "clock " clock_tag
.text_widget tag configure clock_tag -foreground red

search_text "close " close_tag
.text_widget tag configure close_tag -foreground red

search_text "continue" continue_tag
.text_widget tag configure continue_tag -foreground red

search_text "break" break_tag
.text_widget tag configure break_tag -foreground red

search_text "exit" exit_tag
.text_widget tag configure exit_tag -foreground red

search_text "open " open_tag
.text_widget tag configure open_tag -foreground red

search_text "set " set_tag
.text_widget tag configure set_tag -foreground red

search_text "read " read_tag
.text_widget tag configure read_tag -foreground red

search_text "#" comment_tag
.text_widget tag configure comment_tag -foreground red

search_text "\{" left_curly_brace_tag 
.text_widget tag configure left_curly_brace_tag -foreground green

search_text "\}" right_curly_brace_tag 
.text_widget tag configure right_curly_brace_tag -foreground green


search_text "after " after_tag
.text_widget tag configure after_tag -foreground red

search_text "$" variable_tag
.text_widget tag configure variable_tag -foreground LightGreen

search_text "button " button_tag
.text_widget tag configure button_tag -foreground MediumPurple2

search_text "pack " pack_tag
.text_widget tag configure pack_tag -foreground MediumPurple2

search_text "place " place_tag
.text_widget tag configure place_tag -foreground MediumPurple2

search_text "text " text_tag
.text_widget tag configure text_tag -foreground MediumPurple2

search_text "canvas " canvas_tag
.text_widget tag configure canvas_tag -foreground MediumPurple2

search_text "label " label_tag
.text_widget tag configure label_tag -foreground MediumPurple2

search_text "flush " flush_tag
.text_widget tag configure flush_tag -foreground MediumPurple2

search_text "configure " configure_tag
.text_widget tag configure configure_tag -foreground green

search_text "tag " tag_tag
.text_widget tag configure tag_tag -foreground maroon2

search_text "wm " wm_tag
.text_widget tag configure wm_tag -foreground green

search_text "winfo " winfo_tag
.text_widget tag configure winfo_tag -foreground green

search_text "package " package_tag
.text_widget tag configure package_tag -foreground green

search_text "global " global_tag
.text_widget tag configure global_tag -foreground green

search_text "bind " bind_tag
.text_widget tag configure bind_tag -foreground green

search_text "-foreground " foreground_tag
.text_widget tag configure foreground_tag -foreground DarkOrange1

search_text "-background " background_tag
.text_widget tag configure background_tag -foreground DarkOrange1

search_text "-yscrollcommand " yscrollcommand_tag
.text_widget tag configure yscrollcommand_tag -foreground DarkOrange1

search_text "-xscrollcommand " xscrollcommand_tag
.text_widget tag configure xscrollcommand_tag -foreground DarkOrange1

search_text "\= " equals_tag
.text_widget tag configure equals_tag -foreground DeepSkyBlue

search_text "count" count_tag
.text_widget tag configure count_tag -foreground DarkOrange1

search_text "catch " catch_tag
.text_widget tag configure catch_tag -foreground DarkOrange1

search_text "unset " unset_tag
.text_widget tag configure unset_tag -foreground MediumPurple2

search_text "\<" left_tag
.text_widget tag configure left_tag -foreground maroon2

search_text "\>" right_tag
.text_widget tag configure right_tag -foreground maroon2

search_text "\-\> "  structure_operator_tag
.text_widget tag configure structure_operator_tag -foreground maroon2

search_text "/*" open_com_tag
.text_widget tag configure open_com_tag -foreground red

search_text "*/" close_com_tag
.text_widget tag configure close_com_tag -foreground red

search_text "LRESULT" LRESULT_tag
.text_widget tag configure LRESULT_tag -foreground DarkOrange1

search_text "image " image_tag
.text_widget tag configure image_tag -foreground MediumPurple2

search_text "-command " command_tag
.text_widget tag configure command_tag -foreground DarkOrange1

search_text "-style " style_tag
.text_widget tag configure style_tag -foreground DarkOrange1

search_text "-outline " outline_tag
.text_widget tag configure outline_tag -foreground DarkOrange1

search_text "-side " side_tag
.text_widget tag configure side_tag -foreground DarkOrange1

search_text "-fill " fill_tag
.text_widget tag configure fill_tag -foreground DarkOrange1

search_text "-font " font_tag
.text_widget tag configure font_tag -foreground DarkOrange1

search_text "-wrap " wrap_tag
.text_widget tag configure wrap_tag -foreground DarkOrange1

search_text "-height " height_tag
.text_widget tag configure height_tag -foreground DarkOrange1

search_text "-width " width_tag
.text_widget tag configure width_tag -foreground DarkOrange1

search_text "-relief " relief_tag
.text_widget tag configure relief_tag -foreground DarkOrange1

search_text "-highlightcolor " highlightcolor_tag
.text_widget tag configure highlightcolor_tag -foreground DarkOrange1

search_text "-x " x_tag
.text_widget tag configure x_tag -foreground DarkOrange1

search_text "-y " y_tag
.text_widget tag configure y_tag -foreground DarkOrange1

search_text "-text " textflag_tag
.text_widget tag configure textflag_tag -foreground DarkOrange1

search_text "-highlightbackground " highlightbackground_tag
.text_widget tag configure highlightbackground_tag -foreground DarkOrange1

search_text "setgrid " setgrid_tag
.text_widget tag configure setgrid_tag -foreground DarkOrange1

search_text "HINSTANCE" HINSTANCE_tag
.text_widget tag configure HINSTANCE_tag -foreground DarkOrange1

search_text "HWND" HWND_tag
.text_widget tag configure HWND_tag -foreground DarkOrange1

search_text "#include " include_tag
.text_widget tag configure include_tag -foreground Green

search_text "CALLBACK" CALLBACK_tag
.text_widget tag configure CALLBACK_tag -foreground DarkOrange1

search_text "LPARAM" LPARAM_tag
.text_widget tag configure LPARAM_tag -foreground DarkOrange1

search_text "WPARAM" WPARAM_tag
.text_widget tag configure WPARAM_tag -foreground DarkOrange1

search_text "WORD" WORD_tag
.text_widget tag configure WORD_tag -foreground DarkOrange1

search_text "BOOL" BOOL_tag
.text_widget tag configure BOOL_tag -foreground DarkOrange1

search_text "WNDPROC" WNDPROC_tag
.text_widget tag configure WNDPROC_tag -foreground DarkOrange1

search_text "LPSTR" LPSTR_tag
.text_widget tag configure LPSTR_tag -foreground DarkOrange1

search_text "WS_VISIBLE" WS_VISIBLE_tag
.text_widget tag configure WS_VISIBLE_tag -foreground DarkOrange1

search_text "WS_BORDER" WS_BORDER_tag
.text_widget tag configure WS_BORDER_tag -foreground DarkOrange1

search_text "WS_CHILD" WS_CHILD_tag
.text_widget tag configure WS_CHILD_tag -foreground DarkOrange1

search_text "SB_SETTEXT" SB_SETTEXT_tag
.text_widget tag configure SB_SETTEXT_tag -foreground DarkOrange1

search_text "UINT" UINT_tag
.text_widget tag configure UINT_tag -foreground red

search_text "else " else_tag
.text_widget tag configure else_tag -foreground red

search_text "NULL" NULL_tag
.text_widget tag configure NULL_tag -foreground red

search_text "SendMessage" SendMessage_tag
.text_widget tag configure SendMessage_tag -foreground red

search_text "void" void_tag
.text_widget tag configure void_tag -foreground MediumPurple2

search_text "case" case_tag
.text_widget tag configure case_tag -foreground red

search_text "\"" quote_tag
.text_widget tag configure quote_tag -foreground red

search_text " && " amp2_tag
.text_widget tag configure amp2_tag -foreground DarkOrange1

search_text " == " compare_tag
.text_widget tag configure compare_tag -foreground DarkOrchid

search_text "MSG" MSG_tag
.text_widget tag configure MSG_tag -foreground DarkOrange1

search_text "#DEBUG" DEBUG_tag
.text_widget tag configure DEBUG_tag -foreground black -background red

search_text "#debug" debug_tag
.text_widget tag configure debug_tag -foreground black -background red

search_text "#workon" workon_tag
.text_widget tag configure workon_tag -foreground green -background blue

search_text "#WORKON" WORKON_tag
.text_widget tag configure WORKON_tag -foreground green -background blue

search_text "XCreateWindow " XCreateWindow_tag
.text_widget tag configure XCreateWindow_tag -foreground MediumPurple2

search_text "XDrawLine " XDrawLine_tag
.text_widget tag configure XDrawLine_tag -foreground MediumPurple2

search_text "XDrawRectangle " XDrawRectangle_tag
.text_widget tag configure XDrawRectangle_tag -foreground MediumPurple2

search_text "pointerx " pointerx_tag
.text_widget tag configure pointerx_tag -foreground DarkOrange1

search_text "pointery " pointery_tag
.text_widget tag configure pointery_tag -foreground DarkOrange1

search_text "raise " raise_tag
.text_widget tag configure raise_tag -foreground maroon2

search_text "WM_DELETE_WINDOW " WM_DELETE_WINDOW_tag
.text_widget tag configure WM_DELETE_WINDOW_tag -foreground maroon2

search_text "geometry " geometry_tag
.text_widget tag configure geometry_tag -foreground maroon2

search_text "protocol " protocol_tag
.text_widget tag configure protocol_tag -foreground maroon2


.text_widget configure -cursor xterm
update

global file_number_saved
global argv
if {$file_number_saved == 0} {wm title . "The file $argv has not been saved"; update}
if {$file_number_saved == 1} {wm title . "Saved $argv $file_number_saved time"; update}
if {$file_number_saved > 1} {wm title . "Saved $argv $file_number_saved times"; update}
}