#!/usr/bin/wish -f

# tk notepad

#set defaultfont -Adobe-Helvetica-*-R-Normal-*160-*
set defaultfont trialfont-koi8-c

# start by settind default font size for all 
set fontsize $defaultfont

global .
set WINTITLE "Tk NotePad"

eval destroy [winfo child .]
wm title . $WINTITLE
wm iconname . "tknotepad"
wm geometry . 60x25
wm minsize . 1 2 

#create top level frames
#
# this is for the menus file, edit, search, and help
frame .topmenu
pack .topmenu -side top -fill x -expand 0
#
# this seperates the top and bottom menus
frame .bottommenu
pack .bottommenu -side bottom -expand 1 -fill both
#
# this is for the text widget and the y scroll bar
frame .bottomtopmenu
pack .bottomtopmenu -in .bottommenu -side top -expand 1 -fill both
#
# where the text widget is packed
frame .bottomleftmenu 
pack .bottomleftmenu -in .bottomtopmenu  -side left -expand 1 -fill both
#
# where the y scrollbar is packed
frame .bottomrightmenu 
pack  .bottomrightmenu -in .bottomtopmenu  -side right -expand 0 -fill both 
#
# this is for the x scroll bar at the bottom of the window
frame .bottombottommenu
pack .bottombottommenu -in .bottommenu -side bottom -expand 0 -fill both

#create main menu
#file menu
menubutton .filemenu -text File -underline 0 -menu .filemenu.files 
menu .filemenu.files
.filemenu.files add command -label "New" -underline 0 -command "selectnew"
.filemenu.files add command -label "Open" -underline 0 -command "selectopen"
.filemenu.files add command -label "Save" -underline 0 -command "selectsave" -accelerator Ctrl+s
.filemenu.files add command -label "Save As" -underline 5 -command "saveas"
.filemenu.files add separator
#if [ expr [string compare $tcl_platform(platform) "windows"] !=0] {
#	if {$tcl_platform(platform) != "macintosh"} {
	#.filemenu.files add command -label "Print Setup" -underline 0 -command "selectprint"
#	.filemenu.files add command -label "Print" -underline 0 -command "selectprint"
#	.filemenu.files add separator
#	}
#}
.filemenu.files add command -label "Exit" -underline 1 -command "exitapp"

#edit menu
menubutton .edit -text Edit -underline 0 -menu .edit.files
menu .edit.files
.edit.files add command -label "Undo" -underline 0 -command " undo_menu_proc"
.edit.files add command -label "Redo" -underline 0 -command "redo_menu_proc"
.edit.files add separator
.edit.files add command -label "Cut" -underline 2 -command "cuttext" -accelerator Ctrl+x
.edit.files add command -label "Copy" -underline 0 -command "copytext" -accelerator Ctrl+c
.edit.files add command -label "Paste" -underline 0 -command "pastetext" -accelerator Ctrl+v
.edit.files add command -label "Delete" -underline 0 -command "deletetext"
.edit.files add separator
.edit.files add command -label "Select all" -underline 0 -command ".textarea tag add sel 1.0 end"
.edit.files add command -label "Time/Date" -underline 5 -command "printtime"
.edit.files add separator
.edit.files add check -label "Word wrap" -underline 5 -command "wraptext" -variable wordwrapsw

#search menu
menubutton .search -text Search -underline 0 -menu .search.files
menu .search.files
.search.files add command -label "Find" -underline 0 -command "findtext find"
.search.files add command -label "Find Next" -underline 1 -command "findtext find"
.search.files add command -label "Replace" -underline 0 -command "findtext replace"

# help menu
menubutton .helpmenu -text Help -underline 0 -menu .helpmenu.helpless
menu .helpmenu.helpless
.helpmenu.helpless add command -label "Help" -underline 0 -command "helpme"
.helpmenu.helpless add command -label "About" -underline 0 -command "aboutme"
pack .filemenu .edit .search -in .topmenu -side left -expand 0
pack .helpmenu  -in .topmenu -side right -expand 0

# arrow key menu traversal 
tk_menuBar .topmenu .filemenu .edit  .search .helpmenu
focus .topmenu

#create text area
text .textarea -relief sunken -bd 2 -xscrollcommand ".xscroll set" \
	-yscrollcommand ".yscroll set" -wrap none -width 1 -height 1 
