#!/usr/bin/wish
#
# tkrolo - trivial, cross-platform contact list helper
#
# dave@grox.net - Wed Jan  1 04:57:25 EST 2003
#
# based on tkshop:
# dave@grox.net - Sat Dec 28 10:17:20 EST 2002
#
# based on tkpwdb:
# dave.capella@cornell.edu - Sat Dec 21 03:26:22 EST 2002
#
# May be freely distributed and used as long as this header is retained.
# All modifications must be clearly indicated.
#
# The author makes no promise of technical support. However, bug reports,
# suggestions, questions, and comments are welcome. All will be answered
# via electronic mail as time allows.
#
# NO WARRANTY OF ANY KIND EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
#
############################################################

############################################################
# load data from disk
#
proc getdb {dbfile } {
	global db categories curCategory

	set db {}
	set categories {}
	set curCategory "All Entries"

	if { [catch {set fd [ open $dbfile r ] } ] } {
		return {}
	}
	set buf [ read $fd ]
	close $fd

	foreach line [ split $buf "\n" ] {
		# parse the fields from the line (split on tab)
		set fields [split $line "\t" ]
		if { [string length $line] > 1 } {
			if { [string length [lindex $fields 0]] < 1 } {
				set fields [lreplace $fields 0 0 "none"]
			}
			lappend categories [lindex $fields 0]
			set line [join $fields "\t"]
			lappend db $line
		}
	}

	set categories [ lsort -unique -dictionary $categories ]
	set curCategory [ lindex $categories 0 ]
	return $db
}

############################################################
# write data to disk
#
proc putdb {} {
	global db dbfile

	# add the data for each record
	#
	set buf {}
	foreach line $db {
		if [ string length $line ] {
			append buf "$line\n"
		}
	}

	set fd [ open $dbfile w ]
	puts $fd $buf
	close $fd
}

