#!/usr/bin/wish
#
# tktodo - trivial, cross-platform todo list helper
#
# dave@grox.net - Thu Jan  2 10:50:51 EST 2003
#
# 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 showdone

	eval destroy [winfo children .]

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

	menubutton .mf.file -text "tkToDo" -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.show -text "Show" -menu .mf.show.m
	menu .mf.show.m -tearoff 0
	.mf.show.m add command -label "All" -command {
		set showdone 1
		listwin
	}
	.mf.show.m add command -label "Pending" -command {
		set showdone 0
		listwin
	}

	menubutton .mf.sort -text "Sort" -menu .mf.sort.m
	menu .mf.sort.m -tearoff 0
	.mf.sort.m add command -label Priority -command {
		set sortby "Priority"
		set db [ lsort -command sortcmd $db ] 
		listwin
	}
	.mf.sort.m add command -label "Status" -command {
		set sortby "Status"
		set db [ lsort -command sortcmd $db ] 
		listwin
	}
	.mf.sort.m add command -label "Task" -command {
		set sortby "Task"
		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.show .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 . <Return>  {
		set selection $listbox_cursel
		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
		}
	}

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

	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'
		# and completed items based on menu choice
		if { $category == $curCategory || $curCategory == "All Entries" } {
			if { $showdone > 0 || [lindex $fields 1] != "X" } {
				set s [format {%1.1s  (%1.1s)  %s} [lindex $fields 1] \
					[lindex $fields 2] [lindex $fields 3] ]
				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 catEntry doneCB taskEntry priorityMB 

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

	# populate the widgets with data from the record
	#
	set fields [split $item "\t"]
	
	# --------------------------------------
	# buttons
	#
	frame .recwin.buttons
	pack .recwin.buttons -side bottom -fill x -pady 2m

	# retrieve data from widgets and create/modify a record
	#
	button .recwin.buttons.ok -text Okay -command {
		set n [join [split [.recwin.fbot.note get 0.0 end] "\n"] " "]
		set l [list $catEntry $doneCB $priorityMB $taskEntry $n]
		# since the tab character is used as a field delimiter,
		# replace all with spaces
		set l [string map {\t " "} $l]
		# create a tab delim'd record
		set item [join $l "\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
	}

	# --------------------------------------
	# category, 'done' button
	#
	frame .recwin.ftop
	pack .recwin.ftop -side top -fill x

	label .recwin.ftop.lcat -text Category
	pack .recwin.ftop.lcat -side left
	if { $mode == "View" } {
		entry .recwin.ftop.e -width 10 -textvariable catEntry -state disabled
	} else {
		entry .recwin.ftop.e -width 10 -textvariable catEntry
	}
	set catEntry [lindex $fields 0]
	pack .recwin.ftop.e -side left

	if { $mode == "View" } {
		checkbutton .recwin.ftop.cb -onvalue X -offvalue " " \
			-variable doneCB -state disabled
	} else {
		checkbutton .recwin.ftop.cb -onvalue X -offvalue " " -variable doneCB
	}
	set doneCB [lindex $fields 1]
	pack .recwin.ftop.cb -side right
	label .recwin.ftop.ldone -text Done
	pack .recwin.ftop.ldone -side right
	
	# --------------------------------------
	# task, priority
	#
	frame .recwin.fmid
	pack .recwin.fmid -side top -fill x

	label .recwin.fmid.l -text Task
	pack .recwin.fmid.l -side left

	if { $mode == "View" } {
		entry .recwin.fmid.tsk -width 20 -text [lindex $fields 3] \
			-textvariable taskEntry -state disabled
	} else {
		entry .recwin.fmid.tsk -width 20 -text [lindex $fields 3] \
			-textvariable taskEntry
	}
	set taskEntry [lindex $fields 3]
	pack .recwin.fmid.tsk -side left

	if { ! [string length [lindex $fields 2] ] } {
		set s 5
	} else {
		set s [lindex $fields 2]
	}
	if { $mode == "View" } {
		menubutton .recwin.fmid.pri -text $s -menu .recwin.fmid.pri.m \
			-relief raised -state disabled
	} else {
		menubutton .recwin.fmid.pri -text $s -menu .recwin.fmid.pri.m \
			-relief raised
	}
	menu .recwin.fmid.pri.m -tearoff 0
	global priorityMB
	set priorityMB [lindex $fields 2]
	for {set i 1} {$i <= 5} {incr i} {
		set cmd1 [list set priorityMB $i]
		set cmd2 [list .recwin.fmid.pri configure -text $i]
		.recwin.fmid.pri.m add command -label $i -command "
			$cmd1
			$cmd2
		"
	}
	pack .recwin.fmid.pri -side right

	# --------------------------------------
	# note field
	#
	frame .recwin.fbot
	pack .recwin.fbot -side top

	set s [join [split [lindex $fields 4] "|"] "\n"]
	text .recwin.fbot.note -width 30 -height 4
	.recwin.fbot.note insert 0.0 $s
	if { $mode == "View" } {
		.recwin.fbot.note configure -state disabled
	}
	pack .recwin.fbot.note
}
# whew, end of showrec

############################################################
# 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
	set s1 [split $first "\t"] 
	set s2 [split $second "\t"] 

	# else = task
	if { $sortby == "Priority" } {
		set idx 2
	} elseif { $sortby == "Status" } {
		set idx 1
	} else {
		set idx 3
	}
	return [ string compare [lindex $s1 $idx] [lindex $s2 $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 "category"
set fieldnames { "category" "done" "priority" "task" "note" }
set numfields [llength $fieldnames]
set showdone 0

############################################################
# 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) tktodo]
} elseif { $tcl_platform(os) == "macintosh" } {
	set dbfile [file join $env(PREF_FOLDER) tktodo]
} else {
	set dbfile [file join $env(HOME) .tktodo]
}

# but see if it's overridden on the command line
# we accept 2 cases:
# 1. no args - use default file, .tktodo, 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