# jfs.tcl - file-selection panel
#
######################################################################
# Copyright 1992-1995 by Jay Sekora.  This file may be freely        #
# distributed, modified or unmodified, for any purpose, provided     #
# that this copyright notice is retained verbatim in all copies and  #
# no attempt is made to obscure the authorship of this file.  If you #
# distribute any modified versions, I ask, but do not require, that  #
# you clearly mark any changes you make as such and that you provide #
# your users with instructions for getting the original sources.     #
######################################################################

### TO DO
###   more error-checking in j:fs
###   fix focus on j:fs
###   option for load/save?
###   mkdir when saving?
###   `default' behaviour needs fixed (do we even need a default now?)

### CHANGES
###   j:fs now no longer does a cd (well, it does, but it un-does it)

######################################################################
# global variables:
#
global J_PREFS env
j:default J_PREFS(autoposition) 0
j:default J_PREFS(confirm) 1
#
######################################################################

######################################################################
# j:fs ?options? - file selector box
# options are:
#   -buttons (default {ok cancel home})
#   -prompt (default "Choose a file")
#   -directory (default ".")
#   -cancelvalue (default "")
#   -fileprompt (default "File:")
#   -title (default "File Selector")
#   -types (default "")
#   -typevariable (default "")
# NOTE: this may do a cd---affects entire app!
######################################################################
### this proc is too monolithic; it should be broken up.

