### Copyright (C) 1995-1997 Jesper K. Pedersen
### This program is free software; you can redistribute it and/or modify
### it under the terms of the GNU General Public License as published by
### the Free Software Foundation; either version 2 of the License, or
### (at your option) any later version.
###
### This program is distributed in the hope that it will be useful,
### but WITHOUT ANY WARRANTY; without even the implied warranty of
### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
### GNU General Public License for more details.
###
### You should have received a copy of the GNU General Public License
### along with this program; if not, write to the Free Software
### Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

######################################################################
### This is a file browser, it have the following options:
### -dir <dir>            offset for directory
### -file <file>          default file
### -pattern <pattern>    pattern for files
### -showHiden [<value>]  Shall hidden files be shown
### -exist [<value>]      Shall the selected file exists
###
### it returns a list with the following values:
### file pattern showHidden
######################################################################
proc FileBrowser {args} {
  parseOpt {showHidden exist} {dir file pattern} $args
  if {$options(pattern) == ""} {
    set options(pattern) *
  }
  set result [browser $options(dir) $options(file) $options(pattern) \
                  [tkTrue $options(showHidden)] [tkTrue $options(exist)]\
                  1 0]
  return [lrange $result 1 3]
}

######################################################################
### This is a directory browser, it have the following options:
### -dir <dir>            offset for directory
### -showHiden [<value>]  Shall hidden files be shown
### -exist [<value>]      Shall the selected file exists
###
### it returns a list with the following values:
### dir showHidden
######################################################################
proc DirBrowser {args} {
  parseOpt {showHidden exist} {dir} $args
  set result [browser $options(dir) "" "" \
                  [tkTrue $options(showHidden)] [tkTrue $options(exist)]\
                  0 1]
  return [list [lindex $result 0] [lindex $result 3]]
}

######################################################################
### This is a file/dir browser, it have the following options:
### -dir <dir>            offset for directory
### -file <file>          default file
### -pattern <pattern>    pattern for files
### -showHiden [<value>]  Shall hidden files be shown
### -exist [<value>]      Shall the selected file exists
###
### it returns a list with the following values:
### dir file pattern showHidden
######################################################################
proc FileDirBrowser {args} {
  parseOpt {showHidden exist} {dir file pattern} $args
  if {$options(pattern) == ""} {
    set options(pattern) *
  }
  return [browser $options(dir) $options(file) $options(pattern) \
                  [tkTrue $options(showHidden)] [tkTrue $options(exist)]\
                  1 1]
}

######################################################################
### The next three functions offers an entry packed with a
### directory/file browser.
###
### To include the widget in a frame, window or extentry, include
### the element called frame_$name, while you refer to the
### element with a name as the name for the Browser.
### Example:
### File-Dir-Browser test -text Testing
### ExtEntry abc -entries frame_test
### forevery abc {print -->$test}
###
### NOTE: You may need to create a widget like this yourself if
###       you need Tk options, as this sort of mega widget doesn't
###       give you the possibility to refer to individual elements.
######################################################################

proc File-Browser {name args} {
  global argv __language
  parseOpt {showHidden exist} {text default dir pattern} $args
  if {$options(dir) == "" && $options(dircmd) == ""} {
    error "A -dir option is needed for File-Browser" \
      "otherwise I don't know where to get the file from!"
  }

  Entry $name -text [join $options(text)] -packEntry:expand 1 \
      -packEntry:fill x -packFrame:expand 1 -packFrame:fill x \
      -default $options(default)

  Command com_$name \
      -setvalue "
         set $name \[lindex \$com_$name 0\]
         \$widget configure -bitmap \
             @[lindex $argv 0]/bitmaps/folder_center.xbm"\
      -invoke "
         \$widget configure -bitmap @[lindex $argv 0]/bitmaps/act_folder.xbm
         FileBrowser -dir $options(dir) \
                     -file \$$name \
                     -showHidden $options(showHidden) \
                     -exist $options(exist)" \
      -inactive "\$widget configure -bitmap \
             @[lindex $argv 0]/bitmaps/folder_center.xbm"\
      -packFrame:expand 0 -packFrame:fill none \
      -default [list $options(default) $options(pattern) $options(showHidden)]

  Frame frame_$name -entries $name com_$name -packFrame:expand 1 \
      -packFrame:fill x


  Change "
    if {\$changeElm == \"$name\"} {
      set com_$name \$$name
    }
  "
}