.textarea configure -font $fontsize
scrollbar .yscroll -command ".textarea yview"
scrollbar .xscroll -command ".textarea xview" -orient horizontal
pack .textarea  -in  .bottomleftmenu -side left -expand 1 -fill both
pack .yscroll -in .bottomrightmenu -side right -expand 1 -fill both
pack .xscroll -in .bottombottommenu -expand 1 -fill x 
.textarea configure -setgrid 1 
focus .textarea

# create a storage place for the program name
entry .statusted -textvariable statusted
#create a space for storing weather word wrap is on or not
entry .wordwrap -textvariable wordup

# if there is a command line argument then test to see if it is a file and if it exists
if $argc>0 {if [file exists $argv] {
	    	set newnamefile [open $argv r]
		while {![eof $newnamefile]} {
		.textarea insert end [read $newnamefile 1000]	
		wm title . "Tk NotePad - $argv"
		.statusted delete 0 end
	 	.statusted insert 0 $argv
		.statusted xview end
	}
}
}

# help menu
proc helpme {} {
	tk_messageBox -type ok -message "This is a simple ASCII editor like many \
	others. If you have made it this far with Linux, you\
	should be able to figure this out!"
}

# about menu
proc aboutme {} {
	tk_messageBox -type ok -message "Tk-NotePad \n by Joseph Acosta. \n \
		joeja@mindspring.com"
}

# new file
proc selectnew {} {
set answer [tk_messageBox -message \
	" This will delete the contents of the current window, \
	select ok to continue." -type okcancel -icon question]
	case $answer {
		ok {
			.textarea delete 0.0 end
			.statusted delete 0 end
			.statusted insert 0 " "
			.statusted xview end
			set WINTITLE "Tk NotePad"
			wm title . $WINTITLE
		} 
	}
}

# new file
proc exitapp {} {
	set answer [tk_messageBox -message \
	" This will delete the contents of the current window \
	and exit the application, select ok to continue." \
	-type okcancel -icon question]
	case $answer {
		ok {destroy .} 
	}
}


#open an existing file
proc selectopen {} {
set types {
	{"All files"		*}
}
set file [tk_getOpenFile -filetypes $types -parent .]
if [string compare $file ""] {
	set filename $file
	set WINTITLE "Tk NotePad - $filename"
	wm title . $WINTITLE
	.statusted delete 0 end
 	.statusted insert 0 $filename
	.statusted xview end
	#no longer check if file exists file this is built in tk
	.textarea delete 0.0 end
	set newnamefile [open $filename r]
	while {![eof $newnamefile]} {		
		.textarea insert end [read $newnamefile 1000]	
	}
	close $newnamefile
}  
}

#save a file
proc selectsave {} {
set filenamestring [.statusted get]
#check if file exists file
if [expr [string compare $filenamestring ""] == 0 ]  {
	saveas
} elseif [expr [string compare $filenamestring " "] == 0 ]  {
	saveas
} else {
   	if [file exists $filenamestring] {
		set savefilename [open $filenamestring w]
		puts $savefilename [.textarea get 0.0 end]
	close $savefilename
	} else {
		saveas
	}	
}
}

#save a file as
proc saveas {} {
set types {
	{"All files"		*}
}
set file [tk_getSaveFile -filetypes $types -parent . -initialfile Untitled]

if [string compare $file ""] {

set filename $file
#no longer check if file exists file built in tk
	set namefile [open $filename w]
	puts $namefile [.textarea get 0.0 end]
	close $namefile
	set WINTITLE "Tk NotePad - $filename"
	wm title . $WINTITLE
	.statusted delete 0 end
 	.statusted insert 0 $filename
	.statusted xview end
}
}

# procedure to print
proc selectprint {} {
	set savefilename [open /tmp/tkpadtmpfile w]
	puts $savefilename [.textarea get 0.0 end]
	close $savefilename
	exec /usr/bin/lpr /tmp/tkpadtmpfile
	exec rm /tmp/tkpadtmpfile
}

#cut text procedure
proc deletetext {} {
set cuttexts [selection own]
if {$cuttexts != "" } {
$cuttexts delete sel.first sel.last
selection clear
}
}

#cut text procedure
proc cuttext {} {
tk_textCut .textarea
}