############################################################
# view and edit entries - main window
#
proc listwin {} {
	global db categories curCategory listbox_map listbox_cursel item
	global lb_list sortby

	eval destroy [winfo children .]

	# app menu
	#
	frame .mf -relief raised
	pack .mf -side top -fill x

	menubutton .mf.file -text "tkRolo" -menu .mf.file.m
	menu .mf.file.m -tearoff 0
	.mf.file.m add command -label "Save" -command putdb
	.mf.file.m add command -label "Quit" -command exit

	menubutton .mf.edit -text "Entry" -menu .mf.edit.m
	menu .mf.edit.m -tearoff 0
	.mf.edit.m add command -label "View" -command {
		set selection [.frame.list curselection]
		if [expr [llength $selection] == 1 ] {
			set idx [lindex $listbox_map $selection]
			set item [lindex $db $idx]
			showrec View
			tkwait window .recwin
			listwin
			.frame.list activate $idx
			.frame.list see $idx
		}
	}
	.mf.edit.m add command -label "Add" -command {
		set item {}
		showrec Add
		tkwait window .recwin
		lappend db $item
		listwin
	}
	.mf.edit.m add command -label "Edit" -command {
		set selection [.frame.list curselection]
		if [expr [llength $selection] == 1 ] {
			set idx [lindex $listbox_map $selection]
			set item [lindex $db $idx]
			set item [showrec Edit]
			tkwait window .recwin
			set db [lreplace $db $idx $idx $item]
			listwin
			.frame.list activate $idx
			.frame.list see $idx
		}
	}
	.mf.edit.m add command -label "Delete" -command {
		set selection [.frame.list curselection]
		if [expr [llength $selection] == 1 ] {
			set idx [lindex $listbox_map $selection]
			set db [lreplace $db $idx $idx]
			listwin
		}
	}

	menubutton .mf.sort -text "Sort" -menu .mf.sort.m
	menu .mf.sort.m -tearoff 0
	.mf.sort.m add command -label "Name" -command {
		set sortby "name"
		set db [ lsort -command sortcmd $db ] 
		listwin
	}
	.mf.sort.m add command -label "Company" -command {
		set sortby "company"
		set db [ lsort -command sortcmd $db ] 
		listwin
	}

	menubutton .mf.category -text $curCategory -menu .mf.category.m
	menu .mf.category.m -tearoff 0
	.mf.category.m add command -label "All Entries" -command {set curCategory "All Entries" ; listwin}

	pack .mf.file .mf.edit .mf.sort .mf.category -side left
	#
	# end: app menu

	# search field
	frame .fsearch
	pack .fsearch -side top -fill x
	button .fsearch.b -text Find -command {
		set s [join [list ".*" $searchpat ".*"] ""]
		set idx [lsearch -regexp $db $s]
		if { $idx >= 0 } {
			set curCategory "All Entries"
			listwin
			.frame.list see $idx
		}
	}
	entry .fsearch.e -textvariable searchpat -width 20
	pack .fsearch.b .fsearch.e -side left


	# listbox
	#
	frame .frame
	pack .frame -side right -expand yes -fill both

	scrollbar .frame.scroll -command ".frame.list yview"
	listbox .frame.list -yscroll ".frame.scroll set" -setgrid 1 -height 15 \
		-width 30 -background white -selectmode single -listvar lb_list
	pack .frame.scroll -side right -fill y
	pack .frame.list -side left -expand 1 -fill both

	fill_listbox

	foreach s $categories {
		.mf.category.m add command -label "$s" -command "set curCategory $s ; listwin"
	}

	# event bindings
	#
	# needed to update current selection
	bind .frame.list <<ListboxSelect>>  { set listbox_cursel [%W curselection] }

	# view record
	bind .frame.list <Double-Button-1>  {
		set listbox_cursel [%W curselection]
		set selection [%W curselection]
		if [expr [llength $selection] == 1 ] {
			set idx [lindex $listbox_map $selection]
			set item [lindex $db $idx]
			showrec View
			tkwait window .recwin
			listwin
			.frame.list activate $idx
			.frame.list see $idx
		}
	}
	bind .fsearch.e <Return>  {
		set s [join [list ".*" $searchpat ".*"] ""]
		set idx [lsearch -regexp $db $s]
		# skip first char - might be a cap
		# FIXME - right way would be to make searchpat title-case
		if { $idx == -1 } {
			set s [join [list ".*" [string range $searchpat 1 end] ".*"] ""]
			#debug
			puts "s: $s"
			set idx [lsearch -regexp $db $s]
		}
		if { $idx >= 0 } {
			set curCategory "All Entries"
			listwin
			.frame.list see $idx
		}
	}

	# edit record
	bind .frame.list <Double-Button-3>  {
		set listbox_cursel [%W curselection]
		set selection [%W curselection]
		if [expr [llength $selection] == 1 ] {
			set idx [lindex $listbox_map $selection]
			set item [lindex $db $idx]
			showrec Edit
			tkwait window .recwin
			set db [lreplace $db $idx $idx $item]
			listwin
			.frame.list activate $idx
			.frame.list see $idx
		}
	}

}

############################################################
# insert category of entries into list box from db
#
proc fill_listbox {} {
	global db curCategory listbox_map categories lb_list

	set db_idx 0
	set categories {}
	set listbox_map {}
	set lb_list {}

	foreach item $db {
		set fields [ split $item "\t" ]
			set category [ lindex $fields 0 ]
		# only insert items in the current category or 'All Entries'
		if { [string equal $category $curCategory ] || \
			[string equal "All Entries" $curCategory] } {

			set name "[lindex $fields 2] [lindex $fields 1]"
			set s $name
			lappend lb_list $s
			lappend listbox_map $db_idx
		}

		# generate the list of categories from the first field
		lappend categories [ lindex $fields 0 ]

		incr db_idx
	}
	set categories [ lsort -unique -dictionary $categories ]
}

