#
# FD.tcl	- Filedialog utilities
#
# Bugs?  Weirdness?  E-mail jimbo@crseo.ucsb.edu
#


#
# FDGetHierarchy - run a directory back to /
#
# input:
#	dir	top-level directory (e.g., /home/jimbo/pg)
#
# returns:
#	list of directories below dir (e.g., {/home/jimbo} {/home} {/})
#
proc FDGetHierarchy { dir } { 
	if { $dir == "/" } { return "" }
	set h ""
	set d [file dirname $dir]
	while {$d != "/"} {
		lappend h $d
		set d [file dirname $d]
	}
	lappend h /
	return $h
}
#
# FDUpdate -	updates the listbox, file and glob entries
#
# action:
#	globs the current directory, adds "/" to the end of directories,
#	fills in the listbox, file and glob entry boxes
#
proc FDUpdate {} {
	global FDvars
	set dir [pwd]
	# if there never was a glob, focus on the entry box
	# so the user can add one
	if {$FDvars(glob) == "*" || $FDvars(glob) == ""} {
		set FDvars(all) 1
		.fd.select.glob delete 0 end
	}
	# fill in the hierarchy menu button
	if {[set l [string length $dir]] > $FDvars(width)} {
		set i [expr $l-$FDvars(width)]
		set d "...[string range $dir $i end]"
	} else {
		set d $dir
	}
	.fd.box.menu configure -text $d
	Working
	.fd.box.menu.m delete 0 last
	foreach d [FDGetHierarchy $dir] {
		.fd.box.menu.m add command -label $d -command "FDCwd $d"
	}
	if [info exists FDvars(lastdir)] {
		if {$FDvars(lastdir) != "/" && $FDvars(lastdir) != $dir} {
			.fd.box.menu.m add separator
			.fd.box.menu.m add command -label $FDvars(lastdir) -command "FDCwd $FDvars(lastdir)"
		}
	}
	# clear and fill the list box
	ClearBox .fd.box.list
	update
	if {$dir != "/"} {
		set files ../
	}
	if $FDvars(all) {
		if $FDvars(show) {set glob {.* *}} else {set glob *}
	} else {
		set glob $FDvars(glob)
	}

	# get list of files
	# NB: check globbing results because [glob zz] returns "zz" whether or
	# not file zz exists
	set filelist [eval glob -nocomplain $glob]
	if {$filelist == $glob && ![file exists $glob]} {set filelist ""}
	foreach f [lsort $filelist] {
		if {$f == "." || $f == ".."} continue
		if [file isdirectory $f] {
			lappend files $f/
		} else {
			if !$FDvars(SetDir) {lappend files $f}
		}
	}
	FillBox .fd.box.list $files
	Waiting
}

#
# FDCwd	- change to a new directory
#
# input:
#	d	new directory
#
# action:
#	cd's to $d, sets FDvars(lastdir), and calls FDUpdate
#
proc FDCwd { d } {
	global FDvars
	if ![file readable $d] {NoticeBox "Can't open directory $d."; return}
	set FDvars(lastdir) [pwd]
	cd $d
	set FDvars(directory) [pwd]
	FDUpdate
}

#
# FDSelect -	narrows globbing to selected files
#
# action:
#	sets FDvars(glob) from contents of glob entry box, sets FDvars(all),
#	and calls FDUpdate.  If glob entry is empty, just focuses on it.
#
proc FDSelect {} {
	global FDvars
	set glob [.fd.select.glob get]
	if {$glob == ""} {
		focus .fd.select.glob
	} else {
		set FDvars(all) 0
		set FDvars(glob) $glob
		FDUpdate
	}
}