#copy text procedure
proc copytext {} {
tk_textCopy .textarea
}

#paste text procedure
proc pastetext {} {
global tcl_platform
if {"$tcl_platform(platform)" == "unix"} {
	    catch {
		.textarea delete sel.first sel.last
	    }
}
tk_textPaste .textarea
}

proc FindIt {w} {
	global SearchString SearchPos SearchDir findcase 

	if {$SearchString!=""} {
		
		if {$findcase=="1"} {
 			set caset "-exact"
		} else {
			set caset "-nocase"
		}
	
		if {$SearchDir == "forwards"} {
			set limit end
		} else {
			set limit 1.0
		}
		
		set SearchPos [ .textarea search -count len $caset -$SearchDir $SearchString $SearchPos $limit]
		set len [string length $SearchString]
		if {$SearchPos != ""} {
        			.textarea see $SearchPos
	 		tkTextSetCursor .textarea $SearchPos
			.textarea tag add sel $SearchPos  "$SearchPos + $len char"
        			
			if {$SearchDir == "forwards"} {
        				set SearchPos "$SearchPos + $len char"
			}         
			focus .textarea
            		} else {
	           		set SearchPos "0.0"
	          	}

 	}

}

proc ReplaceIt {} {
	global SearchString SearchDir ReplaceString SearchPos findcase
	if {$SearchString!=""} {
	if {$findcase=="1"} {
		set caset "-exact"
	} else {
		set caset "-nocase"
	}
	
	if {$SearchDir == "forwards"} {
		set limit end
	} else {
		set limit 1.0
	}

	set SearchPos [ .textarea search -count len $caset -$SearchDir $SearchString $SearchPos $limit]
		set len [string length $SearchString]
	if {$SearchPos != ""} {
        		.textarea see $SearchPos
               		.textarea delete $SearchPos "$SearchPos+$len char"
        		.textarea insert $SearchPos $ReplaceString
		if {$SearchDir == "forwards"} {
        			set SearchPos "$SearchPos+$len char"
		}         
	} else {
	        	set SearchPos "0.0"
	}
	}
	#focus .textarea
}

proc ReplaceAll {} {
	global SearchPos
	ReplaceIt
	while {$SearchPos!="0.0"} {
		ReplaceIt
	}
}
proc CancelFind {w} {
.textarea tag delete tg1
destroy $w
}

proc ResetFind {} {
global SearchPos
set SearchPos insert
}

# procedure to find text
proc findtext {typ} {
	global SearchString SearchDir ReplaceString findcase c
	set find .find
	catch {destroy $find}
	toplevel $find
	wm title $find "Find"
	wm resizable $find 0 0
	ResetFind
	frame $find.l
	frame $find.l.f
	frame $find.l.f.f1
	label $find.l.f.f1.label -text "Find what:" -width 11  
	entry $find.l.f.f1.entry  -textvariable SearchString -width 30 
	pack $find.l.f.f1.label $find.l.f.f1.entry -side left
	$find.l.f.f1.entry selection range 0 end
	if {$typ=="replace"} {
		frame $find.l.f.f2
		label $find.l.f.f2.label2 -text "Replace with:" -width 11
		entry $find.l.f.f2.entry2  -textvariable ReplaceString -width 30 
		pack $find.l.f.f2.label2 $find.l.f.f2.entry2 -side left

		pack $find.l.f.f1 $find.l.f.f2 -side top
	} else {
		pack $find.l.f.f1
	}
	frame $find.f2
	button $find.f2.button1 -text "Find Next" -command "FindIt $find" -width 10 -height 1 -underline 5 
	button $find.f2.button2 -text "Cancel" -command "CancelFind $find" -width 10 -underline 0
	if {$typ=="replace"} {
		button $find.f2.button3 -text "Replace" -command ReplaceIt -width 10 -height 1 -underline 0
		button $find.f2.button4 -text "Replace All" -command ReplaceAll -width 10 -height 1 -underline 8		
		pack $find.f2.button3 $find.f2.button4 $find.f2.button2  -pady 4
		} else {
		pack $find.f2.button1 $find.f2.button2  -pady 4
	}
	frame $find.l.f4
	frame $find.l.f4.f3 -borderwidth 2 -relief groove
	radiobutton $find.l.f4.f3.up -text "Up" -underline 0 -variable SearchDir -value "backwards" 
	radiobutton $find.l.f4.f3.down -text "Down"  -underline 0 -variable SearchDir -value "forwards" 
	$find.l.f4.f3.down invoke
	pack $find.l.f4.f3.up $find.l.f4.f3.down -side left 
	checkbutton $find.l.f4.cbox1 -text "Match case" -variable findcase -underline 0 
	pack $find.l.f4.cbox1 $find.l.f4.f3 -side left -padx 10
	pack $find.l.f
	pack $find.l.f4 -pady 11
	pack $find.l $find.f2 -side left -padx 1
	bind $find <Escape> "destroy $find"
	focus $find.l.f.f1.entry
	grab $find
}

