golden hour

/usr/lib64/tcl8.5/Tix8.4.3

File/Folder	Size	Actions
Balloon.tcl	12.97 KB
BtnBox.tcl	2.61 KB
CObjView.tcl	7.56 KB
ChkList.tcl	4.97 KB
ComboBox.tcl	35.42 KB
Compat.tcl	870 B
Console.tcl	14.95 KB
Control.tcl	12.11 KB
DefSchm.tcl	2.94 KB
DialogS.tcl	4.2 KB
DirBox.tcl	5.3 KB
DirDlg.tcl	2.15 KB
DirList.tcl	6.9 KB
DirTree.tcl	8.76 KB
DragDrop.tcl	3.93 KB
DtlList.tcl	1002 B
EFileBox.tcl	11.12 KB
EFileDlg.tcl	1.68 KB
Event.tcl	5.11 KB
FileBox.tcl	14 KB
FileCbx.tcl	2.42 KB
FileDlg.tcl	2.13 KB
FileEnt.tcl	7.15 KB
FloatEnt.tcl	3.1 KB
Grid.tcl	21.16 KB
HList.tcl	17.72 KB
HListDD.tcl	4.39 KB
IconView.tcl	5.97 KB
Init.tcl	6.05 KB
LabEntry.tcl	2.09 KB
LabFrame.tcl	1.15 KB
LabWidg.tcl	3.86 KB
ListNBk.tcl	3.5 KB
Meter.tcl	3.04 KB
MultView.tcl	3.62 KB
NoteBook.tcl	6.02 KB
OldUtil.tcl	2.98 KB
OptMenu.tcl	9.17 KB
PanedWin.tcl	27.68 KB
PopMenu.tcl	5.37 KB
Primitiv.tcl	10.28 KB
README.txt	987 B
ResizeH.tcl	12.94 KB
SGrid.tcl	5.8 KB
SHList.tcl	3.7 KB
SListBox.tcl	6.97 KB
STList.tcl	2.37 KB
SText.tcl	3.09 KB
SWidget.tcl	9.52 KB
SWindow.tcl	6.75 KB
Select.tcl	7.04 KB
Shell.tcl	1.06 KB
SimpDlg.tcl	1.13 KB
StackWin.tcl	1.95 KB
StatBar.tcl	1.31 KB
StdBBox.tcl	1.62 KB
StdShell.tcl	1.15 KB
TList.tcl	17.59 KB
Tix.tcl	9.51 KB
Tree.tcl	4.57 KB
Utils.tcl	10.54 KB
VResize.tcl	4.95 KB
VStack.tcl	9.42 KB
VTree.tcl	4.31 KB
Variable.tcl	2.5 KB
WInfo.tcl	965 B
bitmaps	-
fs.tcl	3.9 KB
html	-
libTix.so	320.71 KB
license.terms	2.76 KB
pkgIndex.tcl	122 B
pref	-

Edit: FileBox.tcl

# -*- 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
}