#
# FDOk	- ok button action
#
# action:
#	grabs entry from file entry box.  If it's a directory, calls FDCwd.
#	Otherwise, if FDvars(access) = read, check for readability, if
#	= write, checks for writability and warns the user if the file
#	already exists.
#
proc FDOk { } {
	global FDvars
	set dir [pwd]
	set file [.fd.entry get]
	if [file isdirectory $file] {
		.fd.entry delete 0 end
		FDCwd $file
		return
	}

	if $FDvars(SetDir) return

	if {[file dirname $file] != "."} {
		set dir [file dirname $file]
		cd $dir	
		set FDvars(directory) $dir
		set file [file tail $file]
	}

	case $FDvars(access) in {
	w* {
		if [file exists $file] {
			if ![file writable $file] {ErrorBox "Can't write $file."; return}
			if ![Confirm "$file exists, overwrite?"] return
		}
		if ![file writable $dir] {ErrorBox "Can't write in directory $dir"; return}
	   }
	r* {
		if ![file exists $file] {NoticeBox "$file does not exists."; return}
		if ![file readable $file] {ErrorBox "Can't read $file."; return}
	    }
	}
	set FDvars(filename) $file
	destroy .fd
}

#
# FDCancel -	cancel action
#
# action:
#	cancel the file dialog and sets FDvars(filename) to {}
#
proc FDCancel {} {
	global FDvars
	cd $FDvars(savecwd)
	set FDvars(filename) {}
	set FDvars(directory) {}
	destroy .fd
}


