#!/usr/bin/wish
# BEWARE: this is my FIRST Tcl/Tk program. USE EXTREME CAUTION
# jouzts@bigfoot.com
# DESC: GUI equivalent to etbl -l in Walt Hobbs' /rdb database (now nsq)
# When given no file argument, it looks for *.rdb files in a directory. 
# When called as "edrow yourNewFileName.rdb", it will ask for the number
# of columns, create and load a new rdb file. ColNames are editable on 
# row -1. Field widths (default is 10) are on line 0. Data lines number
# from 1, which accounts for a lot of the complexity of this program.
# BINDINGS: Clicking in scale tough or Shift R/L Arrow moves one row in file.
# REQUIRES: only the Tcl wish interpreter
# BUGS:
#	shift arrow <> does not work on a row added to tail of file
#	scrollform should move automatically with focus

# PROCS
# READ FILE.rdb INTO master_list
proc ReadInFile { file_name } {
	global master_list comment_list col_count
	set master_list {}
	set file_id [ open $file_name "r" ]
	set comment_list {}

	while {[gets $file_id row] != -1 } {
		# list wrap below prevents lines beginning with -
		# from being taken as options to switch
		switch -regexp [list $row] {
			^\{#.*    { lappend comment_list $row 
			}
			default {
				# divvy the line into lists on tabs
				set nuline [split $row \t]
				# add the line to the master_list
				lappend master_list $nuline
			}
		}
	}
	close $file_id
	return $master_list
}

# WRITE $master_list INTO FILE
proc WriteOutFile { file_name } {
	global master_list comment_list
	set file_id [ open $file_name "w" ]

	if { [string length $comment_list] != 0 } {
		foreach line $comment_list {
			puts $file_id $line
		}
	}

	foreach line $master_list {
		set nuline [join $line \t]
		puts $file_id $nuline
	}

	close $file_id
}

# UPDATE DISPLAY BY SCALE -command sends $current_row data 
proc UpdateDisplay { where } {
	global master_list col_names form current_row
	set x 1
	set column 0
	set current_row $where

	# Reconfigure scale length when adding or deleting rows:
	.footer.scale configure -to [expr [llength $master_list] -2]
	.footer.scale set $current_row

	foreach text $col_names {
		$form.line$x.info delete 0 end
		# lindex master_list to get row, then lindex row to get columns:
		$form.line$x.info insert 0\
		  [lindex [lindex $master_list [expr $current_row + 1]] $column]
		pack $form.line$x.info -anchor w
		incr x
		incr column
		}
	wm deiconify .
}

# UPDATE MASTER_LIST
proc UpdateMasterList {x text} {
	global master_list row_no col_count form y
	set y [expr $x + 2]

	set orow_no [expr $row_no + 1] ;# offset row no
	set row_to_replace [lindex $master_list $orow_no]
	set replaced_row [lreplace $row_to_replace $x $x $text]
	set replaced_master \
		[lreplace $master_list $orow_no $orow_no $replaced_row]
	set master_list $replaced_master
}

#CYCLE THE FOCUS THRU THE ROW ITEMS
proc UpdateFocus {line_no} {
	global col_count form

	if { $line_no <= $col_count } {
		if { $line_no > 0 } {
			focus -force $form.line$line_no.info
		}
	} else {
		focus -force $form.line1.info 
	}
}

#DELETE ONE ROW
proc DeleteOneRow {} {
global master_list row_no col_names
	set orow_no [expr $row_no + 1]
	set replaced_master [lreplace $master_list $orow_no $orow_no]
	set master_list $replaced_master
	UpdateDisplay $row_no
}

# ADD ONE ROW
proc AddOneRow {} {
	global row_no master_list col_names
	foreach x $col_names {
		lappend new_line {} 
	}
	set last_line [llength $master_list]
	set last_line_minus [expr $last_line - 1]
	set orow_no [expr $row_no + 1]

	if { $orow_no >= $last_line_minus } {
		lappend master_list $new_line
		set replaced_master $master_list
		.footer.scale configure -from -1 -to $last_line
		#can only incr $orow_no after $master_list is expanded
		incr orow_no
		incr row_no
		set display_line [expr $orow_no + 1]
	} else {
		incr orow_no
		incr row_no
		set replaced_master [linsert $master_list $orow_no $new_line]
		set display_line $row_no
		.footer.scale configure -to $last_line
	}
	set master_list $replaced_master
	UpdateDisplay $display_line
}