proc j:fs { args } {
  j:parse_args {
    {buttons {ok cancel home} }
    {prompt "Choose a file"}
    {directory "."}
    {cancelvalue ""}
    {fileprompt "File:"}
    {title title:jfs}
    {types ""}
    {typevariable ""}
    {typeprompt "File type:"}
  }
  
  set prompt [uplevel 1 [list j:ldb $prompt]]
  set fileprompt [uplevel 1 [list j:ldb $fileprompt]]
  set title [uplevel 1 [list j:ldb $title]]
  set typeprompt [uplevel 1 [list j:ldb $typeprompt]]
    
  global j_fs env J_PREFS
  global fs_defaultbutton
  set J_PREFS(0) 1		;# make sure it's intepreted as array
  
  if {[lsearch [array names J_PREFS] {j_fs_fast}] == -1} {
    set J_PREFS(j_fs_fast) 0	;# make sure it's defined
  }
  if {[lsearch [array names J_PREFS] {scrollbarside}] == -1} {
    set J_PREFS(scrollbarside) right ;# make sure it's defined
  }
  
  set old_cwd [pwd]		;# save current directory to un-do cd's
  
  set dir $directory
  set file ""

  if {![file isdirectory $dir]} {
    set dir .
  }

  set fs_defaultbutton [lindex $buttons 0]

  set j_fs(result) $file
  set j_fs(type) {}
  
  set old_focus [focus]			;# so we can restore original focus
  
  if [winfo exists .fs] {
    destroy .fs
  }

  cd $dir

  toplevel .fs
  wm title .fs $title
  wm minsize .fs 10 10

  label .fs.prompt -anchor w -text $prompt
  label .fs.cwd -text [pwd]
  frame .fs.list
  listbox .fs.list.lb -yscroll ".fs.list.sb set"
  j:tk3 {.fs.list.lb configure -geometry 30x20}
  j:tk4 {.fs.list.lb configure -width 30 -height 20}
  scrollbar .fs.list.sb -command ".fs.list.lb yview"
  frame .fs.file
  label .fs.file.l -text $fileprompt -anchor e
  entry .fs.file.e -text $file
  
  if {"x$types" != "x" && "x$typevariable" != "x"} {
    frame .fs.type
    label .fs.type.l -text $typeprompt -anchor e
    j:option .fs.type.o -list $types
    pack .fs.type.l -side left -pady 10 -padx 10
    pack .fs.type.o -side left -expand yes -pady 10 -padx 10 -fill x
  }

  frame .fs.b -width 200
  button .fs.b.ok -width 8 -text [j:ldb OK] -command {
    set file [.fs.file.e get]
    if {[file isdirectory ./$file]} {
      cd $file			;# cd into directory, refresh list
      .fs.cwd configure -text [pwd]
      j:fs:fill_list .fs.list.lb
      .fs.file.e delete 0 end	;# clear filename space
    } else {
      set cwd [pwd]
      if {$cwd == "/"} {set cwd ""}
      set file [.fs.file.e get]
      case $file in {
        /*	{set j_fs(result) $file}
        default {set j_fs(result) $cwd/$file}
      }
      if [winfo exists .fs.type.o] {
        set j_fs(type) [.fs.type.o get]
      }
      
      destroy .fs
      update
    }
  }
  button .fs.b.gointo -width 8 -text [j:ldb fs:gointo "Go Into"] -command {
    set file [.fs.file.e get]
    if {!([string match /* $file] || [string match ~* $file])} {
      set file ./$file
    }
    if {[file isdirectory $file]} {
      cd $file			;# cd into directory, refresh list
      .fs.cwd configure -text [pwd]
      j:fs:fill_list .fs.list.lb
      .fs.file.e delete 0 end	;# clear filename space
    } else {
      j:alert -text "\"$file\" is not a directory."
    }
  }
  button .fs.b.home -width 8 -text [j:ldb fs:home {Home}] -command {
    cd $env(HOME)
    .fs.cwd configure -text [pwd]
    j:fs:fill_list .fs.list.lb
  }
  button .fs.b.root -width 8 -text [j:ldb fs:root {Root}] -command {
    cd /
    .fs.cwd configure -text [pwd]
    j:fs:fill_list .fs.list.lb
  }
  button .fs.b.here -width 8 -text [j:ldb fs:here {Here}] -command {
    set j_fs(result) [pwd]
    
    # need for following is probably pretty rare:
    if [winfo exists .fs.type.o] {
      set j_fs(type) [.fs.type.o get]
    }
    
    destroy .fs
    update
  }
  button .fs.b.cancel -width 8 -text [j:ldb Cancel] -command "
    set j_fs(result) $cancelvalue
    destroy .fs
    update
  "
  checkbutton .fs.b.fast -text [j:ldb fs:fast {Fast}] \
    -variable J_PREFS(j_fs_fast)

  pack .fs.list.sb -side $J_PREFS(scrollbarside) -fill y
  pack .fs.list.lb -side left -expand yes -fill both
  
  pack .fs.file.l -side left -pady 10 -padx 10
  pack .fs.file.e -side left -expand yes -pady 10 -padx 10 -fill x
  pack [j:filler .fs.file] -side left
  
  # now create the buttons the caller requested:
  #    (NEEDS ERROR CHECKING!)
  pack .fs.b.fast -side top
  foreach b $buttons {
    set button .fs.b.$b
    set border .fs.b.border_$b
    frame $border -borderwidth 1 -relief flat
    raise $button
    pack $button -in $border -padx 2 -pady 2
    pack $border -in .fs.b -side bottom -padx 10 -pady 4
  }
  # wider border on default button:
  .fs.b.border_$fs_defaultbutton configure -relief sunken

  pack .fs.prompt -side top -fill both
  pack [j:rule .fs] -side top -fill x
  pack .fs.cwd -side top -fill both
  pack .fs.file -side bottom -expand yes -fill x
  if [winfo exists .fs.type] {
    pack .fs.type -side bottom -expand yes -fill x
    pack [j:rule .fs] -side bottom -fill x
  }
  pack \
    .fs.b \
    -side right -fill y
  pack .fs.list -side top -expand yes -fill both

  j:dialogue .fs		;# position in centre of screen

  .fs.file.e insert end $j_fs(result)

  focus .fs.file.e
  bind .fs.file.e <Key-Return> {
    set file [.fs.file.e get]
    if {!([string match /* $file] || [string match ~* $file])} {
      set file ./$file
    }
    if {$file != {} && [file isdirectory $file]} {
      .fs.b.gointo invoke
    } else {
      .fs.b.$fs_defaultbutton invoke
    }
  }
  j:tk4 {
    bind .fs.file.e <Key-Return> "+\nbreak"
  }
  j:tk3 {
    bind .fs.file.e <Key-Tab> {	;# expand filename on <Tab>
      set f [%W get]
      %W delete 0 end
      %W insert end [j:expand_filename $f]
    }
  }
  j:tk4 {
    bind .fs.file.e <Key-Tab> {	;# expand filename on <Tab>
      set f [%W get]
      %W delete 0 end
      %W insert end [j:expand_filename $f]
      %W xview end
      focus %W			;# work around Tk4 "all" binding
      break
    }
  }
  bind .fs.list.lb <Button-1> {	;# select, and insert filename into entry
    j:tk3 {
      %W select from [%W nearest %y]
    }
    j:tk4 {
      %W selection clear 0 end; %W selection set [%W nearest %y]
    }
    set file [lindex [selection get] 0]
    .fs.file.e delete 0 end
    .fs.file.e insert end $file
  }

  bind .fs.list.lb <Double-Button-1> {	;# cd to dir or do default thing
    set file [lindex [j:selection_if_any] 0]
    if [file isdirectory ./$file] {
      .fs.b.gointo invoke
    } else {
      .fs.b.$fs_defaultbutton invoke
    }
  }
  j:tk4 {
    bind .fs.list.lb <Double-Button-1> "+\nbreak\n"
  }
  
  j:cancel_button .fs.b.cancel .fs.file.e

#  grab .fs			;# for some reason this screws up 
				;#   "bind .fs.list.lb <Double-Button-1> ..."

  j:fs:fill_list .fs.list.lb	;# fill the listbox for the first time
  tkwait window .fs
  cd $old_cwd			;# leave application in original dir.
  j:tk3 {focus $old_focus}
  j:tk4 {focus -force $old_focus}	;# can't figure out a better way...
  
  if {"x$types" != "x" && "x$typevariable" != "x"} {
    global OPTION_FOR_.fs.option.o
    uplevel 1 [list set $typevariable $j_fs(type)]
  }
  
  return $j_fs(result)
}

######################################################################
# j:fs:fill_list lb - fill the listbox with files from CWD
######################################################################

proc j:fs:fill_list {lb} {
  global J_PREFS
  set J_PREFS(0) 1
  $lb delete 0 end

  # add ".." to go up a level:
  $lb insert end ".."

  update

  # add all normal (non-dot) files:
  foreach i [lsort [glob -nocomplain *]] {
    if { ! $J_PREFS(j_fs_fast) } {
      if {[file isdirectory ./$i]} {
        $lb insert end "$i/"
      } else {
        $lb insert end $i
      }
    } else {
      $lb insert end $i
    }
  }

  # add any dot-files:
  foreach i [lsort [glob -nocomplain .*]] {
    if {$i != "." && $i != ".."} {
      if { ! $J_PREFS(j_fs_fast) } {
        if {[file isdirectory ./$i]} {
          $lb insert end "$i/"
        } else {
          $lb insert end $i
        }
      } else {
        $lb insert end $i
      }
    }
  }
}