proc Dir-Browser {name args} {
  global argv
  parseOpt {showHidden exist} {text default} $args
  Entry $name -text [join $options(text)] -packEntry:expand 1 \
      -packEntry:fill x -packFrame:expand 1 -packFrame:fill x \
      -default $options(default)

  Command com_$name \
      -setvalue "
         set $name \[lindex \$com_$name 0\]
         \$widget configure -bitmap \
             @[lindex $argv 0]/bitmaps/folder_center.xbm"\
      -invoke "
         \$widget configure -bitmap @[lindex $argv 0]/bitmaps/act_folder.xbm
         if {\$$name == {}} {set $name / }
         DirBrowser -dir \$$name \
                    -showHidden $options(showHidden) \
                    -exist $options(exist)" \
      -inactive "\$widget configure -bitmap \
             @[lindex $argv 0]/bitmaps/folder_center.xbm"\
      -packFrame:expand 0 -packFrame:fill none \
      -default [list $options(default) $options(showHidden)]

  Frame frame_$name -entries $name com_$name -packFrame:expand 1 \
      -packFrame:fill x

  Change "
    if {\$changeElm == \"$name\"} {
      set com_$name \$$name
    }
  "
      
}

proc File-Dir-Browser {name args} {
  global argv
  parseOpt {showHidden exist} {text default} $args

  Entry $name -text [join $options(text)] -packEntry:expand 1 \
      -packEntry:fill x -packFrame:expand 1 -packFrame:fill x \
      -default $options(default)

  Command com_$name \
      -setvalue "
         set $name \[lindex \$com_$name 0\]\[lindex \$com_$name 1\]
         \$widget configure -bitmap \
             @[lindex $argv 0]/bitmaps/folder_center.xbm"\
      -invoke "
         \$widget configure -bitmap @[lindex $argv 0]/bitmaps/act_folder.xbm
         if {\$$name == {}} {set $name /}
         FileDirBrowser -dir \[file dirname \$$name\]/ \
                        -file \[file tail \$$name\] \
                        -showHidden $options(showHidden) \
                        -exist $options(exist)" \
      -inactive "\$widget configure -bitmap \
             @[lindex $argv 0]/bitmaps/folder_center.xbm"\
      -packFrame:expand 0 -packFrame:fill none \
      -default [file dirname $options(default)]/ [file tail $options(default)]

  Frame frame_$name -entries $name com_$name -packFrame:expand 1 \
      -packFrame:fill x

  Change "
    if {\$changeElm == \"$name\"} {
      set com_$name \$$name
    }
  "
}



######################################################################
### This is the command, which create a browser
### This one should not be used from the dotfile script, instead one
### of the three above should be used.
######################################################################
proc browser {dir file filePattern showHidden exists showFile showDir} {
  global __browser __language

  set dirOrig $dir
  if {[string index $dir [expr [string length $dir]-1]] != "/" &&
      $showFile} {
    append dir "/"
  }

  ### packing the browser
  packBroswer $showDir $showFile

  ### does the directory exists
  if {[catch "file isdirectory $dir"] || ![file isdirectory $dir] ||
      ![file readable $dir]} {
    set dir /
  }
  ### setting the internal variables
  set __browser(filePattern) $filePattern
  set __browser(showHidden) $showHidden
  set __browser(showDir) $showDir
  set __browser(showFile) $showFile
  set __browser(dir) $dir
  set __browser(dirEntry) $dir
  set __browser(exists) $exists

  if {$file != ""} {
    set __browser(file) $file
  } else {
    set __browser(file) $filePattern
  }
  ### insert elements into the browser
  if {$showDir} {
    if {$showFile} {
      insertDirectories $dir $showHidden
    } else {
      regsub {(~)} $dir [myGlob ~] dir
      set dirList [split $dir "/"]
      if {[lindex $dirList end] == ""} {
        insertDirectories $dir $showHidden
      } else {
        insertDirectories \
            [join [lrange $dirList 0 [expr [llength $dirList]-2]] "/"]/ \
            $showHidden
        set __browser(dir) \
            "[join [lrange $dirList 0 [expr [llength $dirList]-2]] "/"]/"
      }
    }
  }
  if {$showFile} {
    insertFiles $dir $filePattern $file $showHidden
  }

  ### setup destroy handler
  wm protocol .browse WM_DELETE_WINDOW {
    set __browser(exit) cancel
    destroy .browse
  }
  update
  pushGrab local .browse

  ### wait for the window to disapear
  tkwait window .browse
  popGrab

  ### return the values
  if {$__browser(exit) == "ok"} {
    if {$showFile == 0} {
      set last [expr [string length $__browser(dirEntry)] -1]
      if {[string index $__browser(dirEntry) $last] == "/" } {
        set __browser(dirEntry) \
            [string range $__browser(dirEntry) 0 [expr $last-1]]}
    }
    return [list $__browser(dirEntry) $__browser(file) $__browser(filePattern) \
                $__browser(showHidden)]
  } else {
    if {$dirOrig == "."} {set dirOrig ""}
    return [list $dirOrig $file $filePattern $showHidden]
  }
}

