#!/usr/local/bin/wish8.5 -f
#  'CBB' -- Check Book Balancer
#
#   bindings.tcl -- common bindings
#
#  Written by Curtis Olson.  Started August 25, 1994.
#
#  Copyright (C) 1994 - 1997  Curtis L. Olson  - curt@sledge.mn.org
#
#  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 2.8 1997/01/02 04:38:30 curt Exp $
# (Log is kept at end of this file)


#------------------------------------------------------------------------------
# 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
    }
}


proc inc_date nicedate {
    global cbb

    if { $cbb(date_fmt) == 1 } {
	if { "$nicedate" == "" } {
	    set nicedate "01/01/01"
	}

	set pieces [split $nicedate /]
        set month [expr int([lindex $pieces 0].)]
        set day [expr int([lindex $pieces 1].)]
    } else {
	if { "$nicedate" == "" } {
	    set nicedate "01.01.01"
	}

	set pieces [split $nicedate .]
        set day [expr int([lindex $pieces 0].)]
        set month [expr int([lindex $pieces 1].)]
    }

    set year [expr int([lindex $pieces 2].)]

    if { [string length $year] == 2 } {
	set year "$cbb(century)$year"
    }

    set day [incr 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
    }

    if { $cbb(date_fmt) == 1 } {
	if { [string length $year] == 4 } {
	    return "[pad $month]/[pad $day]/[string range [pad $year] 2 3]"
	} else {
	    return "[pad $month]/[pad $day]/[pad $year]"
	}
    } else {
	if { [string length $year] == 4 } {
	    return "[pad $day].[pad $month].[string range [pad $year] 2 3]"
	} else {
	    return "[pad $day].[pad $month].[pad $year]"
 	}
    }
}


proc dec_date nicedate {
    global cbb

    if { $cbb(date_fmt) == 1 } {
	if { "$nicedate" == "" } {
	    set nicedate "01/01/01"
	}

	set pieces [split $nicedate /]
        set month [expr int([lindex $pieces 0].)]
        set day [expr int([lindex $pieces 1].)]
    } else {
	if { "$nicedate" == "" } {
	    set nicedate "01.01.01"
	}

	set pieces [split $nicedate .]
        set day [expr int([lindex $pieces 0].)]
        set month [expr int([lindex $pieces 1].)]
    }

    set year [expr int([lindex $pieces 2].)]

    if { [string length $year] == 2 } {
	set year "$cbb(century)$year"
    }

    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
    }

    if { $cbb(date_fmt) == 1 } {
	if { [string length $year] == 4 } {
	    return "[pad $month]/[pad $day]/[string range [pad $year] 2 3]"
	} else {
	    return "[pad $month]/[pad $day]/[pad $year]"
	}
    } else {
	if { [string length $year] == 4 } {
	    return "[pad $day].[pad $month].[string range [pad $year] 2 3]"
	} else {
	    return "[pad $day].[pad $month].[pad $year]"
 	}
    }
}


# ----------------------------------------------------------------------------
# $Log: bindings.tcl,v $
# Revision 2.8  1997/01/02 04:38:30  curt
# Changes over the 1996 holidays:
#   - Converted listbox to text widget.  This allows us to do nice
#     things with alternating background colors, highliting, red
#     negative numbers, etc.
#   - Negative transactions are now drawn in red.
#   - Added a Goto <Today> option.
#   - <Home> & <End> were double bound.  Now, listbox can be traversed with
#     <Meta-Home> and <Meta-End>
#
# Revision 2.7  1996/12/17 14:53:51  curt
# Updated copyright date.
#
# Revision 2.6  1996/12/16 04:18:11  curt
# Continuing the great overhaul of December 1996.
#
# Revision 2.5  1996/12/14 17:15:19  curt
# The great overhaul of December '96.
#
# Revision 2.4  1996/12/11 18:33:25  curt
# Ran a spell checker.
#
# Revision 2.3  1996/12/09 14:36:56  curt
# Fixed a couple of variables to be in the cbb() realm where they should be.
#
# Revision 2.2  1996/12/08 07:39:57  curt
# Rearranged quite a bit of code.
# Put most global variables in cbb() structure.
#
# Revision 2.1  1996/12/07 20:38:13  curt
# Renamed *.tk -> *.tcl
#
# Revision 2.13  1996/11/07 20:30:25  curt
# Fixed the <Control-Tab> binding for the description field (again ... oops :-)
#
# Revision 2.12  1996/10/22 19:43:15  curt
# Rob and Heather got the inc_date and dec_date to work with months with
# other than 31 days.  They will do the leap year stuff later.
#
# Revision 2.10  1996/10/02 19:37:16  curt
# Replaced instances of hardcoded century (19) with a variable.  We need to
# know the current century in cases where it is not provided and it is
# assumed to be the current century.  Someday I need to figure out how
# to determine the current century, but I have a couple of years to do it. :-)
#
# I still need to fix conf-reports and reports.pl
#
# Revision 2.9  1996/09/30 15:14:35  curt
# Updated CBB URL, and hardwired wish path.
#
# Revision 2.8  1996/09/28 21:18:10  curt
# Fixed a problem in the autohilite code that caused delete/backspace not
# to work if you just tabbed to and started typing in a previously blank
# field.  Also, previous selection is cleared when tabbing to a blank field.
#
# Revision 2.7  1996/09/26 19:53:35  curt
# Worked on splits totals to automatically keep track of the difference.
# Touch up tab completion.
#
# Revision 2.6  1996/09/25 17:45:42  curt
# Revamped tab completions in description and category fields.
# Fixed a problem with autohiliting.  When tabbing to a blank field, we used
# to leave the previous hilited field hilited.
#
# Revision 2.5  1996/09/25 17:11:09  curt
# Added some initial code to better handle tab completion.
#
# Revision 2.4  1996/08/29 14:31:50  curt
# Removed unused bindings.  (tk3.6 support)
#
# Revision 2.3  1996/08/29 14:22:33  curt
# <Meta-Tab> changed to <Control-Tab> in desc field.
#
# Revision 2.2  1996/07/13 02:57:33  curt
# Version 0.65
# Packing Changes
# Documentation changes
# Changes to handle a value in both debit and credit fields.
#
# Revision 2.1  1996/02/27  05:35:30  curt
# Just stumbling around a bit with cvs ... :-(
#
# Revision 2.0  1996/02/27  04:41:45  curt
# Initial 2.0 revision.  (See "Log" files for old history.)
