#!wish8.2 -f
#  'CBB' -- Check Book Balancer
#
#   bindings.tcl -- common bindings
#
#  Written by Curtis Olson.  Started August 25, 1994.
#
#  Copyright (C) 1994 - 1999  Curtis L. Olson  - curt@me.umn.edu
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# $Id: bindings.tcl,v 1.2 2000/01/02 19:08:02 curt Exp $


#------------------------------------------------------------------------------
# Setup auto highlighting of entry fields
#------------------------------------------------------------------------------
proc setup_auto_hilite {} {
    global cbb

    bind Entry <FocusIn> { 
	set textvar [lindex [%W configure -textvariable] 4]
        set value [subst $[subst $textvar]]
	if { $cbb(debug) } { puts "$textvar = '$value'" }

	if { "$value" == "" } {
	    # do nothing, blank value
	} else {
	    %W selection from 0
	    %W selection to end
	}
    }

    bind Entry <FocusOut> { 
	%W selection clear
    }
}


#------------------------------------------------------------------------------
# Setup default field binding
#------------------------------------------------------------------------------

proc setup_default_binding {} {
    global cbb desc addcat

    set tabList { .entry.line1.check .entry.line1.date .entry.line1.desc \
	    .entry.line1.debit .entry.line1.credit .entry.line2.com \
	    .entry.line2.cat .entry.line1.clear }

    foreach field $tabList {
        bind $field <Return> { done_entering }
    }


    # The following are duplicates from menu.tk where these things
    # are bound to "all".  I am duplicating them here for the widgets
    # that ignore "all" bindings.

    foreach field { .entry.line1.desc .entry.line2.cat } {
	# <Tab> is handled individual to make tab completion possible
	bind $field <Shift-Tab> {focus [tk_focusPrev %W]}

    	bind $field <Meta-q> { cbbQuit }
	bind $field <Alt-q> { cbbQuit }
	bind $field <Meta-u> { undoAction }
	bind $field <Alt-u> { undoAction }
	bind $field <Meta-n> { clear_entry_area }
	bind $field <Alt-n> { clear_entry_area }
	bind $field <Meta-e> { 
	    if { [listGetCurTrans] >= 1 } {
		update_entry_area [listGetCurTrans].0
	    }
	}                                                  
	bind $field <Alt-e> { 
	    if { [listGetCurTrans] >= 1 } {
		update_entry_area [listGetCurTrans].0
	    }
	}
	bind $field <Meta-s> { 
	    cbbWindow.splits
	    tkwait window .splits
	}
	bind $field <Alt-s> { 
	    cbbWindow.splits
	    tkwait window .splits
	}
	bind $field <Meta-c> { cbbWindow.catwin }
	bind $field <Alt-c> { cbbWindow.catwin }
    }

    bind .entry.line1.desc <Control-Tab> {
	set cbb(no_more_mem) 1
	focus [tk_focusNext %W];
    }

    bind .entry.line1.desc <Tab> {
	if { [expr ($cbb(no_more_mem) == 0) && ($cbb(use_mems) == 1)] } { 
	    puts $eng "find_mem $desc"; flush $eng
	    gets $eng result
	    if { $cbb(debug) } { puts $result }
	    if { "$result" != "none" } {
		if { [string range $result 0 13] == "partial_match:" } {
		    set desc [string range $result 14 end]
                    .status.line configure -text "Partial completion:  '$desc'"
		} else {
		    update_from_mem $result
		    set cbb(no_more_mem) 1
                    .status.line configure -text "Unique description found."
		    focus [tk_focusNext %W];
		}
		tkEntrySetCursor %W end
	    } else {
		focus [tk_focusNext %W];
	    }
	} else {
	    focus [tk_focusNext %W];
	}
    }

    bind .entry.line2.cat <Tab> {
	if { "[string range $cat 0 0]" != "|" } {
	    puts $eng "find_cat $cat"; flush $eng
	    gets $eng result
	    if { "$result" != "none" } {
		if { $cbb(debug) } { puts $result }
                if { [string range $result 0 13] == "partial_match:" } {
                    set cat [string range $result 14 end]             
                    .status.line configure -text "Partial completion:  '$cat'"
                } else {              
		    set cat $result
                    .status.line configure -text "Unique category found."
		    focus [tk_focusNext %W];
                }                                                
		tkEntrySetCursor %W end
	    } elseif { "$cat" != "" } {
		set addcat(cat) $cat
		set addcat(mode) "missing"
		cbbWindow.newcat
		tkwait window .newcat
		focus [tk_focusNext %W];
	    } else {
		focus [tk_focusNext %W];
	    }
	} else {
	    focus [tk_focusNext %W];
	}
    }

    bind . <Alt-Home> { goto 1 }
    bind . <Meta-Home> { goto 1 }
    bind . <Alt-End> { goto [expr [listGetSize] - 1] }
    bind . <Meta-End> { goto [expr [listGetSize] - 1] }
    bind . <Up> { goto [expr [listGetCurTrans] - 2] }
    bind . <Down> { goto [expr [listGetCurTrans] + 2] }
    bind . <Prior> { 
	goto [expr [listGetCurTrans] - ($cbb(list_height) - 4)]
    }
    bind . <Next> { 
	goto [expr [listGetCurTrans] + ($cbb(list_height) - 4)]
    }
}