######################################################################
### This function takes care of packing the browser
######################################################################
proc packBroswer {showDir showFiles} {
  global __language
  set w [toplevel .browse]

  ### The outer frames
  if {$showDir} {
    frame $w.dirs
    pack $w.dirs -side left -fill both -expand 1 -padx 2
  }
  if {$showFiles} {
    frame $w.files
    pack $w.files -side left -fill both -expand 1 -padx 2
  }
  frame $w.buts
  pack $w.buts -side left -fill y -expand 0 -pady 5


  ### files and dirs
  foreach prefix {files dirs} {
    if {$prefix == "dirs" && !$showDir} continue
    if {$prefix == "files" && !$showFiles} continue
    set path $w.$prefix
    label $path.label -anchor w
    entry $path.entry
    bind $path.entry <Return> "browser_select $path.box $prefix"
    if {$prefix == "files"} {
      $path.label configure -text $__language(browser,1)
      $path.entry configure -textvariable __browser(file)
    } else {
      $path.label configure -text $__language(browser,2)
      $path.entry configure -textvariable __browser(dirEntry)
    }
    listbox $path.box  -yscrollcommand "$path.scroll set" -width 0 \
         -exportselection 0
    scrollbar $path.scroll -command "$path.box yview"
    pack $path.label -fill x -expand 0 -padx 5
    pack $path.entry -fill x -expand 0
    pack $path.box -fill both -expand 1 -side left
    pack $path.scroll -fill y -expand 1
    ### creating the bindings
    if {$prefix == "files"} {
      bind $path.box <1> {
        if {[.browse.files.box curselection] != ""} {
          set __browser(file) [lindex $__browser(files) \
                                   [.browse.files.box curselection]]
        }
      }
     bind $path.box <Double-1> browse_ok

    } else {
      if {$showFiles} {
        bind $path.box <1> "$path.box selection clear 0 end"
        bind $path.box <Double-1> "browse_changeDir $path.box %x %y"
      } else {
        bind $path.box <1> {
          if {[.browse.dirs.box curselection] != ""} {
            set __browser(dirEntry) $__browser(dir)[lindex $__browser(dirs) \
                                    [.browse.dirs.box curselection]]
          }
        }
        bind $path.box <Double-1> "browse_changeDir $path.box %x %y"
      }
    }
    bindtags $path.box "Listbox $path.box"
  }

  ### buttons
  set buts $w.buts

  # OK
  button $buts.ok -text $__language(ok) -command browse_ok

  # Cancel
  button $buts.cancel -text $__language(cancel) -command {
    set __browser(exit) cancel
    destroy .browse
  }
  checkbutton $buts.showHidden -text $__language(browser,5) \
      -variable __browser(showHidden) -justify left \
      -command browse_checkboxSelcted
  pack $buts.ok $buts.cancel $buts.showHidden -anchor w -pady 2 -fill x
}

######################################################################
### This function insert directories into the directory listbox
######################################################################
proc insertDirectories {dir hidden} {
  global __browser __language
  set w .browse.dirs.box
  $w delete 0 end

  if {$dir != "/"} {
    $w insert end ".."
    set __browser(dirs) ".."
  } else {
     set __browser(dirs) ""
  }

  if {![file readable $dir]} {
    tk_dialog .warning $__language(warning) $__language(browser,7) info 0 $__language(ok)
    return
  }

  set files [lsort [myGlob -nocomplain $dir*]]
  
  ### are hidden files are to be show?
  if {$hidden} {
    set files [concat $files [lsort [myGlob -nocomplain $dir.*]]]
    set res [lremove $files "[myGlob -nocomplain $dir]."]
    if {$res != "__error__"} {
      set files $res
    }
    set res [lremove $files "[myGlob -nocomplain $dir].."]
    if {$res != "__error__"} {
      set files $res
    }
  }
    
  ### run through all the files, and insert the directories.
  foreach file $files {
    if {[file isdirectory $file]} {
      $w insert end [file tail $file]
      lappend __browser(dirs) [file tail $file]
    }
  }
}

