
#@package: fileselect fileselect

package require Tk

#
# Copyright (C) 1992-1997 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  NeoSoft makes no 
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.

#
# $Id: filereq.tcl,v 1.1.1.1 1999/03/31 20:34:39 damon Exp $
#

# Originally from Mario J. Silva
#From: msilva@mercenary.CS.Berkeley.EDU (Mario J. Silva)
#Date: 16 Jan 93 15:12:01
#Distribution: world
#Message-ID: <MSILVA.93Jan16151201@mercenary.CS.Berkeley.EDU>
#References: <1j97ddINN43q@urmel.informatik.rwth-aachen.de>
#In-reply-to: kuku@acds.physik.rwth-aachen.de's message of 16 Jan 1993 14:51:25 GMT
#
#This one mimicks Framemaker's file selector.
#Never tried it with tk3.0, but I believe changes will be minimal, if
#any. As this is pre-tk3.0, there are no grabs. That should now be
#easy. Just add a couple of Tcl/Tk lines at the right place.

#Mario Jorge Silva			          msilva@cs.Berkeley.EDU
#University of California Berkeley                 Ph:    +1(510)642-8248
#Computer Science Division, 571 Evans Hall         Fax:   +1(510)642-5775
#Berkeley CA 94720                                 

#
#
#  file:                  +----+
#  ____________________   | OK |
#                         +----+
#
#  +------------------+    Cancel
#  | ..               |S
#  | file1            |c
#  | file2            |r
#  |                  |b
#  | filen            |a
#  |                  |r
#  +------------------+
#  currrent-directory

# use the option command for further configuration


proc fileselect.default.cmd {w f} {
  puts stderr "selected file $f"
  destroy $w
}

proc fileselect {
  {cmd fileselect.default.cmd} {purpose "file:"} {w .file_select} } {

  catch {destroy $w}

    global FS_cmd FS_w
    set FS_cmd $cmd
    set FS_w $w

    toplevel $w
    wm title $w "Select File"


    # path independent names for the widgets
    global entry FS_list ok cancel dirlabel

    set entry $w.file.eframe.entry
    set FS_list $w.file.sframe.list
    set scroll $w.file.sframe.scroll
    set ok $w.bframe.okframe.ok
    set cancel $w.bframe.cancel
    set dirlabel $w.file.dirlabel

    # widgets
    frame $w.file -bd 10 
    frame $w.bframe -bd 10
    pack $w.file -side left -fill y
    pack $w.bframe -side left -expand yes -anchor n

    frame $w.file.eframe
    frame $w.file.sframe
    label $w.file.dirlabel -width 24 -anchor e -text [exec pwd] 

    pack $w.file.eframe -side top -anchor w
    pack $w.file.sframe -side top -anchor w
    pack $w.file.dirlabel -side top -anchor w


    label $w.file.eframe.label -text "$purpose"
    entry $w.file.eframe.entry -relief sunken 

    pack $w.file.eframe.label -side top -expand yes -anchor w
    pack $w.file.eframe.entry -side top -fill x -anchor w


    scrollbar $w.file.sframe.yscroll -relief sunken \
	 -command "$w.file.sframe.list yview"

    listbox $w.file.sframe.list -relief sunken \
        -geometry "25x10" \
	-yscroll "$w.file.sframe.yscroll set" 

    pack $w.file.sframe.yscroll -side right -fill y
    pack $w.file.sframe.list -side left

    # buttons
    frame $w.bframe.okframe -borderwidth 2 -relief sunken
 
    button $w.bframe.okframe.ok -text OK -relief raised -padx 10 \
        -command "ok.cmd;"

    button $w.bframe.cancel -text cancel -relief raised -padx 10 \
        -command "cancel.cmd; destroy $w"
    pack $w.bframe.okframe.ok -padx 10 -pady 10

    pack $w.bframe.okframe -expand yes -padx 20 -pady 20
    pack $w.bframe.cancel -side top

    # Fill the listbox with a list of all the files in the directory (run
    # the "ls" command to get that information).
 
    foreach i [exec ls -a [exec pwd]] {
        if {[string compare $i "."] != 0} {
            $FS_list insert end $i
        }
    }

   # Set up bindings for the browser.
    bind $entry <Return> {eval $ok invoke}
    bind $entry <Control-c> {eval $cancel invoke}

    bind $w <Control-c> {eval $cancel invoke}
    bind $w <Return> {eval $ok invoke}


   bind $FS_list <Button-1> {
        # puts stderr "button 1"
        %W select from [%W nearest %y]
        %W select to [%W nearest %y]
	eval $entry delete 0 end
	eval $entry insert 0 [%W get [%W nearest %y]]
    }

    bind $FS_list <Key> {
        %W select from [%W nearest %y]
        %W select to [%W nearest %y]
        eval $entry delete 0 end
	eval $entry insert 0 [%W get [%W nearest %y]]
    }

    bind $FS_list <B1-Motion> " "

    bind $FS_list <Double-Button-1> {
        # puts stderr "double button 1"
	eval $ok invoke
    }

    bind $FS_list <Return> {
        %W select from [%W nearest %y]
        %W select to [%W nearest %y]
	eval $entry delete 0 end
	eval $entry insert 0 [%W get [%W nearest %y]]
	eval $ok invoke
    }

    # button procedures

    proc cancel.cmd {} {
	puts stderr "Cancel"
    }

    proc ok.cmd {} {

        global entry dirlabel FS_list 
        set selected [$entry get]

        if {[file isdirectory $selected] != 0} {
            cd $selected
            set dir [exec pwd]
	    eval $dirlabel configure -text $dir
            $FS_list delete 0 end
	    foreach i [exec ls -a $dir] {
	        if {[string compare $i "."] != 0} {
	            eval $FS_list insert end $i
	        }
	    }
	    return
	}

        global FS_cmd FS_w
	eval $FS_cmd $FS_w $selected
    }
}