############################################################
# view and edit entries - main window
#
proc showrec {mode} {
	global db dbfile categories curCategory item numfields fieldnames
	global entryVals

	catch {destroy .recwin}
	toplevel .recwin
	wm title .recwin "$mode Record"

	set fields [split $item "\t"]
	
	frame .recwin.buttons
	pack .recwin.buttons -side bottom -fill x -pady 2m

	button .recwin.buttons.ok -text Okay -command {
		set e {}
		foreach field $fieldnames {
			lappend e $entryVals($field)
		}
		set item [join $e "\t"]

		destroy .recwin
		return $item
		}
	# add a 'cancel' button if editing or adding
	if { $mode != "View" } {
		button .recwin.buttons.cancel -text Cancel -command {
			destroy .recwin
			return $item
			}
		pack .recwin.buttons.ok .recwin.buttons.cancel -side left -expand 1
	} else {
		pack .recwin.buttons.ok -side top -expand 1
	}

	set i 0
	foreach field $fieldnames {
		set f .recwin.$field
		frame $f -bd 0
		set entryVals($field) [lindex $fields $i]
		if [string equal $mode View] {
			entry $f.e -relief sunken -width 30 -state disabled -textvariable entryVals($field)
		} else {
			entry $f.e -relief sunken -width 30 -textvariable entryVals($field)
		}
		label $f.l -text [string totitle $field]
		pack $f.e -side right
		pack $f.l -side left
		pack $f -side top -fill x
		incr i
	}

}

############################################################
# display a message in a window
#
proc msg { txt } {
	catch { destroy .msgwin }
	toplevel .msgwin
	label .msgwin.l -text $txt
	button .msgwin.b -text ok -command { destroy .msgwin }
	pack .msgwin.l .msgwin.b
}

############################################################
# sort data by arbitrary field
#
proc sortcmd { first second } {
	global sortby

	if { $sortby == "company" } { set idx 4 } else { set idx 1 }
	return [ string compare [lindex [split $first "\t"]  $idx] \
		[lindex [split $second "\t"] $idx] ]
}

#####################################################################
# globals
# i know, ya ain't s'posed ta, but this is a tiny program, after all.
#
set db {}
set categories {}
set listbox_map {}
set item {}
set lb_list {}
set sortby "company"
set fieldnames { "category" "last" "first" "title" "company" "work" "home"
	"fax" "other" "email" "address" "city" "state" "zip" "country" "note"
}
set numfields [llength $fieldnames]

############################################################
# main
############################################################

# for the ipaq - it's a small screen.
# 
#if { $tcl_platform(machine) == "armv4l" } {
#	option add "*Font" "-*-*-*-*-*-*-7-*-*-*"
#} elseif { $tcl_platform(os) == "Linux" } {
#	option add "*Font" "fixed"
#} elseif { [string equal -length 7 $tcl_platform(os) "Windows"] } {
#	option add "*Font" "Courier"
#}
if { $tcl_platform(machine) == "armv4l" } {
	option add "*Font" "-*-*-*-*-*-*-7-*-*-*"
}

# initialize the default location for the data file
#
if { [string equal -nocase -length 7 $tcl_platform(os) "windows" ] } {
	set dbfile [file join $env(HOMEDRIVE) $env(HOMEPATH) tkrolo]
} elseif { $tcl_platform(os) == "macintosh" } {
	set dbfile [file join $env(PREF_FOLDER) tkrolo]
} else {
	set dbfile [file join $env(HOME) .tkrolo]
}

# but see if it's overridden on the command line
# we accept 2 cases:
# 1. no args - use default file, .tkrolo, in $HOME
# 2. 1 arg - file name to open
#
if { $argc } {
	set dbfile [lindex $argv 1]
	if [ expr ! [ file isfile $argv ] ] {
		msg "Cannot use the file: $argv"
		tkwait window .msgwin
		exit
	}
}

set db [ lsort -dictionary [ getdb $dbfile ] ]
listwin

bind . <Control-q> exit