#!/usr/local/bin/wish8.5 -f
#  'CBB' -- Check Book Balancer
#
#   categories.tcl - category specific front end code.
#
#  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: categories.tcl,v 2.7 1997/03/05 18:58:32 curt Exp $
# (Log is kept at end of this file)


#------------------------------------------------------------------------------
# import the default category list
#------------------------------------------------------------------------------

proc catImportDefaults {} {
    global cbb eng lib_path yesno

    if { $cbb(safe_mode) == 1 } { 
	return 
    }

    # check for a valid file
    if { "$cbb(cur_file)" == "noname.cbb" } {
	cbbWindow.ok "You must either Make or Load an Account First."
	tkwait window .ok
	return
    } elseif { "$cbb(cur_file)" == ""} {
	cbbWindow.ok "You must either Make or Load an Account First."
	tkwait window .ok
	return
    }

    cbbWindow.yesno "Do you really wish to import the default categories?"
    tkwait window .yesno

    if { "$yesno(result)" == "yes" } {
        if { $cbb(debug) } {
	    puts "Importing the default category file $lib_path/$cbb(def_cat)"
	}
        puts $eng "load_cats $lib_path/$cbb(def_cat)"; flush $eng

	if { $cbb(debug) } { puts "Reading result" }
	gets $eng result
	if { $cbb(debug) } { puts "Got result: $result" }
    }
}


#------------------------------------------------------------------------------
# Procedures to handle unknown categories
#------------------------------------------------------------------------------

proc cbbWindow.newcat {} {
    global cbb addcat

    if {[winfo exists .newcat] == 1} {
        destroy .newcat
    }

    option add *font $cbb(dialog_font)

    set addcat(desc) $addcat(cat)
    set addcat(tax) 0

    toplevel .newcat

    if { $addcat(mode) == "normal" } {
	wm title .newcat "Add New Category ..."
	wm iconname .newcat "Add New Category ..."
    } else {
	wm title .newcat "Unknown Category ..."
	wm iconname .newcat "Unknown Category ..."
    }
    frame .newcat.frame -borderwidth 2 -relief raised

    if { $addcat(mode) == "normal" } {
	message .newcat.frame.m -width 300 -font $cbb(msg_text_font) -text \
		"Please enter a new category and description:"
    } else {
	message .newcat.frame.m -width 300 -font $cbb(msg_text_font) -text \
		"WARNING:  The category, ``$addcat(cat)'' does not exist.  \
		What would you like to do?"
    }

    frame .newcat.frame.c -borderwidth 2
    frame .newcat.frame.d -borderwidth 2

    label .newcat.frame.c.label -text "Category"
    entry .newcat.frame.c.entry -textvariable addcat(cat) -relief sunken \
	    -font $cbb(default_font)

    label .newcat.frame.d.label -text "Description"
    entry .newcat.frame.d.entry -textvariable addcat(desc) -relief sunken \
	    -font $cbb(default_font)

    checkbutton .newcat.frame.tax -text "Tax Related?" -variable addcat(tax) \
	    -anchor w -font $cbb(button_font)

    button .newcat.frame.create -text "Add to the category \
	    list" -font $cbb(button_font) -command {
	if { $cbb(debug) } { puts "adding $addcat(cat)" }
	if { "$addcat(tax)" == "0" } {
	    puts $eng "insert_cat $addcat(cat)\t$addcat(desc)\t"
	    flush $eng
	} else {
	    puts $eng "insert_cat $addcat(cat)\t$addcat(desc)\tx"
	    flush $eng
	}
	gets $eng result
	if { $cbb(debug) } { puts "Adding category: $result" }
	if { $cbb(safe_mode) == 0 } {
	    if { $cbb(debug) } { puts "Saving category file" }
	    puts $eng "save_cats [file dirname $cbb(cur_file)]/categories"
	    flush $eng
	    gets $eng result
	    if $cbb(debug) { puts "save result=$result" }
	}
	set addcat(result) "yes"
	destroy .newcat 
    }

    button .newcat.frame.ignore -text "Do not add to the list" \
	    -font $cbb(button_font) -command {
	set addcat(result) "no"
        destroy .newcat 
    }

    button .newcat.frame.seecats -text "See category list" \
	    -font $cbb(button_font) -command { 
	set addcat(result) "see"
	cbbWindow.catwin
	destroy .newcat 
    }

    pack .newcat.frame -side top -fill both -expand 1
    pack .newcat.frame.ignore .newcat.frame.create .newcat.frame.seecats \
	    -side bottom -fill x -padx 8 -pady 4
    pack .newcat.frame.m -side top -fill x
    pack .newcat.frame.c .newcat.frame.d -side top -fill x \
	    -expand 1
    pack .newcat.frame.tax -side top -fill x -expand 1 -padx 8 -pady 4
    pack .newcat.frame.c.label -side left
    pack .newcat.frame.c.entry -side left -fill x -expand 1

    pack .newcat.frame.d.label -side left
    pack .newcat.frame.d.entry -side left -fill x -expand 1


    focus .newcat.frame.c.entry
}