#procedure to set the time
proc printtime {} {
set nowtime [clock seconds]
set clocktime [clock format $nowtime -format "%R %p %D"]
.textarea insert insert $clocktime
}

proc wraptext {} {
if [expr [string compare [.wordwrap get] "wraponword"] == 0] {
	.textarea configure -wrap none
	.wordwrap delete 0 end
	.wordwrap insert 0 wrapnone
	.wordwrap xview end
	
} else {
	.textarea configure -wrap word
	.wordwrap delete 0 end
	.wordwrap insert 0 wraponword
	.wordwrap xview end
}
}

#bindings
bind All <Alt-F> {}
bind All <Alt-E> {}
bind All <Alt-S> {}
bind All <Alt-H> {}
bind . <Control-x> {cuttext}
bind . <Control-c> {copytext}
bind . <Control-s> {selectsave}

# because window is 'different' and mac is unknown
if [ expr [string compare $tcl_platform(platform) "windows"] !=0] {
	if {$tcl_platform(platform) != "macintosh"} {
		#events
		set tk_strictMotif 0
		event delete <<Cut>> <Control-x>
		event delete <<Paste>> <Control-v>
		#event add <<Paste>> <Control-v> 
		# more bindings

		bind . <Control-v> {pastetext 
			tkTextScrollPages %W -1} 
	}
}


###################################################################
set zed_dir [file dirname [info script]] 
# here is where the undo stuff begins
if {![info exists classNewId]} {
    # work around object creation between multiple include of this file problem
    set classNewId 0
}

proc new {className args} {
    # calls the constructor for the class with optional arguments
    # and returns a unique object identifier independent of the class name

    global classNewId
    # use local variable for id for new can be called recursively
    set id [incr classNewId]
    if {[llength [info procs ${className}:$className]]>0} {
        # avoid catch to track errors
        eval ${className}:$className $id $args
    }
    return $id
}

proc delete {className id} {
    # calls the destructor for the class and delete all the object data members

    if {[llength [info procs ${className}:~$className]]>0} {
        # avoid catch to track errors
        ${className}:~$className $id
    }
    global $className
    # and delete all this object array members if any (assume that they were stored as $className($id,memberName))
    foreach name [array names $className "$id,*"] {
        unset ${className}($name)
    }
}

# end of where you would have sourced in new.tcl

###############

proc lifo:lifo {id {size 2147483647}} {
    global lifo

    set lifo($id,maximumSize) $size
    lifo:empty $id
}

proc lifo:push {id data} {
    global lifo

    lifo:tidyUp $id
    if {$lifo($id,size)>=$lifo($id,maximumSize)} {
        unset lifo($id,data,$lifo($id,first))
        incr lifo($id,first)
        incr lifo($id,size) -1
    }
    set lifo($id,data,[incr lifo($id,last)]) $data
    incr lifo($id,size)
}

proc lifo:pop {id} {
    global lifo

    lifo:tidyUp $id
    if {$lifo($id,last)<$lifo($id,first)} {
        error "lifo($id) pop error, empty"
    }
    # delay unsetting popped data to improve performance by avoiding a data copy
    set lifo($id,unset) $lifo($id,last)
    incr lifo($id,last) -1
    incr lifo($id,size) -1
    return $lifo($id,data,$lifo($id,unset))
}

proc lifo:tidyUp {id} {
    global lifo

    if {[info exists lifo($id,unset)]} {
        unset lifo($id,data,$lifo($id,unset))
        unset lifo($id,unset)
    }
}