#
# FD -		setup file dialog window
#
# inputs:
#	various args:
#		-file <filename>	default filename
#		-dir <directory>	default directory
#		-select	<pattern>	glob files matching pattern
#		-title <title>		wm title
#		-access <mode>		access mode, read or write
#		-show			show hidden files
#		-setdir			get a directory instead of a filename
#		-open			return an open file descriptor
#					instead of just a valid filename
#
# action:
#	Constructs listbox, hierarchy menubutton, back-to button,
#	globbing radiobuttons and entry, filename entry, and
#	ok, cancel, home, refresh, and jump-to buttons.  Calls FDUpdate
#	and waits for .fd window to exit before returning a valid
#	filename or open file descriptor.
#
#	Returns {} on cancel.
#
proc FD { args } {
	global FDvars

	# set default arguements or restore arguments from last
	# file dialog
	set FDvars(savecwd) [pwd]
	if ![info exists FDvars(show)] {set FDvars(show) 0}
	if ![info exists FDvars(all)] {set FDvars(all) 1}
	if ![info exists FDvars(glob)] {set FDvars(glob) {}}
	set file {}
	set select {}
	set access r
	set title "Select a File"
	set dir {}

	# parse arguments
	if ![ParseArgs {:file :dir :select :access :title show open setdir} $args] return

	# update FDvars
	set FDvars(filename) $file
	if {$dir != {} && [file isdirectory $dir] && [file readable $dir]} {
		set FDvars(lastdir) $FDvars(savecwd); cd $dir
	} else {
		set dir $FDvars(savecwd)
	}
	if {$select != {}} {
		set FDvars(glob) $select
		set FDvars(all) 0
	}
	set FDvars(access) $access
	if $show {set FDvars(show) 1}
	set FDvars(directory) $dir
	set FDvars(SetDir) $setdir

	toplevel .fd
	wm title .fd $title

	# construct right-hand buttons
	frame .fd.b
	if $FDvars(SetDir) {
		mkButton .fd.b.ok {Set Directory} {destroy .fd} default
		set label "Jump To..."
		set files directories
	} else {
		mkButton .fd.b.ok OK FDOk default
		set label Filename
		set files files
	}
	mkButton .fd.b.cancel Cancel FDCancel
	mkButton .fd.b.refresh Update {FDUpdate}
	mkButton .fd.b.home Home {FDCwd ~}
	pack append .fd.b \
		.fd.b.ok { top pady 5m frame w fillx }\
		.fd.b.cancel { top pady 5m fillx } \
		.fd.b.refresh { top pady 5m fillx } \
		.fd.b.home { top pady 5m fillx } 

	# construct left-hand labels, buttons, and listbox
	set width 30
	set FDvars(width) $width
	label .fd.directory -anchor w -width $width -text {Current Directory}
	frame .fd.box
	menubutton .fd.box.menu -menu .fd.box.menu.m -width $width -bd 3 \
		-relief raised -anchor w
	menu .fd.box.menu.m
	listbox .fd.box.list -yscroll {.fd.box.scroll set} -bd 3 -relief raised \
		-geometry ${width}x10
	bind .fd.box.list <Double-Button-1> {
		.fd.entry delete 0 end
		.fd.entry insert 0 [selection get]
		FDOk
	}
	scrollbar .fd.box.scroll -command {.fd.box.list yview} -bd 2 -relief raised
	pack append .fd.box \
		.fd.box.menu { top frame w }\
		.fd.box.list left \
		.fd.box.scroll {left filly}

	checkbutton .fd.show -variable FDvars(show) -relief flat \
		-variable FDvars(show) -onvalue 1 -offvalue 0 \
		-text "Show hidden $files" -command FDUpdate

	label .fd.filename -text $label -width $width -anchor w
	entry .fd.entry -relief sunken -bd 4 -width $width
	.fd.entry insert 0 $FDvars(filename)

	# construct file-pattern matching frame
	frame .fd.select
	label .fd.select.label -text "Select" -anchor e
	radiobutton .fd.select.all -variable FDvars(all) -value 1 \
		-text "all $files" -command FDUpdate -relief flat
	radiobutton .fd.select.match -variable FDvars(all) -value 0 \
		-text "$files matching" -command FDSelect -relief flat
	entry .fd.select.glob -width 10 -relief sunken -bd 2
	.fd.select.glob insert 0 $FDvars(glob)
	pack append .fd.select \
		.fd.select.label left \
		.fd.select.all {top frame w} \
		.fd.select.match left \
		.fd.select.glob left
	bind .fd.select.glob <Return> FDSelect

	set tablist ".fd.entry .fd.select.glob .fd.b.ok .fd.b.cancel .fd.b.refresh .fd.b.home"

	if !$FDvars(SetDir) {
		mkButton .fd.b.jump "Jump To..." {FDCwd [EntryDialog "Jump to directory" {} Jump]}
		pack append .fd.b .fd.b.jump { top pady 5m fillx } 
		bind .fd.entry <Return> {.fd.b.ok flash;.fd.b.ok invoke}
		lappend tablist .fd.b.jump
	} else {
		bind .fd.entry <Return> FDOk
	}

	mkInfoBar .fd.title -text $title -msg "Scanning..."
	#label .fd.title -text $title
	# pack everything together, setup tabbing between buttons and entries
	pack append .fd \
		.fd.title {top fillx pady 5m} \
		.fd.b {right padx 5m} \
		.fd.directory {top frame w pady 1m} \
		.fd.box {top frame w pady 1m} \
		.fd.show {top frame w pady 1m} \
		.fd.filename {top frame w pady 1m} \
		.fd.entry {top frame w pady 1m} \
		.fd.select top
	eval SetTabbing $tablist

	# update listbox and wait for .fd to be destroyed
	FDUpdate
	bind Entry <Control-x> {
		puts stderr "\n\tFDvars:\n[join [DumpArray FDvars] \n]"
	}
	tkwait window .fd
	cd $FDvars(savecwd)

	# cancel'ed early return
	if {$FDvars(directory) == {}} {return {}}

	# directory early return
	if $FDvars(SetDir) {
		return $FDvars(directory)
	}

	# filename-only early return
	if !$open {return $FDvars(directory)/$FDvars(filename)}

	# attempt to open file and return file descriptor
	if [catch {set file [open $FDvars(directory)/$FDvars(filename) $FDvars(access)]} err] {
		ErrorBox $err ; return {}
	} else {
		return $file
	}
}

#
# FD macros -	simple macros for calling FD
#
# inputs:
#	title	wm title
#	args	additional FD args (e.g., -file, -show, etc.)
#
#
# Return a writable filename
proc FDSaveFilename {args}  {
	eval FD -access w -title {{Save File}} $args
}
#
# Return a readable filename
proc FDOpenFilename {args} {
	eval FD -access r -title {{Open File}} $args
}
#
# Return a writeable open file descriptor
proc FDSave {args}  {
	eval FD -access w -open -title {{Save File}} $args
}
#
# Return a readable open file descriptor
proc FDOpen {args} {
	eval FD -access r -open -title {{Open File}} $args
}
#
# Return a directory name
proc FDSetDir {args} {
	eval FD -setdir -title {{Set Directory}} $args
}