#------------------------------------------------------------------------------
# Procedures to interactively view and edit categories
#------------------------------------------------------------------------------

proc cbbWindow.catwin {} {
    global cbb lib_path cat addcat

    if {[winfo exists .catwin] == 1} {
        destroy .catwin
    }

    option add *font $cbb(dialog_font)
    
    toplevel .catwin

    wm title .catwin "Category List"
    wm iconname .catwin "Category List"
    frame .catwin.frame -borderwidth 2 -relief raised
    pack .catwin.frame -side top -fill both -expand 1

    frame .catwin.frame.l
    frame .catwin.frame.b
    pack .catwin.frame.b -side bottom -fill x
    pack .catwin.frame.l -side top -fill both -expand 1

    listbox .catwin.frame.l.list -width 55 -height 15 \
	-exportselection false -relief sunken \
	-yscrollcommand ".catwin.frame.l.scroll set" -font $cbb(fixed_font)

    bind .catwin <KeyPress-Down> { .catwin.frame.l.list \
	    yview scroll 1 units }
    bind .catwin <Control-KeyPress-n> { .catwin.frame.l.list \
	    yview scroll 1 units }
    bind .catwin <KeyPress-n> { .catwin.frame.l.list \
	    yview scroll 1 units }
    bind .catwin <KeyPress-j> { .catwin.frame.l.list \
	    yview scroll 1 units }

    bind .catwin <KeyPress-Up> { .catwin.frame.l.list \
	    yview scroll -1 units }
    bind .catwin <Control-KeyPress-p> { .catwin.frame.l.list \
	    yview scroll -1 units }
    bind .catwin <KeyPress-p> { .catwin.frame.l.list \
	    yview scroll -1 units }
    bind .catwin <KeyPress-k> { .catwin.frame.l.list \
	    yview scroll -1 units }

    bind .catwin <KeyPress-Next> { .catwin.frame.l.list \
	    yview scroll 1 pages }
    bind .catwin <Control-KeyPress-v> { .catwin.frame.l.list \
	    yview scroll 1 pages }

    bind .catwin <KeyPress-Prior> { .catwin.frame.l.list \
	    yview scroll -1 pages }
    bind .catwin <Alt-KeyPress-v> { .catwin.frame.l.list \
	    yview scroll -1 pages }

    scrollbar .catwin.frame.l.scroll -command ".catwin.frame.l.list yview" \
	-relief flat
    pack .catwin.frame.l.scroll -side right -fill y
    pack .catwin.frame.l.list -side left -fill both -expand 1

    bind .catwin.frame.l.list <Double-Button> {
	if { "[.catwin.frame.l.list curselection]" != "" } {
	    set cat [string trim [string range \
		[.catwin.frame.l.list get [.catwin.frame.l.list curselection]] \
		3 27]]
	}
    }

    button .catwin.frame.b.add -text "Add" -command { 
	set addcat(cat) ""
	set addcat(mode) "normal"
	cbbWindow.newcat
	tkwait window .newcat
	if { [winfo exists .catwin] } {
	    # parent could have already been dismissed.
	    catLoad .catwin.frame.l.list
	}
    }
    button .catwin.frame.b.delete -text "Delete" -command { 
	if { "[.catwin.frame.l.list curselection]" != "" } { 
	    catDelete [.catwin.frame.l.list get \
	            [.catwin.frame.l.list curselection]]
	}
    }
    button .catwin.frame.b.paste -text "Paste" -command {
	if { "[.catwin.frame.l.list curselection]" != "" } {
	    set cat [string trim [string range \
		[.catwin.frame.l.list get [.catwin.frame.l.list curselection]] \
		3 27]]
	}
    }
    button .catwin.frame.b.dismiss -text "Dismiss" \
	-command { destroy .catwin }

    pack .catwin.frame.b.add .catwin.frame.b.delete .catwin.frame.b.paste \
	    .catwin.frame.b.dismiss -side left -fill x -expand 1 -padx 8 -pady 8

    catLoad .catwin.frame.l.list
}