proc lifo:empty {id} {
    global lifo

    lifo:tidyUp $id
    foreach name [array names lifo $id,data,*] {
        unset lifo($name)
    }
    set lifo($id,size) 0
    set lifo($id,first) 0
    set lifo($id,last) -1
}


proc textUndoer:textUndoer {id widget {depth 2147483647}} {
    global textUndoer

    if {[string compare [winfo class $widget] Text]!=0} {
        error "textUndoer error: widget $widget is not a text widget"
    }
    set textUndoer($id,widget) $widget
    set textUndoer($id,originalBindingTags) [bindtags $widget]
    bindtags $widget [concat $textUndoer($id,originalBindingTags) UndoBindings($id)]

    bind UndoBindings($id) <Control-u> "textUndoer:undo $id"

    # self destruct automatically when text widget is gone
    bind UndoBindings($id) <Destroy> "delete textUndoer $id"

    # rename widget command
    rename $widget [set textUndoer($id,originalCommand) textUndoer:original$widget]
    # and intercept modifying instructions before calling original command
    proc $widget {args} "textUndoer:checkpoint $id \$args; 
		global search_count;
		eval $textUndoer($id,originalCommand) \$args"

    set textUndoer($id,commandStack) [new lifo $depth]
    set textUndoer($id,cursorStack) [new lifo $depth]
    #lee 
    textRedoer:textRedoer $id $widget $depth 
}


proc textUndoer:~textUndoer {id} {
    global textUndoer

    bindtags $textUndoer($id,widget) $textUndoer($id,originalBindingTags)
    rename $textUndoer($id,widget) ""
    rename $textUndoer($id,originalCommand) $textUndoer($id,widget)
    delete lifo $textUndoer($id,commandStack)
    delete lifo $textUndoer($id,cursorStack)
    #lee
    textRedoer:~textRedoer $id
}

proc textUndoer:checkpoint {id arguments} {
    global textUndoer
    #lee
    global textRedoer

    # do nothing if non modifying command
    if {[string compare [lindex $arguments 0] insert]==0} {
        textUndoer:processInsertion $id [lrange $arguments 1 end]
        if {$textRedoer($id,redo) == 0} {
           textRedoer:reset $id
        }
    }
    if {[string compare [lindex $arguments 0] delete]==0} {
        textUndoer:processDeletion $id [lrange $arguments 1 end]
        if {$textRedoer($id,redo) == 0} {
           textRedoer:reset $id
        }
    }
}

proc textUndoer:processInsertion {id arguments} {
    global textUndoer

    set number [llength $arguments]
    set length 0
    # calculate total insertion length while skipping tags in arguments
    for {set index 1} {$index<$number} {incr index 2} {
        incr length [string length [lindex $arguments $index]]
    }
    if {$length>0} {
        set index [$textUndoer($id,originalCommand) index [lindex $arguments 0]]
        lifo:push $textUndoer($id,commandStack) "delete $index $index+${length}c"
        lifo:push $textUndoer($id,cursorStack) [$textUndoer($id,originalCommand) index insert]
    }
}

proc textUndoer:processDeletion {id arguments} {
    global textUndoer

    set command $textUndoer($id,originalCommand)
    lifo:push $textUndoer($id,cursorStack) [$command index insert]

    set start [$command index [lindex $arguments 0]]
    if {[llength $arguments]>1} {
        lifo:push $textUndoer($id,commandStack) "insert $start [list [$command get $start [lindex $arguments 1]]]"
	#I changed line above : instead "{ [$command ...] }" -> " [list [$command ...] ]"
	#See explanation in file undo.txt
    } else {
        lifo:push $textUndoer($id,commandStack) "insert $start [list [$command get $start]]"
	#I changed line above : instead "{ [$command ...] }" -> " [list [$command ...] ]"
	#See explanation in file undo.txt
    }
}

proc textUndoer:undo {id} {
    global textUndoer

    if {[catch {set cursor [lifo:pop $textUndoer($id,cursorStack)]}]} {
        return
    }
    
    set popArgs [lifo:pop $textUndoer($id,commandStack)] 
    textRedoer:checkpoint $id $popArgs
    
    eval $textUndoer($id,originalCommand) $popArgs
#    eval $textUndoer($id,originalCommand) [list [lifo:pop $textUndoer($id,commandStack)] ]
    # now restore cursor position
    $textUndoer($id,originalCommand) mark set insert $cursor
    # make sure insertion point can be seen
    $textUndoer($id,originalCommand) see insert
}