#SCROLLABLE CANVAS PROCS from Harrison&McLennon "Eff Tcl Progming" p 121
proc scrollform_create {win} {
	frame $win -class Scrollform

	scrollbar $win.sbar -command "$win.vport yview"
	pack $win.sbar -side right -fill y

	canvas $win.vport -yscrollcommand "$win.sbar set" -background skyblue
	pack $win.vport -side left -fill both -expand true

	frame $win.vport.form
	$win.vport create window 0 0 -anchor nw -window $win.vport.form

	bind $win.vport.form <Configure> "scrollform_resize $win"
	return $win
}

proc scrollform_resize {win} {
	set bbox [$win.vport bbox all]
	set wid [winfo width $win.vport.form]
	$win.vport configure -width $wid\
		-scrollregion $bbox -yscrollincrement 0.29i
}

proc scrollform_interior {win} {
	return "$win.vport.form"
}

proc MoveScale { units } {
	global current_row
	set bottom [ .footer.scale cget -from ]
	set top [ .footer.scale cget -to ]
	set new_row_no [ expr $current_row + $units ]

	# stay within scale limits
	if {$new_row_no >= $bottom } {
		if {$new_row_no <= $top } {
			UpdateDisplay $new_row_no
		}
	}
}

# CREATE A NEW, EMPTY .rdb FILE
proc CreateNewFile {} {
	global choice file_name
	set fileid [open $file_name w]
	# This was to have been a simple routine to use integers to head
	# columns, add a row of default field widths (to make a entry widget
	# wide enough to type into), and open an empty first data row.
	# Unlike etbl -l, you can backup to row -1 to change column
	# names without creating global search and replace commands.
	# Reload the file to see column name or field width changes.

	puts -nonewline $fileid 1 ;#device to avoid trailing tabs
	for {set i 2} { $i <= $choice} {incr i } {
		puts -nonewline $fileid "	$i" 
	}
	puts $fileid "" ;# add newline on end of column name row
	puts -nonewline $fileid "-----" ;#trailing tabs give "" width to .ent -> bomb
	for {set i 2} { $i <= $choice} {incr i } {
		puts -nonewline $fileid "	-----" 
	}
	puts $fileid "" ;# add newline on end of field width row
	;#add a row of tabs to allow focus on empty fields for first row of data
	for {set i 1} { $i <= $choice} {incr i } {
		puts -nonewline $fileid "	" 
	}
	puts $fileid ""
	close $fileid
	destroy .options
}

proc Header {} {
	global file_name form

	wm title . "edrow $file_name"

	frame .header
	label .header.title -text\
		"Shift Right/Left Arrow to move one row"
	pack .header.title -anchor n
	pack .header -expand no

	scrollform_create .sform
	pack .sform -expand yes -fill both

	set form [scrollform_interior .sform]
}

proc Footer {} {
	global master_list file_name
	set row_count [llength $master_list]

	if { $row_count >= 16 } {
		set tickinterval [expr $row_count/8]
	} else {
		set tickinterval 1
	}

	frame .footer -borderwidth 5
		set row_count [llength $master_list] 
		scale .footer.scale -from -1 -to [incr row_count -2]\
			-showvalue 1 -orient horizontal\
			-variable row_no\
			-length 5i -command {UpdateDisplay }\
			-tickinterval $tickinterval\
			-troughcolor skyblue
		pack .footer.scale

	frame .footer.fr1 -borderwidth 5
		button .footer.fr1.b_insert -text "INSERT after this row" \
			-command "AddOneRow"
		button .footer.fr1.b_delete -text "DELETE this row"\
			-command "DeleteOneRow"
		pack .footer.fr1.b_insert .footer.fr1.b_delete -side left 
	pack .footer.fr1

	frame .footer.fr2 -borderwidth 5
		button .footer.fr2.b_save -text SAVE -command \
			"WriteOutFile $file_name"
		button .footer.fr2.b_savexit -text "SAVE & EXIT" \
			-command "WriteOutFile $file_name; exit"
		button .footer.fr2.b_exit -text EXIT -command exit
	pack .footer.fr2.b_save .footer.fr2.b_savexit .footer.fr2.b_exit\
			-side left 
	pack .footer.fr2
	pack .footer -expand no
}