proc inc_check check {
    global cbb

    if { "$check" == "" } {
	set check $cbb(next_chk)
    }

    .entry.line1.check icursor end

    return [expr int($check.) + 1]
}


proc dec_check check {
    global cbb

    if { "$check" == "" } {
	set check $cbb(next_chk)
    }

    .entry.line1.check icursor end

    if { [expr $check > 1] } {
        return [expr int($check.) - 1]
    } else {
        return 1
    }
}


proc pad num {
    if { "$num" == "" } {
	set num 0
    }
    set num [expr int($num.)]
    if { [expr $num >= 0 && $num <= 9] } {
	return "0$num"
    } else {
	return $num
    }
}

# Input year is CCYY or YY, return CCYY.
# If year is YY, deduce CC.
# If within 20 years of century end get next/prev century
# proc full_year year {
#     global cbb
# 
#     if { [string length $year] == 4 } {
# 	return $year
#     }
# 
#     if { [expr $year >= 80 && $cbb(year) < 20 ] } {
#         return "[expr $cbb(century) - 1]$year"
#     }
# 
#     if { [expr $year < 20 && $cbb(year) >= 80 ] } {
# 	return "[expr $cbb(century) + 1]$year"
#     }
# 
#     return "$cbb(century)$year"
# }

proc inc_date { date } {
    global cbb

    # if { $cbb(debug) } { puts "date = '$date'" }

    if { [string length $date] == 6 } {
	puts "invalid date in inc_date()"
	exit
	set year [full_year [string range $date 0 1]]
	set month [string range $date 2 3]
	set day [string range $date 4 5]
    } else {
	set year [string range $date 0 3]
	set month [string range $date 4 5]
	set day [string range $date 6 7]
    }

    # if { $cbb(debug) } { puts "day month year = '$day $month $year'" }

    if { [string range $day 0 0] == "0" } {
	# if { $cbb(debug) } { puts " sr =  '[string range $day 1 1]'" }
	set day [string range $day 1 1]
    }
    if { [string range $month 0 0] == "0" } {
	set month [string range $month 1 1]
    }
    # if { $cbb(debug) } { puts " day month year = '$day $month $year'" }

    # if { $cbb(debug) } { puts "day = '$day'" }
    set day [incr day]
    # if { $cbb(debug) } { puts " day = '$day'" }

    # for the calculations of leap years, I have ignored the fact
    # that 2000 is a leap year, but 2100, 2200 and 2300 are not.
    # This holds true for any time that the century is/is not 
    # divisible by four.  If you _have_ to have this coded in here, 
    # please write Curtis, he will know how to get ahold of me.
    # I will do it, if your need seems legit or funny enough.  -- Rob

    if {$day > 28} {                               
	# only check for Feb.  ~ 4 times a month.
        if {$month == 2} {
	    # it is Feb.
            # if { { {expr $year fmod 4} == 0} || 
	    #      { {expr $year fmod 4} == 4} } {
		# is leap year, or ends in 00
		# if {$day == 29} {
		    #first time through
                    # nop
		# } else {
		    # Feb over 29 days?
                    set day 1
                    set month 3
		# }
	    # }
        } elseif {$day > 30} {
            if {$month == 4 || $month == 6 || $month == 9 || $month == 11} {
                set day 1
                set month [incr month]
            } elseif {$day > 31} {
                set day 1
                set month [incr month]
            }
        }
    }
                
    if {$month > 12} {
	set month 1
	set year [incr year]
    }

    if {$year > 9999} {
	set year 0
    }

    return "$year[pad $month][pad $day]"
}


proc dec_date date {
    global cbb

    # if { $cbb(debug) } { puts "date = '$date'" }

    if { [string length $date] == 6 } {
	puts "invalid date in dec_date()"
	exit
	set year [full_year [string range $date 0 1]]
	set month [string range $date 2 3]
	set day [string range $date 4 5]
    } else {
	set year [string range $date 0 3]
	set month [string range $date 4 5]
	set day [string range $date 6 7]
    }

    if { [string range $day 0 0] == 0 } {
	set day [string range $day 1 1]
    }
    if { [string range $month 0 0] == 0 } {
	set month [string range $month 1 1]
    }

    set day [expr $day - 1]

    if {$day < 1} {
        if {$month == 3} {
            set day 28
            # get the leap year stuff to 
            # go in here.
        } elseif {$month == 5 || $month == 7 || $month == 10 || $month == 12} {
            set day 30
        } elseif { $month == 1 || $month == 2 || $month == 4 || $month == 6 \
                || $month == 8 || $month == 9 || $month == 11} {
            set day 31
        }
        set month [expr int($month - 1)]
    }

    if {$month < 1} {
        set month 12
        set year [expr $year - 1]
    }

    if {$year < 0} {
	set year 9999
    }

    return "$year[pad $month][pad $day]"
}