proc textUndoer:reset {id} {
    global textUndoer

    lifo:empty $textUndoer($id,commandStack)
    lifo:empty $textUndoer($id,cursorStack)
}


#########################################################################
proc textRedoer:textRedoer {id widget {depth 2147483647}} {
    global textRedoer

    #bp {creation redoer}
    if {[string compare [winfo class $widget] Text]!=0} {
        error "textRedoer error: widget $widget is not a text widget"
    }
    set textRedoer($id,commandStack) [new lifo $depth]
    set textRedoer($id,cursorStack) [new lifo $depth]
    set textRedoer($id,redo) 0
}

proc textRedoer:~textRedoer {id} {
    global textRedoer

    #bp {destroy redoer}
    delete lifo $textRedoer($id,commandStack)
    delete lifo $textRedoer($id,cursorStack)
}


proc textRedoer:checkpoint {id arguments} {
    global textUndoer
    global textRedoer

    # bp {redo-check point}
    # do nothing if non modifying command
    if {[string compare [lindex $arguments 0] insert]==0} {
        textRedoer:processInsertion $id [lrange $arguments 1 end]
    }
    if {[string compare [lindex $arguments 0] delete]==0} {
        textRedoer:processDeletion $id [lrange $arguments 1 end]
    }
}

proc textRedoer:processInsertion {id arguments} {
    global textUndoer
    global textRedoer

    #bp {redo-insert}
    set number [llength $arguments]
    set length 0
    # calculate total insertion length while skipping tags in arguments
    for {set index 1} {$index<$number} {incr index 2} {
        incr length [string length [lindex $arguments $index]]
    }
    if {$length>0} {
        set index [$textUndoer($id,originalCommand) index [lindex $arguments 0]]
        lifo:push $textRedoer($id,commandStack) "delete $index $index+${length}c"
        lifo:push $textRedoer($id,cursorStack) [$textUndoer($id,originalCommand) index insert]
    }
}

proc textRedoer:processDeletion {id arguments} {
    global textUndoer
    global textRedoer

    #bp {redo-del}
    set command $textUndoer($id,originalCommand)
    lifo:push $textRedoer($id,cursorStack) [$command index insert]

    set start [$command index [lindex $arguments 0]]
    if {[llength $arguments]>1} {
        lifo:push $textRedoer($id,commandStack) "insert $start [list [$command get $start [lindex $arguments 1]]]"
	#I changed line above : instead "{ [$command ...] }" -> " [list [$command ...] ]"
	#See explanation in file undo.txt
    } else {
        lifo:push $textRedoer($id,commandStack) "insert $start [list [$command get $start]]"
	#I changed line above : instead "{ [$command ...] }" -> " [list [$command ...] ]"
	#See explanation in file undo.txt
    }
}
proc textRedoer:redo {id} {
    global textUndoer
    global textRedoer

    #bp {redo-redo}
    if {[catch {set cursor [lifo:pop $textRedoer($id,cursorStack)]}]} {
        return
    }
    
#    textRedoer:checkpoint $id  [lifo:pop $textUndoer($id,commandStack)] 
    
    set textRedoer($id,redo) 1
    set popArgs [lifo:pop $textRedoer($id,commandStack)] 
    textUndoer:checkpoint $id $popArgs
    eval $textUndoer($id,originalCommand) $popArgs
    set textRedoer($id,redo) 0
    # now restore cursor position
    $textUndoer($id,originalCommand) mark set insert $cursor
    # make sure insertion point can be seen
    $textUndoer($id,originalCommand) see insert
}


proc textRedoer:reset {id} {
    global textRedoer

#    bp {redo-reset}
    lifo:empty $textRedoer($id,commandStack)
    lifo:empty $textRedoer($id,cursorStack)
}

# end of where youd source in undo.tcl

set undo_id [new textUndoer .textarea]
proc undo_menu_proc {} {
	global undo_id
	textUndoer:undo $undo_id
}

proc redo_menu_proc {} {
	global undo_id
	textRedoer:redo $undo_id
}



