#MAIN
wm withdraw .

# GET INPUT FILE
if {$argv == ""} {
	set typeList {
	{{rdb files} {.rdb}}
	{{all files} {.*}}
	}
	set file_name [tk_getOpenFile -initialdir . -filetypes $typeList]
	if {$file_name == ""} { exit }
} else {
	set file_name $argv
}

# IF REQUESTED FILE DOES NOT ALREADY EXIST, CREATE?
if {![file exists $file_name]} {
	toplevel .options -class Notice
	# bind Notice <Visibility> {raise %W} #overrides tk_optionMenu
	frame .options.info
	label .options.info.icon -bitmap questhead
	label .options.info.lab1 -text "This file does not exist in this directory.
	If you wish to create it, set the number of         
	columns and click on Create. Otherwise Cancel.  "
	frame .options.sep -height 2 -borderwidth 1 -relief sunken
	frame .options.controls
	pack .options.info.icon -side left -padx 8
	pack .options.info.lab1 -side top -pady 4
	pack .options.info
	pack .options.sep -fill x -pady 4
	label .options.controls.lab2 -text "Number of columns: "

	set optMenu [tk_optionMenu .options.controls.optmenu choice temp]
	$optMenu delete 0
	set choice 7
	for {set i 1} {$i < 36} {incr i} {
		$optMenu add radiobutton -label "$i" \
			-variable choice
	}
	$optMenu invoke 6 ;#Default column number - 1
	button .options.controls.but1 -text "Create" -command "CreateNewFile"
	button .options.controls.but2 -text "Cancel" -command "exit"
	pack .options.controls.lab2 -side left -padx 4 -pady 4
	pack .options.controls.optmenu -side left
	pack .options.controls.but1 -side left
	pack .options.controls.but2 -side left
	pack .options.controls
	
	after idle {
		update idletasks
		set xmax [winfo screenwidth .options]
		set ymax [winfo screenheight .options]
		set x [expr ($xmax - [winfo reqwidth .options])/2]
		set y [expr ($ymax - [winfo reqheight .options])/2]
		wm title .options "edrow: Create new *.rdb file?"
		wm resizable .options 0 0
		wm group .options .
		wm geometry .options "+$x+$y"
	}
}

# Wait for .options window to get number of columns IF FILE DOES NOT EXIST:
if {[winfo exists .options]} {tkwait window .options}

Header

ReadInFile $file_name

# GET TBL HEADER LINES
set col_names [lindex $master_list 0]
# STRIP FIELD TYPES/JUSTIFICATION MARKS OFF COLUMN WIDTHS
regsub -all {N*M*S*\>*\<*} [lindex $master_list 1] {} col_widths

set col_count [llength $col_names]

set counter 0
foreach field $col_names dashes $col_widths {
	set width [string length $dashes] ;# convert dashes to widths
 	set line "$form.line[incr counter]"
 		frame $line -background skyblue
 		label $line.label -text $field -width 18 -anchor e\
			-background skyblue
 		pack $line.label -side left
		entry $line.info -width $width -textvariable vari$counter
 		pack $line.label -side left
 		pack $line.info -anchor w
 		pack $line -side top -fill x
 		bind $line.info <KeyPress-Return>\
 			{configure -background gray}
		set y [expr $counter -1]
 		bind $line.info <KeyPress-Return>\
		 "UpdateMasterList $y $[$line.info cget -textvariable]
			UpdateFocus [expr $y + 2]"
		bind $line.info <Leave> \
		 "UpdateMasterList $y $[$line.info cget -textvariable]"
		bind $line.info <Shift-Right> \
			"UpdateMasterList $y $[$line.info cget -textvariable]
				MoveScale 1"
		bind $line.info <Shift-Left> \
			"UpdateMasterList $y $[$line.info cget -textvariable]
				MoveScale -1"
		bind $line.info <Up> "UpdateFocus $y"
		bind $line.info <Down> "UpdateFocus [expr $y + 2]"
 }

# focus $form.line1.info
focus .sform.vport.form.line1.info
bind Entry <FocusIn> {%W configure -background white}
bind Entry <FocusOut> {%W configure -background #d9d9d9}

Footer

# wm deiconify .
UpdateDisplay 1