######################################################################
### This functoin insert files into the fileListbox.
######################################################################
proc insertFiles {dir filePattern activeFile hidden} {
  global __browser __language
  set w .browse.files.box
  $w delete 0 end
  if {![file readable $dir]} {

    return
  }
  set files [lsort [myGlob -nocomplain $dir$filePattern]]
  if {$hidden} {
    set files [concat $files [lsort [myGlob -nocomplain $dir.$filePattern]]]
  }
  set __browser(files) ""
  foreach file $files {
    if {[file isfile $file]} {
      $w insert end [file tail $file]
      if {[file tail $file] == $activeFile} {
        $w selection set end
      }
      lappend __browser(files) [file tail $file]
    }
  }
}

######################################################################
### This function is called when the user press the enter key
### in one of the entries.
######################################################################
proc browser_select {path prefix} {
  global __browser __language
  if {$prefix == "files"} {
    if {[regexp {\*|\?} $__browser(file)]} {
      ### a pattern were inserted.
      set __browser(filePattern) $__browser(file)
      insertFiles $__browser(dir) $__browser(filePattern) \
          "" $__browser(showHidden)
    } else {
      ### The user has typed a name he want's to accept
      browse_ok
      return
    }
  } else {
    ### directories
    if {[string index $__browser(dirEntry) \
             [expr [string length $__browser(dirEntry)]-1]] != "/"} {
      append __browser(dirEntry) "/"
    }
    if {[catch "file isdirectory $__browser(dirEntry)"] ||
         ![file isdirectory $__browser(dirEntry)]} {
      ### Directory does not exist.
      $path delete 0 end
      if {$__browser(showFile)} {
        .browse.files.box delete 0 end
      }
      set __browser(dirs) ""
      set __browser(files) ""
      tk_dialog .dialog $__language(error) $__language(browser,10) error 0 $__language(ok)
    } else {
      ### The directory exists.
      set __browser(dir) $__browser(dirEntry)
      insertDirectories $__browser(dir) $__browser(showHidden)
      if {$__browser(showFile)} {
        insertFiles $__browser(dir) $__browser(filePattern) "" $__browser(showHidden)
      }
    }
  }
}


######################################################################
### This function is called, when the user press the mouse over a
### directory to change to it.
######################################################################
proc browse_changeDir {path x y} {
  global __browser __language
  set value [$path get [$path index @$x,$y]]

  ### The user selected ".."
  if {$value == ".."} {
    if {[regexp {~[^/]*/$} $__browser(dir)]} {
      set dir "/home/"
    } else {
      set dirList [split $__browser(dir) "/"]
      set dir [join [lrange $dirList 0 [expr [llength $dirList]-3]] "/"]/
    }
  } else {
    set dir $__browser(dir)$value/
  }
  set __browser(dir) $dir
  set __browser(dirEntry) $dir
  insertDirectories $dir $__browser(showHidden)
  if {$__browser(showFile)} {
    insertFiles $dir $__browser(filePattern) "" $__browser(showHidden)
  }
}

######################################################################
### This function is called, when the state of the checkbox
### is changed.
######################################################################
proc browse_checkboxSelcted {} {
  global __browser __language

  if {$__browser(showDir)} {
    insertDirectories $__browser(dir) $__browser(showHidden)
  }
  if {$__browser(showFile)} {
    insertFiles $__browser(dir) $__browser(filePattern) "" \
        $__browser(showHidden)
  }
}

proc browse_ok {} {
  global __browser __language

  ### test that the filename is valid.
  if {$__browser(showFile)} {
    if {[regexp {\*|\\|\?|\{|\}} $__browser(file)] || $__browser(file) == ""} {
      tk_dialog .error $__language(error) [langExp "%s" $__browser(file) $__language(browser,13)] error 0 $__language(ok)
      return
    }
    if {$__browser(exists) && ![file exists $__browser(dir)$__browser(file)]} {
      tk_dialog .error $__langauge(error) [langExp "%s" $__browser(file) $__language(browser,14)] \
          error 0 $__language(ok)
      return
    }
  } else {
    if {[regexp {\*|\\|\?|\{|\}} $__browser(dirEntry)] ||
        $__browser(dirEntry) == ""} {
      tk_dialog .error $__langauge(error) [langExp %s $__browser(file) $__language(browser,15)]\
          error 0 OK
      return
    }
    if {$__browser(exists) && ![file exists $__browser(dirEntry)]} {
      tk_dialog .error $__langauge(error) \
        [langExp "%s" $__browser(dirEntry) $__language(browser,16)]   error 0 $__language(ok)
      return
    }
  }
  set __browser(exit) ok
  destroy .browse
}