#
# Add command in file scripting if loading first time
#
if ![llength [info command va_key_init]] {
    set w .v.top.panel2.file.script.m
    if [winfo exists $w] {$w add command -label "Hot Keys" -command va_key_init}
}  
proc va_mymenu {} {
    eval {
	proc tkGenerateMenuSelect {menu} {
	    global tkPriv va_k_set
	    if {[string equal $tkPriv(activeMenu) $menu] \
		    && [string equal $tkPriv(activeItem) [$menu index active]]} {
		return
	    }
	    set tkPriv(activeMenu) $menu
	    set tkPriv(activeItem) [$menu index active]
	    if ![catch "$menu entrycget $tkPriv(activeItem) -command"] {
		set va_k_set(current) [$menu entrycget $tkPriv(activeItem) -command]
	    } 
	    event generate $menu <<MenuSelect>>
	}
    }
    eval {
	proc tkCheckRadioDown w {
	    global tkPriv va_k_set
	    set tkPriv(relief) [$w cget -relief]
	    if {[string compare [$w cget -state] "disabled"]} {
		set tkPriv(buttonWindow) $w
		if ![catch "$w configure -command"] {
		    set va_k_set(current) [lindex [$w configure  -command] end]
		}
		$w configure -state active
	    }
	}
    }
    eval {
	proc tkButtonDown w {
	    global tkPriv va_k_set
	    set tkPriv(relief) [$w cget -relief]
	    if {[string compare [$w cget -state] "disabled"]} {
		set tkPriv(buttonWindow) $w
		if ![catch "$w configure -command"] {
		    set va_k_set(current) [lindex [$w configure  -command] end]
		}
		$w configure -relief sunken
	    }
	}
    }
}
#----------------------------
proc va_normalmenu {} {
    eval {
	proc tkGenerateMenuSelect {menu} {
	    global tkPriv
	    if {[string equal $tkPriv(activeMenu) $menu] \
		    && [string equal $tkPriv(activeItem) [$menu index active]]} {
		return
	    }
	    set tkPriv(activeMenu) $menu
	    set tkPriv(activeItem) [$menu index active]
	    event generate $menu <<MenuSelect>>
	}
    }
    eval {
	proc tkCheckRadioDown w {
	    global tkPriv
	    set tkPriv(relief) [$w cget -relief]
	    if {[string compare [$w cget -state] "disabled"]} {
		set tkPriv(buttonWindow) $w
		$w configure -state active
	    }
	}
    }
    eval {
	proc tkButtonDown w {
	    global tkPriv
	    set tkPriv(relief) [$w cget -relief]
	    if {[string compare [$w cget -state] "disabled"]} {
		set tkPriv(buttonWindow) $w
		$w configure -relief sunken
	    }
	}
    }
}
#----------------------------
proc va_key_init {} {
    global va_k_set tcl_platform
    va_key_create_menu
    set va_k_set(empty) ""
}
#---------------------------
proc va_key_screen_select {} {
    global va_k_set tcl_platform
    if {$tcl_platform(platform) != "unix"} {
	tk_messageBox -message "Use UNIX for this function" 
	return
    }
    bind all <Shift-Control-Key> {va_key_set_check}
    va_mymenu
}
#--------------------------
proc va_key_add_key {} {
    global va_k_set 
    $va_k_set(wc) configure -listvariable va_k_set(empty)
    set c [string index [string trim $va_k_set(newk)] 0] 
    update
    set va_k_set(newk) $c
    if ![string length $c] {return 1}
    if ![llength $va_k_set(keys)] {
	set k 0
	set va_k_set(keys) $c
    } else {
	set k [lsearch $va_k_set(keys) $c]
	if {$k < 0} {
	    set va_k_set(keys) [lsort "$va_k_set(keys) $c"]
	    set k [lsearch $va_k_set(keys) $c]
	}
    }
    set now [$va_k_set(wk) curselection]
    if [llength $now] {
	foreach i $now {$va_k_set(wc) selection clear $i}
    }
    $va_k_set(wk) selection set $k
    $va_k_set(wk) see $k
    if ![info exists va_k_set($c)] {set va_k_set($c) ""}
    $va_k_set(wc) configure -listvariable va_k_set($c)
}
#-----------------------------
proc va_key_show_key {} {
    global va_k_set
    set now [$va_k_set(wk) curselection]
    set c [lindex $va_k_set(keys) $now]
    
    set va_k_set(newk) $c
    $va_k_set(wc) configure -listvariable va_k_set($c)
}
#--------------------------
proc va_key_add_com {} {
    global va_k_set
    set c $va_k_set(newk)
    if ![string length $c] {tk_messageBox -message "Select key!"; return} 
    set com [string trim $va_k_set(newc)] 
    set va_k_set(newc) $com
    if ![string length $com] {return 1}
    if ![llength $va_k_set($c)] {
	set k 0
	lappend va_k_set($c) $com
    } else {
	set k [$va_k_set(wc) curselection]
	if {$k == ""} {
	    set k [llength $va_k_set($c)]
	    lappend va_k_set($c) $com
	} else {
	    incr k
	    set va_k_set($c) [linsert $va_k_set($c) $k $com]
	}
    }
    set now [$va_k_set(wc) curselection]
    if [llength $now] {
	foreach i $now {$va_k_set(wc) selection clear $i}
    }
    $va_k_set(wc) selection set $k
    after 100 "$va_k_set(wc) see $k"
}
#-----------------------------
proc va_key_delete_com {} {
    global va_k_set 
    set now [$va_k_set(wc) curselection]
    if ![llength $now] {tk_messageBox -message "Select line to delete"; return}
    set var [lindex [$va_k_set(wc) configure -listvariable] end]
    ic_mess $var\n
    set $var [lreplace [subst $[subst $var]] $now $now]
}
#-----------------------------
proc va_key_delete_key {} {
    global va_k_set 
    set now [$va_k_set(wk) curselection]
    if ![llength $now] {tk_messageBox -message "Select Key to delete"; return}
    set c [lindex $va_k_set(keys) $now]
    if {$c != $va_k_set(newk)} {tk_messageBox -message "Not clear.Select again Key to delete"; return}
    set var [lindex [$va_k_set(wc) configure -listvariable] end]
    if [info exists va_k_set($c)] {
	$va_k_set(wc)  configure -listvariable va_k_set(empty)
	unset va_k_set($c)}
    va_key_delete_unused 
}
#--------------------------------------
proc va_key_delete_unused {} {
    global va_k_set
    set i 0 
    foreach k $va_k_set(keys) {
	if {![info exists va_k_set($k)] || ![llength $va_k_set($k)]} {
	    set va_k_set(keys) [lreplace $va_k_set(keys) $i $i]
	    va_key_delete_unused
	    return
	}
    }
}
#-----------------------
proc va_key_create_menu {} {
    global va_k_set 
    if [winfo exists .va_key] {destroy .va_key}
    toplevel .va_key
    set wb .va_key.but
    set wk .va_key.key
    set wc .va_key.com
    set va_k_set(wk) $wk
    set va_k_set(wc) $wc
    frame $wb
    #
    frame $wb.main
    button $wb.main.read -text Load -command va_key_read
    button $wb.main.activate -text Activate -command {va_key_activate 1}
    button $wb.main.deactivate -text Deactivate -command {va_key_activate 0}
    button $wb.main.more -text Create... -command "grid $wb.more"
    button $wb.main.close -text Close -command {destroy .va_key}
    grid $wb.main.read $wb.main.activate $wb.main.deactivate $wb.main.more $wb.main.close
    #
    frame $wb.more
    entry $wb.more.e -textvar va_k_set(newk) -width 1 -bg white
    bind $wb.more.e <Return> va_key_add_key
    bind $wb.more.e <Double-Button-1> va_key_add_key
    button $wb.more.delk -text "Delete Key" -command {va_key_delete_key}
    button $wb.more.delc -text "Delete Command" -command {va_key_delete_com} 
    button $wb.more.write -text Save -command {va_key_write}
    button $wb.more.done -text "Close Edit" -command "grid forget $wb.more"
    button $wb.more.select -text "Screen select" -command "va_key_screen_select"
    entry $wb.more.c -textvar va_k_set(newc) -width 30 -bg white
    bind $wb.more.c <Return> va_key_add_com
    bind $wb.more.c <Double-Button-1> va_key_add_com
    grid $wb.more.e $wb.more.delk $wb.more.delc $wb.more.write $wb.more.done $wb.more.select
    grid $wb.more.c - - - - -
    #
    listbox $wk  -yscrollcommand "$wk.keyscroll set" -selectmode single -listvariable va_k_set(keys)
    scrollbar $wk.keyscroll -command "$wk yview"
    listbox $wc  -yscrollcommand "$wc.comscroll set" -selectmode single -listvariable va_k_set(empty)
    scrollbar $wc.comscroll -command "$wc yview"
    #
    pack $wk.keyscroll -side right -fill y
    pack $wc.comscroll -side right -fill y
    grid $wb.main
    
    pack $wb  -side top -anchor w
    
    pack $wk -side left -fill y -ipadx 10  -expand y 
    
    
    pack $wc -side left -fill both -ipadx 100 -expand y 
    
    
    
    
    #grid $w.key $w.com
    bind $wk <ButtonRelease-1> {update; va_key_show_key }
    bind $wc <ButtonRelease-1> {}
}
#---------------------------------------------------------
proc va_key_read {} {
    global va_k_set
    set fn [tk_getOpenFile]
    if {$fn == ""} return
    #
    # Delete current key definitions if any
    # No merge!
    foreach key [array names va_k_set] {
	if {[string length $key] != 1} continue
	unset va_k_set($key)
    }
    set va_k_set(keys) ""
    $va_k_set(wc)  configure -listvariable va_k_set(empty)
    #
    # Read key definitions using format:
    # c
    # command
    # command
    # ....
    # c
    #.....
    # # in first column is comment in key file
    #
    set f [open $fn "r"]
    set key ""
    while {  [gets $f txt ] >= 0 } {
	set txt [string trim $txt]
	if {[string index $txt 0] == "#"} continue
	if {[string length $txt] == 1} {
	    set key $txt
	    lappend va_k_set(keys) $key
	    continue
	}
	if {$key == ""} continue
	lappend va_k_set($key) $txt
    }
    set va_k_set(keys) [lsort $va_k_set(keys)]
    close $f
}
#=================================
proc va_key_write {} {
    global va_k_set
    set fn [tk_getSaveFile]
    if {$fn == ""} return
    set f [open $fn "w"]
    foreach key $va_k_set(keys) {
	puts $f $key
	foreach com $va_k_set($key) {
	    puts $f $com
	}
    }
    close $f 	
}
#---------------------------
proc va_key_activate {do} {
    global va_k_set
    foreach key $va_k_set(keys) {
	if $do {
	    tdv_set_key_command $key "va_key_do_command $key"
	} else { 
	    tdv_set_key_command $key ""
	}
    }
}
#========================================================
proc va_key_do_command {key} {
    global va_k_set
    if ![info exists va_k_set($key)] return
    foreach com $va_k_set($key) {
	eval $com
    }
}
#----------------------
proc va_key_stop {{unset ""}} {
    global va_k_set tcl_platform
    if {[info exists va_k_set(window)] && [winfo exists $va_k_set(window)]} {
	destroy $va_k_set(window)
    }
    bind all <Shift-Control-Key> ""
    va_normalmenu
    if [llength $unset] tdv_set_key_command
}
#--------------------------
proc va_key_set_check {} {
    global va_k_set
    if ![info exists va_k_set(current)] return
    set cur $va_k_set(current)
    if ![info exists va_k_set(last_com)] {set va_k_set(last_com) ""}
    if ![llength $cur] return
    if ![info exists va_k_set(wc)] return
    if ![winfo exists $va_k_set(wc)] return
    if {$cur != $va_k_set(last_com)} {
	$va_k_set(wc) insert end $cur
	set va_k_set(last_com) $cur
    }
}
