#          
 # tkgetfile.tcl -- Enhanced file selector using tablelist widget (to provide
 #                   detail view and easy access to sorting and column sizing).
 #                   Intended as a replacement for tk_getOpenFile.
 #
 # Features a detailed view of directories with Name, Size, and Date Modified.
 # The user can click on any column heading to sort that column in ascending or
 # descending order.
 # Input a file name with wildcards (e.g. *.c) to see all files that match.
 # You can use the Tab keys, up-down arrows (depending on focus), Return, etc.
 #
 # Author: Walter B. Wulczak <[email protected]>
 # Date: Oct 10 2005
 #
 # Requires the package "tablelist" ( http://www.nemethi.de )
 # Tested with Tcl/Tk 8.1 and 8.4 under Unix.
 #
 # Usage:
 #        set filename [tkgetfile ?-option value? ]
 #        if {$filename != ""} {
 #        # Open the file and do other stuff ...
 #        }
 #
 # Options are:
 #        [-initialdir dir] Specifies that the files in dir should be
 #                          displayed when the dialog pops up.  Defaults
 #                          to the current working directory.
 #        [-parent window]  Display tkgetfile over parent window.
 #        [-title string]   Make string the label of dialog window.
 # 
 # Layout:
 #
 #  Open File:
 #  +------------------+ +-----+
 #  |                  | +UpDir+
 #  +------------------+ +-----+
 #
 #    Name    Size   Date Modified
 #  +------------------------------------+
 #  | file1     25   2005-01-24 19:11:55 |S
 #  | file2                              |c
 #  | file3                              |r
 #  |                                    |b
 #  |                                    |a
 #  | filen                              |r
 #  +------------------------------------+
 #  Directory Name: currrent-dir
 #
 #        +------+  +--------+
 #        |  OK  |  | cancel |
 #        +------+  +--------+
 #
 ###############################################################
 #
 # Thanks to:
 #   Csaba Nemethi, author of tablelist, for helpful suggestions.
 #
 # 10-04-05 wbw: Replaced listbox with tablelist.  Dir folder image added.
 #                Corrected key and button binding definitions.
 # 10-05-05 wbw: Recoded 3 sections doing the same thing into tkgetfileshowdir.
 #                Updir button added.
 # 10-06-05 wbw: Work around glob quirk.  The following returns no files:
 #                        set selected "*.c *.tcl"
 #                        set globlist [glob $selected]
 #                                or
 #                        set globlist [glob [list $selected]]
 #                This works (returns files matching either pattern):
 #                        set selected "*.c *.tcl"
 #                        set globlist [eval glob $selected]
 # 10-06-05 wbw: Every time tkgetfileshowdir is called, sort the list per the
 #                        last known sorting order.
 # 10-07-05 wbw: File names with spaces now handled (removed "glob" call).
 #                Catch exceptions when user clicks beyond the table.
 # 10-08-05 wbw: Added support for "-initialdir" and "-title".
 # 10-09-05 wbw: Switched from "ls -a" to "glob".  Bindings corrected.
 # 10-10-05 wbw: Cleanup and comment out "puts" debugging statements.
 # 
 #
 #
 #
 #
 # Copyright 2005 Walter B. Wulczak
 # Permission to use, copy, modify, and distribute this
 # software and its documentation for any purpose and without
 # fee is hereby granted, provided that this copyright
 # notice appears in all copies.  Walter B. Wulczak
 # makes no representations about the suitability of this
 # software for any purpose.  It is provided "as is" without
 # express or implied warranty.
 #
 # Based in part on fileselect.tcl by:
 # Mario Jorge Silva                               [email protected]
 # University of California Berkeley
 #
 # Parts Copyright 1993 Regents of the University of California
 # Permission to use, copy, modify, and distribute this
 # software and its documentation for any purpose and without
 # fee is hereby granted, provided that this copyright
 # notice appears in all copies.  The University of California
 # makes no representations about the suitability of this
 # software for any purpose.  It is provided "as is" without
 # express or implied warranty.
 #
 
 package require tablelist
 
 proc tkgetfile {args} {
    global tkgetfile_selected
    set tkgetfile_selected "-Cancelled-"
 
    global tkgetfilemsg
    set tkgetfilemsg(title) "Select File"
    set tkgetfilemsg(parent) ""
 
    #
    # arguments
    #
    set index 0
    set max [llength $args]
    while { $index < $max } {
        switch -exact -- [lindex $args $index] {
            "-initialdir" {
                incr index
                cd [lindex $args $index]
                incr index
            }
            "-parent" {
                incr index
                set tkgetfilemsg(parent) [lindex $args $index]
                incr index
            }
            "-title" {
                incr index
                set tkgetfilemsg(title) [lindex $args $index]
                incr index
            }
            default {
                puts stderr "Unsupported option [lindex $args $index]"
            }
        }
    }
    proc setfilename {f} {
            global tkgetfile_selected    
            set tkgetfile_selected  $f
            # puts stderr "tkgetfile.tcl result is: $f"
    }
 
    tkgetfileINT setfilename "Open File" .openFile
 
    # pick one of these 2 lines; you only need the one you like most here.
    # tkwait variable tkgetfile_selected
    tkwait window .openFile
 
    if { [string compare $tkgetfile_selected "-Cancelled-"] == 0 } then {
       # puts stderr "Selection cancelled"
       return ""
 
    }
    # Return full path name
    if {[regexp "/" $tkgetfile_selected] != 0} { return $tkgetfile_selected}
    return [pwd]/$tkgetfile_selected
 }
 
 # Names starting with "tkgetfile" are reserved by this module
 
 # this is the default proc  called when "OK" is pressed
 # to indicate yours, give it as the first arg to "tkgetfileINT"
 
 proc tkgetfile.default.cmd {f} {
  puts stderr "Selected file $f"
 }
 image create photo b_up -data {
    R0lGODlhFgATAMIAAHt7e9/fX////gAAAK6uSv///////////yH+Dk1hZGUgd2l0aCBHSU1QACH5
    BAEAAAcALAAAAAAWABMAAANVeArcoDBKEKoNT2p6b9ZLJzrkAQhoqq4qMJxi3LnwRcjeK9jDjWM6
    C2FA9Mlou8CQWMQhO4Nf5XmJSqkW6w9bYXqZFq40HBzPymYyac1uDA7fuJyZAAA7
    }
 
 image create photo b_dir -data {
    R0lGODlhEAAQAMIAAHB/cN/fX////gAAAP///////////////yH+Dk1hZGUgd2l0aCBHSU1QACH5
    BAEAAAQALAAAAAAQABAAAAM2SLrc/jA2QKkEIWcAsdZVpQBCaZ4lMBDk525r+34qK8x0fOOwzfcy
    Xi2IG4aOoRVhwGw6nYQEADs=
    }
 
 # this is the proc that creates the file selector box
 
 proc tkgetfileINT {
    {cmd tkgetfile.default.cmd}
    {purpose "Open file:"}
    {w .tkgetfileWindow} } {
    global tkgetfilemsg
 
    catch {destroy $w}
 
    toplevel $w
    grab $w
    # wm title $w "Select File"
    wm title $w $tkgetfilemsg(title)
    if {$tkgetfilemsg(parent) != ""} {
        set par $tkgetfilemsg(parent)
        set xOrgWin [expr [winfo rootx $par] + [winfo width $par] / 2 -200]
        set yOrgWin [expr [winfo rooty $par] + [winfo height $par] / 2 -200]
        wm geometry $w +$xOrgWin+$yOrgWin
        wm transient $w $tkgetfilemsg(parent)
    }
 
    # path independent names for the widgets
    global tkgetfile
 
    set tkgetfile(entry) $w.file.eframe.entry
    set tkgetfile(list) $w.file.sframe.list
    set tkgetfile(scroll) $w.file.sframe.scroll
    set tkgetfile(ok) $w.bframe.okframe.ok
    set tkgetfile(cancel) $w.bframe.cancel
    set tkgetfile(dirlabel) $w.file.dirlabel
 
    # widgets
    frame $w.file -bd 5
    frame $w.bframe -bd 2
    pack append $w \
        $w.file {top expand filly} \
        $w.bframe {top frame n}
        # $w.bframe {left expand frame n}
 
    frame $w.file.eframe
    frame $w.file.sframe
    # label $w.file.dirlabel -anchor w -width 40 -text "Directory Name: [pwd]"
    label $w.file.dirlabel -anchor w -text "Directory Name: [pwd]"
 
    pack append $w.file \
        $w.file.eframe {top frame w} \
        $w.file.sframe {top expand fillx filly} \
        $w.file.dirlabel {top frame w}
 
    label $w.file.eframe.label -anchor w -width 40 -text $purpose
    entry $w.file.eframe.entry -relief sunken -background white
    button $w.file.eframe.up -image b_up -command "tkgetfileshowdir .."
 
    pack append $w.file.eframe \
                $w.file.eframe.label {top expand frame w} \
                $w.file.eframe.up {right frame e} \
                $w.file.eframe.entry {top fillx frame w}
 
    scrollbar $w.file.sframe.yscroll -relief sunken \
         -command "$w.file.sframe.list yview"
    # listbox $w.file.sframe.list -relief sunken \
        # -yscroll "$w.file.sframe.yscroll set" -selectmode single -width 40 \
        # -background white
    tablelist::tablelist $w.file.sframe.list -columns {0 "Name" 0 "Size" right 0 "Date Modified" } \
            -stretch all -background white -width 0 \
            -yscrollcommand [list $w.file.sframe.yscroll set] \
            -stripebackground #f0f0f0 \
            -labelcommand tablelist::sortByColumn \
    -font "-*-helvetica-medium-r-normal-*-12-*-*-*-p-*-iso8859-1" \
            -activestyle frame
    $w.file.sframe.list columnconfigure 1 -name fileSize -sortmode integer
    $w.file.sframe.list columnconfigure 0 -editable 0
    $w.file.sframe.list columnconfigure 1 -editable 0
    $w.file.sframe.list columnconfigure 2 -editable 0
 
    pack append $w.file.sframe \
        $w.file.sframe.yscroll {right filly} \
        $w.file.sframe.list {left expand fill}
 
    # buttons
    # frame $w.bframe.okframe -borderwidth 2 -relief sunken
    frame $w.bframe.okframe -borderwidth 2 -relief flat
 
    button $w.bframe.okframe.ok -text OK -relief raised -padx 20 \
        -command "tkgetfile.ok.cmd $w $cmd"
 
    button $w.bframe.cancel -text cancel -relief raised -padx 10 \
        -command "tkgetfile.cancel.cmd $w"
    pack append $w.bframe.okframe $w.bframe.okframe.ok {padx 1 pady 1}
 
    pack append $w.bframe $w.bframe.okframe {left expand padx 2 pady 2}\
                          $w.bframe.cancel {left}
 
    # Fill the listbox with a list of the files in the directory
    tkgetfileshowdir [pwd]
 
   #---------------------------------------
   # Set up bindings for the browser.
    bind $tkgetfile(entry) <Return> {eval $tkgetfile(ok) invoke}
    bind $tkgetfile(ok) <Return> {eval $tkgetfile(ok) invoke}
    bind $tkgetfile(entry) <Control-c> {eval $tkgetfile(cancel) invoke}
 
    bind $w <Control-c> {eval $tkgetfile(cancel) invoke}
    # 10-05-05 wbw: Don't see a good reason for the next line as it causes
    #                    a doubling up of the <Return> invokation above.
    # bind $w <Return> {eval $tkgetfile(ok) invoke}
 
    # tk_listboxSingleSelect $tkgetfile(list)
 
    set bodyTag [$tkgetfile(list) bodytag]
 
 
    bind $bodyTag <Button-1> {
        # puts stderr "button 1 release"
        foreach {tablelist::W tablelist::x tablelist::y} \
            [tablelist::convEventFields %W %x %y] {}
        set clickcell [$tkgetfile(list) nearest $tablelist::y]
        # puts stderr "Nearest clicked on cell $clickcell"
        # A button click in an invalid area could exceed the tablelist
        if { [$tkgetfile(list) index end] > $clickcell } {
            $tkgetfile(entry) delete 0 end
            # Get the cell at 0,y (beginning cell of the selected line)
            $tkgetfile(entry) insert 0 [$tkgetfile(list) getcells [$tkgetfile(list) nearest $tablelist::y],0]
        }
        focus $tkgetfile(list)
    }
 
    # 10-05-05 wbw: Binding must be KeyRelease as tablelist widget first does
    #                    selection setup via its own Key binding.
    bind $bodyTag <KeyRelease> {
        foreach {tablelist::W tablelist::x tablelist::y} \
            [tablelist::convEventFields %W %x %y] {}
        $tkgetfile(entry) delete 0 end
        set currow [$tkgetfile(list) curselection]
        # puts stderr "currow $currow [$tkgetfile(list) getcells active]"
        $tkgetfile(entry) insert 0 [$tkgetfile(list) getcells active]
    }
 
    bind $bodyTag <Double-ButtonPress-1> {
        # puts stderr "double button 1"
        foreach {tablelist::W tablelist::x tablelist::y} \
            [tablelist::convEventFields %W %x %y] {}
        # set clickcell [$tkgetfile(list) getscells [$tkgetfile(list) containingcell 0 $tablelist::y]]
        set clickcell [$tkgetfile(list) nearest $tablelist::y]
        # puts stderr "Converted double click on cell $clickcell"
        if { [$tkgetfile(list) index end] > $clickcell } {
            $tkgetfile(entry) delete 0 end
            # Get the cell at 0,y (beginning cell of the selected line)
            $tkgetfile(entry) insert 0 [$tkgetfile(list) getcells [$tkgetfile(list) nearest $tablelist::y],0]
            $tkgetfile(ok) invoke
        }
    }
 
    # This binding creates a conflict with tablelist::condEditActiveCell due
    # to the window being destroyed before condEditActiveCell is called!
    if 0 {
        bind $bodyTag <Return> {
            $tkgetfile(entry) delete 0 end
            $tkgetfile(entry) insert 0 [$tkgetfile(list) getcells active]
            $tkgetfile(ok) invoke
        }
    }
 
    # set kbd focus to list widget, not entry widget
    focus $tkgetfile(entry)
    # focus $tkgetfile(list)
 
 }
 
 # auxiliary button procedures
 
 proc tkgetfile.cancel.cmd {w} {
    # puts stderr "Cancel"
    destroy $w
 }
 
 proc tkgetfile.ok.cmd {w cmd} {
    global tkgetfile
    set selected [$tkgetfile(entry) get]
    # puts stderr "The tkgetfile.ok.cmd selection is: $selected"
    if [file isfile "$selected"] {
        # after 5 destroy $w
        destroy $w
        $cmd $selected
        return
    }
 
    if { [string compare $selected "" ] == 0} {
        # puts stderr "tkgetfile.ok.cmd received blank selection"
        return
    }
 
    # selection may be a directory. Expand it.
    if {[file isdirectory "$selected"] != 0} {
        tkgetfileshowdir $selected
        return
    }
 
    # some nasty file names may cause "file isdirectory" to return an error
    set sts [catch {
        file isdirectory $selected
    }  errorMessage ]
 
    if { $sts != 0 } then {
        tk_dialog .oops "STS directory error" "Filename directory test return error: $errorMessage" error 0 OK
        return
 
    }
 
    # perform globbing on the selection.
    # If globing returns an error, return (leaving the file listbox empty)
    # If resulting list length > 1, put the list on the file listbox and return
    # If globing expands to a list of filenames in multiple directories,
    # the indicated regexp is invalid and the error handler is called instead.
 
    set sts [catch {
        set globlist [eval glob $selected]
        # puts stderr "globlist: $globlist"
    } errorMessage ]
 
    if { $sts != 0 } then {
        tk_dialog .oops "STS error" "Error: $errorMessage" error 0 OK
        return
    }
 
    # handle wildcard filenames (e.g. *.txt, *.c, etc.)
    # if {[llength $globlist] > 1}
    if {$globlist != $selected} {
        if {[regexp "/" $globlist] != 0} {
            tk_dialog .oops "regexp error" "Invalid regular expression (don't mix '/' with wildcards): $selected" error 0 OK
            return
        }
        tkgetfileshowdir $selected
        return
    }
 
    if [file isfile "$selected"] {
        destroy $w
        $cmd $selected
    } else {
        tk_dialog .oops "Invalid File Name" "You didn't choose anything" error 0 OK
        return
    }
 
 
 } 
 
 
 proc tkgetfileshowdir {dirpath} {
    # Fill tablelist with a list of the files in the directory (with glob).
    global tkgetfile
    # puts stderr "tkgetfileshowdir $dirpath"
 
    if {[file isdirectory $dirpath] != 0} {
        cd $dirpath
        set dirpath [pwd]
        $tkgetfile(dirlabel) configure -text "Directory Name: $dirpath"
        # puts stderr "Expanding directory $dirpath"
        set dirpath ".* *"
    }
 
    # Clean the text entry and prepare the list
    $tkgetfile(entry) delete 0 end
    $tkgetfile(list) delete 0 end
 
    # set globlist [lsort [eval glob $dirpath]]
    # if {[llength $globlist] <= 1}
    # if {$globlist == $dirpath} {
        # set globlist [ exec /bin/ls -a $dirpath]
    # }
    # set globlist [ exec sh -c "/bin/ls -a $dirpath"]
    # puts stderr $globlist
    # foreach i [exec /bin/ls -a $dirpath]
    # foreach i [split $globlist \n]
    # foreach i [lsort [eval glob [file join $dirpath *]]]
    foreach i [lsort [eval glob -nocomplain $dirpath]] {
        if {[string compare $i "."] != 0 && \
            [string compare $i ".."] != 0 } {
            set fileSize [file size $i]
            set dttm [clock format [file mtime $i] -format "%Y-%m-%d %H:%M:%S" ]
            $tkgetfile(list) insert end [list $i $fileSize $dttm]
            if {[file isdirectory $i] != 0} {
                $tkgetfile(list) cellconfigure end,0 -image b_dir
                }
        }
    }
    # Sort the list per the last user-specified sorting order.
    set sortcol [$tkgetfile(list) sortcolumn]
    if {$sortcol != -1 } {
        $tkgetfile(list) sortbycolumn $sortcol -[$tkgetfile(list) sortorder ]
    }
 }