--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/python-2.5.2/win32/tcl/tix8.4/FileBox.tcl Fri Apr 03 17:19:34 2009 +0100
@@ -0,0 +1,568 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+# $Id: FileBox.tcl,v 1.5 2004/03/28 02:44:57 hobbs Exp $
+#
+# FileBox.tcl --
+#
+# Implements the File Selection Box widget.
+#
+# Copyright (c) 1993-1999 Ioi Kim Lam.
+# Copyright (c) 2000-2001 Tix Project Group.
+# Copyright (c) 2004 ActiveState
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+# ToDo
+# (1) If user has entered an invalid directory, give an error dialog
+#
+
+tixWidgetClass tixFileSelectBox {
+ -superclass tixPrimitive
+ -classname TixFileSelectBox
+ -method {
+ filter invoke
+ }
+ -flag {
+ -browsecmd -command -dir -directory -disablecallback
+ -grab -pattern -selection -value
+ }
+ -configspec {
+ {-browsecmd browseCmd BrowseCmd ""}
+ {-command command Command ""}
+ {-directory directory Directory ""}
+ {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
+ {-grab grab Grab global}
+ {-pattern pattern Pattern *}
+ {-value value Value ""}
+ }
+ -alias {
+ {-selection -value}
+ {-dir -directory}
+ }
+ -forcecall {
+ -value
+ }
+ -default {
+ {.relief raised}
+ {*filelist*Listbox.takeFocus true}
+ {.borderWidth 1}
+ {*Label.anchor w}
+ {*Label.borderWidth 0}
+ {*TixComboBox*scrollbar auto}
+ {*TixComboBox*Label.anchor w}
+ {*TixScrolledListBox.scrollbar auto}
+ {*Listbox.exportSelection false}
+ {*directory*Label.text "Directories:"}
+ {*directory*Label.underline 0}
+ {*file*Label.text "Files:"}
+ {*file*Label.underline 2}
+ {*filter.label "Filter:"}
+ {*filter*label.underline 3}
+ {*filter.labelSide top}
+ {*selection.label "Selection:"}
+ {*selection*label.underline 0}
+ {*selection.labelSide top}
+ }
+}
+
+
+proc tixFileSelectBox:InitWidgetRec {w} {
+ upvar #0 $w data
+ global env
+
+ tixChainMethod $w InitWidgetRec
+
+ if {$data(-directory) eq ""} {
+ set data(-directory) [pwd]
+ }
+ if {$data(-pattern) eq ""} {
+ set data(-pattern) "*"
+ }
+
+ tixFileSelectBox:SetPat $w $data(-pattern)
+ tixFileSelectBox:SetDir $w [tixFSNormalize $data(-directory)]
+
+ set data(flag) 0
+ set data(fakeDir) 0
+}
+
+#----------------------------------------------------------------------
+# Construct widget
+#----------------------------------------------------------------------
+proc tixFileSelectBox:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ set frame1 [tixFileSelectBox:CreateFrame1 $w]
+ set frame2 [tixFileSelectBox:CreateFrame2 $w]
+ set frame3 [tixFileSelectBox:CreateFrame3 $w]
+
+ pack $frame1 -in $w -side top -fill x
+ pack $frame3 -in $w -side bottom -fill x
+ pack $frame2 -in $w -side top -fill both -expand yes
+}
+
+proc tixFileSelectBox:CreateFrame1 {w} {
+ upvar #0 $w data
+
+ frame $w.f1 -border 10
+ tixComboBox $w.f1.filter -editable 1\
+ -command [list $w filter] -anchor e \
+ -options {
+ slistbox.scrollbar auto
+ listbox.height 5
+ label.anchor w
+ }
+ set data(w:filter) $w.f1.filter
+
+ pack $data(w:filter) -side top -expand yes -fill both
+ return $w.f1
+}
+
+proc tixFileSelectBox:CreateFrame2 {w} {
+ upvar #0 $w data
+
+ tixPanedWindow $w.f2 -orientation horizontal
+ # THE LEFT FRAME
+ #-----------------------
+ set dir [$w.f2 add directory -size 120]
+ $dir config -relief flat
+ label $dir.lab
+ set data(w:dirlist) [tixScrolledListBox $dir.dirlist\
+ -scrollbar auto\
+ -options {listbox.width 4 listbox.height 6}]
+
+ pack $dir.lab -side top -fill x -padx 10
+ pack $data(w:dirlist) -side bottom -expand yes -fill both -padx 10
+
+ # THE RIGHT FRAME
+ #-----------------------
+ set file [$w.f2 add file -size 160]
+ $file config -relief flat
+ label $file.lab
+ set data(w:filelist) [tixScrolledListBox $file.filelist \
+ -scrollbar auto\
+ -options {listbox.width 4 listbox.height 6}]
+
+ pack $file.lab -side top -fill x -padx 10
+ pack $data(w:filelist) -side bottom -expand yes -fill both -padx 10
+
+ return $w.f2
+}
+
+proc tixFileSelectBox:CreateFrame3 {w} {
+ upvar #0 $w data
+
+ frame $w.f3 -border 10
+ tixComboBox $w.f3.selection -editable 1\
+ -command [list tixFileSelectBox:SelInvoke $w] \
+ -anchor e \
+ -options {
+ slistbox.scrollbar auto
+ listbox.height 5
+ label.anchor w
+ }
+
+ set data(w:selection) $w.f3.selection
+
+ pack $data(w:selection) -side top -fill both
+
+ return $w.f3
+}
+
+proc tixFileSelectBox:SelInvoke {w args} {
+ upvar #0 $w data
+
+ set event [tixEvent type]
+
+ if {$event ne "<FocusOut>" && $event ne "<Tab>"} {
+ $w invoke
+ }
+}
+
+proc tixFileSelectBox:SetValue {w value} {
+ upvar #0 $w data
+
+ set data(i-value) $value
+ set data(-value) [tixFSNative $value]
+}
+
+proc tixFileSelectBox:SetDir {w value} {
+ upvar #0 $w data
+
+ set data(i-directory) $value
+ set data(-directory) [tixFSNative $value]
+}
+
+proc tixFileSelectBox:SetPat {w value} {
+ upvar #0 $w data
+
+ set data(i-pattern) $value
+ set data(-pattern) [tixFSNative $value]
+}
+
+
+#----------------------------------------------------------------------
+# BINDINGS
+#----------------------------------------------------------------------
+
+proc tixFileSelectBox:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ tixDoWhenMapped $w [list tixFileSelectBox:FirstMapped $w]
+
+ $data(w:dirlist) config \
+ -browsecmd [list tixFileSelectBox:SelectDir $w] \
+ -command [list tixFileSelectBox:InvokeDir $w]
+
+ $data(w:filelist) config \
+ -browsecmd [list tixFileSelectBox:SelectFile $w] \
+ -command [list tixFileSelectBox:InvokeFile $w]
+}
+
+#----------------------------------------------------------------------
+# CONFIG OPTIONS
+#----------------------------------------------------------------------
+proc tixFileSelectBox:config-directory {w value} {
+ upvar #0 $w data
+
+ if {$value eq ""} {
+ set value [pwd]
+ }
+ tixFileSelectBox:SetDir $w [tixFSNormalize $value]
+ tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
+ $w filter
+
+ return $data(-directory)
+}
+
+proc tixFileSelectBox:config-pattern {w value} {
+ upvar #0 $w data
+
+ if {$value eq ""} {
+ set value "*"
+ }
+
+ tixFileSelectBox:SetPat $w $value
+ tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
+
+ # Returning a value means we have overridden the value and updated
+ # the widget record ourselves.
+ #
+ return $data(-pattern)
+}
+
+proc tixFileSelectBox:config-value {w value} {
+ upvar #0 $w data
+
+ tixFileSelectBox:SetValue $w [tixFSNormalize $value]
+ tixSetSilent $data(w:selection) $value
+
+ return $data(-value)
+}
+
+#----------------------------------------------------------------------
+# PUBLIC METHODS
+#----------------------------------------------------------------------
+proc tixFileSelectBox:filter {w args} {
+ upvar #0 $w data
+
+ $data(w:filter) popdown
+ tixFileSelectBox:InterpFilter $w
+ tixFileSelectBox:LoadDir $w
+}
+
+proc tixFileSelectBox:invoke {w args} {
+ upvar #0 $w data
+
+ if {[$data(w:selection) cget -value] ne
+ [$data(w:selection) cget -selection]} {
+ # this will in turn call "invoke" again ...
+ #
+ $data(w:selection) invoke
+ return
+ }
+
+ # record the filter
+ #
+ set filter [tixFileSelectBox:InterpFilter $w]
+ $data(w:filter) addhistory $filter
+
+ # record the selection
+ #
+ set userInput [string trim [$data(w:selection) cget -value]]
+ tixFileSelectBox:SetValue $w \
+ [tixFSNormalize [file join $data(i-directory) $userInput]]
+ $data(w:selection) addhistory $data(-value)
+
+ $data(w:filter) align
+ $data(w:selection) align
+
+ if {[llength $data(-command)] && !$data(-disablecallback)} {
+ set bind(specs) "%V"
+ set bind(%V) $data(-value)
+ tixEvalCmdBinding $w $data(-command) bind $data(-value)
+ }
+}
+
+#----------------------------------------------------------------------
+# INTERNAL METHODS
+#----------------------------------------------------------------------
+# InterpFilter:
+# Interprets the value of the w:filter widget.
+#
+# Side effects:
+# Changes the fields data(-directory) and data(-pattenn)
+#
+proc tixFileSelectBox:InterpFilter {w {filter ""}} {
+ upvar #0 $w data
+
+ if {$filter == ""} {
+ set filter [$data(w:filter) cget -selection]
+ if {$filter == ""} {
+ set filter [$data(w:filter) cget -value]
+ }
+ }
+
+ set i_filter [tixFSNormalize $filter]
+
+ if {[file isdirectory $filter]} {
+ tixFileSelectBox:SetDir $w $i_filter
+ tixFileSelectBox:SetPat $w "*"
+ } else {
+ set nDir [file dirname $filter]
+ if {$nDir eq "" || $nDir eq "."} {
+ tixFileSelectBox:SetDir $w [tixFSNormalize $data(i-directory)]
+ } else {
+ tixFileSelectBox:SetDir $w [tixFSNormalize $nDir]
+ }
+ tixFileSelectBox:SetPat $w [file tail $filter]
+ }
+
+ tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
+
+ return $data(filter)
+}
+
+proc tixFileSelectBox:SetFilter {w dir pattern} {
+ upvar #0 $w data
+
+ set data(filter) [file join $dir $pattern]
+ tixSetSilent $data(w:filter) $data(filter)
+}
+
+proc tixFileSelectBox:LoadDirIntoLists {w} {
+ upvar #0 $w data
+
+ $data(w:dirlist) subwidget listbox delete 0 end
+ $data(w:filelist) subwidget listbox delete 0 end
+
+ set dir $data(i-directory)
+
+ # (1) List the directories
+ #
+ set isDrive [expr {[llength [file split $dir]] == 1}]
+ foreach name [tixFSListDir $dir 1 0 1 1] {
+ if {".." eq $name && $isDrive} { continue }
+ $data(w:dirlist) subwidget listbox insert end $name
+ }
+
+ # (2) List the files
+ #
+ # %% UNIX'ISM:
+ # If the pattern is "*" force glob to list the .* files.
+ # However, since the user might not
+ # be interested in them, shift the listbox so that the "normal" files
+ # are seen first
+ #
+ # NOTE: if we pass $pat == "" but with $showHidden set to true,
+ # tixFSListDir will list "* .*" in Unix. See the comment on top of
+ # the tixFSListDir code.
+ #
+ if {$data(i-pattern) eq "*"} {
+ set pat ""
+ } else {
+ set pat $data(i-pattern)
+ }
+
+ set top 0
+ foreach name [tixFSListDir $dir 0 1 0 0 $pat] {
+ $data(w:filelist) subwidget listbox insert end $name
+ if {[string match .* $name]} {
+ incr top
+ }
+ }
+
+ $data(w:filelist) subwidget listbox yview $top
+}
+
+proc tixFileSelectBox:LoadDir {w} {
+ upvar #0 $w data
+
+ tixBusy $w on [$data(w:dirlist) subwidget listbox]
+
+ tixFileSelectBox:LoadDirIntoLists $w
+
+ if {[$data(w:dirlist) subwidget listbox size] == 0} {
+ # fail safe, just in case the user has inputed an errnoeuos
+ # directory
+ $data(w:dirlist) subwidget listbox insert 0 ".."
+ }
+
+ tixWidgetDoWhenIdle tixBusy $w off [$data(w:dirlist) subwidget listbox]
+}
+
+# User single clicks on the directory listbox
+#
+proc tixFileSelectBox:SelectDir {w} {
+ upvar #0 $w data
+
+ if {$data(fakeDir) > 0} {
+ incr data(fakeDir) -1
+ $data(w:dirlist) subwidget listbox select clear 0 end
+ $data(w:dirlist) subwidget listbox activate -1
+ return
+ }
+
+ if {$data(flag)} {
+ return
+ }
+ set data(flag) 1
+
+ set subdir [tixListboxGetCurrent [$data(w:dirlist) subwidget listbox]]
+ if {$subdir == ""} {
+ set subdir "."
+ }
+
+ tixFileSelectBox:SetFilter $w \
+ [tixFSNormalize [file join $data(i-directory) $subdir]] \
+ $data(i-pattern)
+ set data(flag) 0
+}
+
+proc tixFileSelectBox:InvokeDir {w} {
+ upvar #0 $w data
+
+ set theDir [$data(w:dirlist) subwidget listbox get active]
+
+ tixFileSelectBox:SetDir $w \
+ [tixFSNormalize [file join $data(i-directory) $theDir]]
+
+ $data(w:dirlist) subwidget listbox select clear 0 end
+
+ tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
+ tixFileSelectBox:InterpFilter $w [tixFSNativeNorm $data(filter)]
+
+ tixFileSelectBox:LoadDir $w
+
+ if {![tixEvent match <Return>]} {
+ incr data(fakeDir) 1
+ }
+}
+
+proc tixFileSelectBox:SelectFile {w} {
+ upvar #0 $w data
+
+ if {$data(flag)} {
+ return
+ }
+ set data(flag) 1
+
+ # Reset the "Filter:" box to the current directory:
+ #
+ $data(w:dirlist) subwidget listbox select clear 0 end
+ tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
+
+ # Now select the file
+ #
+ set selected [tixListboxGetCurrent [$data(w:filelist) subwidget listbox]]
+ if {$selected != ""} {
+ # Make sure that the selection is not empty!
+ #
+ tixFileSelectBox:SetValue $w \
+ [tixFSNormalize [file join $data(i-directory) $selected]]
+ tixSetSilent $data(w:selection) $data(-value)
+
+ if {[llength $data(-browsecmd)]} {
+ tixEvalCmdBinding $w $data(-browsecmd) "" $data(-value)
+ }
+ }
+ set data(flag) 0
+}
+
+proc tixFileSelectBox:InvokeFile {w} {
+ upvar #0 $w data
+
+ set selected [tixListboxGetCurrent [$data(w:filelist) subwidget listbox]]
+ if {$selected != ""} {
+ $w invoke
+ }
+}
+
+# This is only called the first this fileBox is mapped -- load the directory
+#
+proc tixFileSelectBox:FirstMapped {w} {
+ if {![winfo exists $w]} {
+ return
+ }
+
+ upvar #0 $w data
+
+ tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
+ tixFileSelectBox:LoadDir $w
+ $data(w:filter) align
+}
+
+
+#----------------------------------------------------------------------
+#
+#
+# C O N V E N I E N C E R O U T I N E S
+#
+#
+#----------------------------------------------------------------------
+
+# This is obsolete. Use the widget tixFileSelectDialog instead
+#
+#
+proc tixMkFileDialog {w args} {
+ set option(-okcmd) ""
+ set option(-helpcmd) ""
+
+ tixHandleOptions option {-okcmd -helpcmd} $args
+
+ toplevel $w
+ wm minsize $w 10 10
+
+ tixStdDlgBtns $w.btns
+
+ if {$option(-okcmd) != ""} {
+ tixFileSelectBox $w.fsb \
+ -command "[list wm withdraw $w]; $option(-okcmd)"
+ } else {
+ tixFileSelectBox $w.fsb -command [list wm withdraw $w]
+ }
+
+ $w.btns button ok config -command [list $w.fsb invoke]
+ $w.btns button apply config -command [list $w.fsb filter] -text Filter
+ $w.btns button cancel config -command [list wm withdraw $w]
+
+ if {$option(-helpcmd) == ""} {
+ $w.btns button help config -state disabled
+ } else {
+ $w.btns button help config -command $option(-helpcmd)
+ }
+ wm protocol $w WM_DELETE_WINDOW [list wm withdraw $w]
+ pack $w.btns -side bottom -fill both
+ pack $w.fsb -fill both -expand yes
+
+ return $w.fsb
+}
+
+