browse.tcl

好东西,欢迎下在,联系方式E-mail:[e-mail]

# browsedir.tcl - a program to display the directory structure for
#		  the Unix Setup program 
#
# history
# -------
# 01b,05jul96,tcy change fonts and increase border width
# 01a,28jun96,tcy modified from the File Selection Dialog example  

proc fileselectResources {} {
    # path is used to enter the file name
    option add *Fileselect*path.relief          sunken  startup
    option add *Fileselect*path.background      white   startup
    option add *Fileselect*path.foreground      black   startup
    # Text for the label on pathname entry
    option add *Fileselect*l.text               Path:   startup
    # Text for the OK and Cancel buttons
    option add *Fileselect*ok*text              OK      startup
    option add *Fileselect*cancel.text          Cancel  startup
    # Size of the listbox
    option add *Fileselect*list.width           20      startup
    option add *Fileselect*list.height          10      startup
}

# fileselect returns the selected pathname, or windDir
proc fileselect {windDir} {
        global fileselect
        global env
        global ctrlVals
 
        # save the initial directory
        set fileselect(windDir) $windDir

        set t [toplevel .fileselect -bd 15 -class Fileselect]
        wm title $t "Choose Directory"
        grab $t
        fileselectResources
    
        set msg "Please choose the directory for installation." 
        message $t.msg -aspect 1000 -text $msg\
                -font $ctrlVals(textFont) 
        pack $t.msg -side top -fill x
    
        # Create an entry for the pathname
        # The value is kept in fileselect(path)
        frame $t.top
        label $t.top.l -padx 10 -pady 20  -font $ctrlVals(textFont)
        set e [entry $t.top.path -font $ctrlVals(textFont)\
                -textvariable fileselect(path)]
        pack $t.top -side top -fill x
        pack $t.top.l -side left
        pack $t.top.path -side right -fill x -expand true

        # Create a listbox to hold the directory contents
        set lb [listbox $t.list -font $ctrlVals(textFont)\
                -yscrollcommand [list $t.scroll set]]
        scrollbar $t.scroll -command [list $lb yview]

        # Create the OK and Cancel buttons
        # The OK button has a rim to indicate it is the default
        frame $t.buttons -bd 10
        frame $t.buttons.ok -bd 2 -relief sunken
        set ok [button $t.buttons.ok.b  -font $ctrlVals(bldFont)\
                -command fileselectOK]
        set can [button $t.buttons.cancel  -font $ctrlVals(bldFont)\
                -command fileselectCancel]

        # Pack the list, scrollbar, and button box
        # in a horizontal stack below the upper widgets
        pack $t.list -side left -fill both -expand true
        pack $t.scroll -side left -fill y
        pack $t.buttons -side left -fill both
        pack $t.buttons.ok $t.buttons.cancel \
                -side top -padx 10 -pady 5
        pack $t.buttons.ok.b -padx 4 -pady 4

        fileselectBindings $t $e $lb $ok $can

        # Initialize variables and list the directory
        if {$windDir == ""} {
	    set dir "/usr" 
        } else {
            if {[file isdirectory $windDir]} {
               set dir $windDir
            } else {
               set dir "/usr"  
            } 
        } 

        if {![file isdirectory $dir]} {
	    set dir "$env(HOME)"
        }

        # this is last resort
        if {![file isdirectory $dir]} {
	    set dir [pwd]
        }

        set fileselect(path) $windDir
        set fileselect(dir) {}
        set fileselect(done) 0

        # Wait for the listbox to be visible so
        # we can provide feedback during the listing 
        tkwait visibility .fileselect.list
	# dir should be a valid directory -- windDir or home directory 
        fileselectList $dir

        tkwait variable fileselect(done)
	grab release $t
        destroy $t
        return $fileselect(path)

}
proc fileselectBindings { t e lb ok can } {
        # t - toplevel
        # e - name entry
        # lb - listbox
        # ok - OK button
        # can - Cancel button

        # Elimate the all binding tag because we
        # do our own focus management
        foreach w [list $e $lb $ok $can] {
            bindtags $w [list $t [winfo class $w] $w]
        }
        # Dialog-global cancel binding
        bind $t <Control-c> fileselectCancel

        # Entry bindings
        bind $e <Return> absPathUpdate

        # A single click appends the name to the existing path, and 
        #  puts the complete path in the entry
        # A double-click, or <Return>, selects the name
        bind $lb <Button-1> "focus $lb" 
        bind $lb <Return> "fileselectTake %W; pathUpdate; $lb select set 0"
        bind $lb <Double-Button-1>  "fileselectClick %W %y; pathUpdate; \
				     $lb select set 0" 

        # Focus management    
        bind $e <Tab> "focus $lb ; $lb select set 0"
        bind $lb <Tab> "focus $ok"

        bind $ok <Tab> "focus $can"
        bind $can <Tab> "focus $e"

        # Set up for ok button 
        focus $ok
}

proc fileselectList { dir {files {}} } {
        global fileselect

        # Update the directory display
        set e .fileselect.top.path
        $e config -state normal
        $e delete 0 end
        $e insert 0 $dir
        # scroll to view the tail end
        $e xview moveto 1

        .fileselect.list delete 0 end
        set fileselect(dir) $dir
        if ![file isdirectory $dir] {
            .fileselect.list insert 0 "Bad Directory"
            return
        }

        .fileselect.list insert 0 Listing...
        update idletasks
        .fileselect.list delete 0
        if {[string length $files] == 0} {

                # List the directory and add an
                # entry for the parent directory

                set files [glob -nocomplain $fileselect(dir)/*]
		
                if {$fileselect(dir) != "/"} {                     
                    .fileselect.list insert end ../
		}
        }
        # Sort the directories to the front
        set dirs {}
        
        foreach f [lsort $files] {
                if { [file isdirectory $f] && [file executable $f] } {
                    .fileselect.list insert end [file tail $f]
                        lappend dirs [file tail $f]/
                }
        }
}

proc fileselectOK {} {
        global fileselect

        set fileselect(done) 1
#        set fileselect(path) {}
}

proc absPathUpdate {} {
        global fileselect

        # Handle the parent directory specially
        if {[regsub {^\.\./?} $fileselect(path) {} newpath] != 0} {
                set fileselect(path) $newpath
                set fileselect(dir) [file dirname $fileselect(dir)]
                absPathUpdate
                return
        }

        if [file isdirectory $fileselect(path)] {
                fileselectList $fileselect(path)
                return
        }
}

proc pathUpdate {} {
        global fileselect

        # Handle the parent directory specially
        if {[regsub {^\.\./?} $fileselect(path) {} newpath] != 0} {
                set fileselect(path) $newpath
                set fileselect(dir) [file dirname $fileselect(dir)]
                pathUpdate
                return
        }

        if {$fileselect(dir) == "/"} {
	    set path "/$fileselect(path)"
	} else {
            set path [string trimright $fileselect(dir)/$fileselect(path) /]
        } 

        if [file isdirectory $path] {
                set fileselect(path) {}
                fileselectList $path
                return
        }
}

proc fileselectCancel {} {
        global fileselect

        set fileselect(path) $fileselect(windDir)
        set fileselect(done) 1
}

proc fileselectClick { lb y } {
        # Take the item the user clicked on
        global fileselect
        set fileselect(path) [$lb get [$lb nearest $y]]
}

proc fileselectTake { lb } {
        # Take the currently selected list item
        global fileselect
        set fileselect(path) [$lb get [$lb curselection]]
}