# load the category listbox
proc catLoad win {
    global eng

    $win delete 0 end

    puts $eng "all_cats"; flush $eng
    gets $eng result; 
    while { $result != "none" } {
	set pieces [split $result "\t"]
	set key [lindex $pieces 0]
	set desc [lindex $pieces 1]
	set tax [lindex $pieces 2]
	
        $win insert end [format "%-2s %-25s %-25s" $tax $key $desc]
        gets $eng result
    }
}


# actually delete ...
proc catDelete line {
    global cbb del_cat eng yesno

    set del_cat [string trim [string range $line 3 28]]
    if { $cbb(debug) } { puts '$del_cat' }

    puts $eng "find_cat $del_cat"; flush $eng
    gets $eng result

    if { "$result" != "none" } {
	set pieces [split $result "\t"]
	set key [lindex $pieces 0]
	set desc [lindex $pieces 1]

	cbbWindow.yesno "Do you really wish to delete the category ``$key''?"
	tkwait window .yesno
	
	if { "$yesno(result)" == "yes" } {
	    if { $cbb(debug) } { puts "deleting $del_cat" }
	    puts $eng "delete_cat $del_cat"; flush $eng
	    gets $eng result
	    if { $cbb(debug) } { 
		puts "deleting category: $result"
	    }
	    catLoad .catwin.frame.l.list
	}
    } else {
	cbbWindow.ok "Cannot locate account ``$del_cat''."
	tkwait window .ok
    }
}


# ----------------------------------------------------------------------------
# $Log: categories.tcl,v $
# Revision 2.7  1997/03/05 18:58:32  curt
# Added additional bindings to scrolling lists: categories list, balance
# window list, text help, and report list.
#
# Revision 2.6  1996/12/17 14:53:52  curt
# Updated copyright date.
#
# Revision 2.5  1996/12/16 04:18:12  curt
# Continuing the great overhaul of December 1996.
#
# Revision 2.4  1996/12/14 17:15:20  curt
# The great overhaul of December '96.
#
# Revision 2.3  1996/12/11 18:33:27  curt
# Ran a spell checker.
#
# 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:14  curt
# Renamed *.tk -> *.tcl
#
# Revision 2.6  1996/10/23 01:32:50  curt
# Fixed a typo that caused an error when attempting to delete a category.
#
# Revision 2.5  1996/10/01 20:25:37  curt
# Added better handling of unknown category when trying to "commit" a
# transaction.
#
# Revision 2.4  1996/09/30 15:14:35  curt
# Updated CBB URL, and hardwired wish path.
#
# Revision 2.3  1996/08/15 15:03:16  curt
# Add view category list button when handling an unknown category.
#
# Revision 2.2  1996/07/13 02:57:35  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:32  curt
# Just stumbling around a bit with cvs ... :-(
#
# Revision 2.0  1996/02/27  04:41:47  curt
# Initial 2.0 revision.  (See "Log" files for old history.)
