# jfs.tcl - file-selection panel
#
###############################################################################
#  Copyright 1992-2001 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.                                              #
###############################################################################

package provide aq 0.1

# following has side-effect of making sure ::aq namespace is defined
namespace eval ::aq {
  namespace export {[a-z]*}
  catch {
    package require jldb
    # following likely to fail, because done by other libraries too
    namespace import ::jldb::shortcuts::*
  }
}

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

######################################################################
# Localisation defaults:
#
::jldb::set_defaults {
  {title:jfs {File Selector}}
  {fs:choose_a_file {Choose a file}}
  {fs:fileprompt {File:}}
  {fs:typeprompt {File type:}}
  {fs:dirprompt {Directory name:}}
  {title:newdir {Create Directory}}
  {fs:gointo {Go Into}}
  {fs:home {Home}}
  {fs:root {Root}}
  {fs:here {Here}}
  {fs:mkdir {New Dir}}
  {fs:fast {Fast}}
}

######################################################################
# file selector box
######################################################################
### this proc is too monolithic; it should be broken up.

proc ::aq::fs { args } {
  ::aq::parse_args {
    {buttons {ok cancel mkdir home} }
    {prompt {Choose a file}}
    {directory "."}
    {cancelvalue ""}
    {fileprompt {File:}}
    {title {File Selector}}
    {types ""}
    {typevariable ""}
    {typeprompt {File type:}}
    {filehistory fs_files}
    {dirhistory fs_dirs}
  }
  
  set doing_filehistory [string length $filehistory]
  set doing_dirhistory [string length $dirhistory]
  
  global j_fs env J_PREFS aq_library
  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
  wm withdraw .fs			;# avoid flashing during size calc'ns

  label .fs.prompt -anchor w -text $prompt
  label .fs.cwd -text [pwd]
  frame .fs.list
  listbox .fs.list.lb -yscroll ".fs.list.sb set"
  .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
  
  frame .fs.file.f			;# holds entry and any history buttons
  entry .fs.file.e -text $file
  
  pack .fs.file.e -in .fs.file.f -side left -expand yes -fill x
  if $doing_filehistory {
    update idletasks
    set h [winfo reqheight .fs.file.f]
    set ht [.fs.file.e cget -highlightthickness]
    set h [expr {$h - ( $ht * 2 ) - 6}]	;# um, derived empirically. :-) ######
    button .fs.file.down -width $h -height $h -padx 0 -pady 0 \
      -bitmap @$aq_library/bitmaps/down.xbm -command "
      .fs.file.e delete 0 end
      .fs.file.e insert end \[::aq::history_down $filehistory\]
      .fs.file.e xview end
    "
    button .fs.file.up -width $h -height $h -padx 0 -pady 0 \
      -bitmap @$aq_library/bitmaps/up.xbm -command "
      .fs.file.e delete 0 end
      .fs.file.e insert end \[::aq::history_up $filehistory\]
      .fs.file.e xview end
    "
    pack .fs.file.down .fs.file.up -in .fs.file.f -side left
    
    ::aq::history_begin $filehistory
    
    bind .fs.file.e <Up> "
      %W delete 0 end
      %W insert end \[::aq::history_up $filehistory\]
      %W xview end
      catch {break}
    "
    bind .fs.file.e <Down> "
      %W delete 0 end
      %W insert end \[::aq::history_down $filehistory\]
      %W xview end
      catch {break}
    "
  }
  
  if {[string length $types] && [string length $typevariable]} {
    frame .fs.type
    label .fs.type.l -text $typeprompt -anchor e
#    set j_fs(type) [lindex $types 0]
    ::aq::option_button .fs.type.o \
      -list $types \
      -variable j_fs(type)
    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 [::jldb::short_text OK] -command {
    set file [.fs.file.e get]
    if [string length $file] {
      if {[string length $file] && [file isdirectory ./$file]} {
        cd $file			;# cd into directory, refresh list
        .fs.cwd configure -text [pwd]
        ::aq::_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}
        }
        destroy .fs
        update
      }
    } else {
      # if the entry is empty, return null string, but don't prepend
      # [cwd], so calling procedure can distinguish clicking "ok" from
      # clicking "here".  this will often be the same as clicking 
      # "cancel".
      
      set j_fs(result) ""
      destroy .fs
      update
    }
  }
  button .fs.b.gointo -width 8 \
    -text [::jldb::short_text 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]
      ::aq::_fs_fill_list .fs.list.lb
      .fs.file.e delete 0 end	;# clear filename space
    } else {
      ::aq::alert -text \
        [subst -nocommands -nobackslashes {"$file" is not a directory.}]
    }
  }
  button .fs.b.home -width 8 -text [::jldb::short_text fs:home] -command {
    cd $env(HOME)
    .fs.cwd configure -text [pwd]
    ::aq::_fs_fill_list .fs.list.lb
  }
  button .fs.b.root -width 8 -text [::jldb::short_text fs:root] -command {
    cd /
    .fs.cwd configure -text [pwd]
    ::aq::_fs_fill_list .fs.list.lb
  }
  button .fs.b.here -width 8 -text [::jldb::short_text fs:here] -command {
    set j_fs(result) [pwd]
    destroy .fs
    update
  }
  button .fs.b.mkdir -width 8 -text [::jldb::short_text fs:mkdir] -command {
    set dirname \
      [::aq::prompt -file 1 \
      -text [::jldb::short_text fs:dirprompt] \
      -title [::jldb::short_text title:newdir]]
    if {![string match "" $dirname]} {
      exec mkdir $dirname
      cd $dirname			;# cd into directory, refresh list
      .fs.cwd configure -text [pwd]
      ::aq::_fs_fill_list .fs.list.lb
      .fs.file.e delete 0 end		;# clear filename space
    }
  }
  button .fs.b.cancel -width 8 -text [::jldb::short_text Cancel] -command "
    set j_fs(result) $cancelvalue
    destroy .fs
    update
  "
  checkbutton .fs.b.fast -text [::jldb::short_text fs: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.f -side left -expand yes -pady 10 -padx 10 -fill x
  pack [::aq::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 [::aq::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 [::aq::rule .fs] -side bottom -fill x
  }
  pack \
    .fs.b \
    -side right -fill y
  pack .fs.list -side top -expand yes -fill both

  ::aq::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
    }
    break
  }
  bind .fs.file.e <Key-Tab> {	;# expand filename on <Tab>
    set f [%W get]
    %W delete 0 end
    %W insert end [::aq::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
    %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 [::aq::selection_if_any] 0]
    if [file isdirectory ./$file] {
      .fs.b.gointo invoke
    } else {
      .fs.b.$fs_defaultbutton invoke
    }
    break
  }
  
  ::aq::cancel_button .fs.b.cancel .fs.file.e

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

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

######################################################################
# ::aq::_fs_fill_list lb - fill the listbox with files from CWD
######################################################################

proc ::aq::_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
      }
    }
  }
}
