summaryrefslogtreecommitdiff
path: root/tix/library/DirList.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'tix/library/DirList.tcl')
-rw-r--r--tix/library/DirList.tcl286
1 files changed, 286 insertions, 0 deletions
diff --git a/tix/library/DirList.tcl b/tix/library/DirList.tcl
new file mode 100644
index 00000000000..2d96f4d15a3
--- /dev/null
+++ b/tix/library/DirList.tcl
@@ -0,0 +1,286 @@
+# DirList.tcl --
+#
+# Implements the tixDirList widget.
+#
+# - overrides the -browsecmd and -command options of the
+# HList subwidget
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixDirList {
+ -classname TixDirList
+ -superclass tixScrolledHList
+ -method {
+ chdir
+ }
+ -flag {
+ -browsecmd -command -dircmd -disablecallback
+ -root -rootname -showhidden -value
+ }
+ -configspec {
+ {-browsecmd browseCmd BrowseCmd ""}
+ {-command command Command ""}
+ {-dircmd dirCmd DirCmd ""}
+ {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
+ {-root root Root ""}
+ {-rootname rootName RootName ""}
+ {-showhidden showHidden ShowHidden 0 tixVerifyBoolean}
+ {-value value Value ""}
+ }
+ -default {
+ {.scrollbar auto}
+ {*borderWidth 1}
+ {*hlist.background #c3c3c3}
+ {*hlist.indent 7}
+ {*hlist.relief sunken}
+ {*hlist.height 10}
+ {*hlist.width 20}
+ {*hlist.padX 2}
+ {*hlist.padY 0}
+ {*hlist.wideSelection 0}
+ {*hlist.drawBranch 0}
+ {*hlist.highlightBackground #d9d9d9}
+ {*hlist.itemType imagetext}
+ {*hlist.takeFocus 1}
+ }
+ -forcecall {
+ -value
+ }
+}
+
+# Important data members:
+#
+# data(vpath)
+# The currently selected vpath. This internal variable is useful on
+# the Win95 platform, where an directory may correspond to more than
+# one node in the hierarchy. For example, C:\Windows\Desktop\Foo
+# can appead as "Desktop\Foo" and
+# "Desktop\My Computer\C:\Windows\Desktop\Foo". This variable tells us
+# which icon should we show given the same DOS pathname.
+#
+
+proc tixDirList:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+}
+
+proc tixDirList:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ $data(w:hlist) config \
+ -separator [tixFSSep] \
+ -selectmode "single"
+
+ # We must creat an extra copy of these images to avoid flashes on
+ # the screen when user changes directory
+ #
+# set data(images) [image create compound -window $data(w:hlist)]
+# $data(images) add image -image [tix getimage act_fold]
+# $data(images) add image -image [tix getimage folder]
+# $data(images) add image -image [tix getimage openfold]
+}
+
+proc tixDirList:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ $data(w:hlist) config \
+ -browsecmd "tixDirList:Browse $w" \
+ -command "tixDirList:Command $w"
+
+ if [tixStrEq $data(-value) ""] {
+ set data(-value) [tixFSPWD]
+ }
+ if [catch {
+ set data(vpath) [tixFSVPath [tixFSNormDir $data(-value)]]
+ }] {
+ set data(vpath) [tixFSVPath [tixFSNormDir [tixFSPWD]]]
+ }
+}
+
+#----------------------------------------------------------------------
+# Incoming-Events
+#----------------------------------------------------------------------
+proc tixDirList:Browse {w args} {
+ upvar #0 $w data
+
+ uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
+ set vpath [tixEvent flag V]
+ set value [$data(w:hlist) info data $vpath]
+
+ tixDirList:HighLight $w $vpath
+
+ set data(vpath) $vpath
+ set data(-value) $value
+
+ tixDirList:CallBrowseCmd $w $data(-value)
+}
+
+proc tixDirList:Command {w args} {
+ upvar #0 $w data
+
+ set vpath [tixEvent value]
+ set value [$data(w:hlist) info data $vpath]
+ set data(-value) $value
+
+ tixDirList:LoadDir $w [tixFSNormDir $value] $vpath
+ tixDirList:HighLight $w $vpath
+
+ set data(vpath) $vpath
+ tixDirList:CallCommand $w $data(-value)
+}
+
+#----------------------------------------------------------------------
+# Outgoing-Events
+#----------------------------------------------------------------------
+
+proc tixDirList:CallBrowseCmd {w value} {
+ upvar #0 $w data
+
+ if {$data(-browsecmd) != ""} {
+ set bind(specs) "%V"
+ set bind(%V) $value
+ tixEvalCmdBinding $w $data(-browsecmd) bind $value
+ }
+}
+
+proc tixDirList:CallCommand {w value} {
+ upvar #0 $w data
+
+ if {$data(-command) != "" && !$data(-disablecallback)} {
+ set bind(specs) "%V"
+ set bind(%V) $value
+ tixEvalCmdBinding $w $data(-command) bind $value
+ }
+}
+
+#----------------------------------------------------------------------
+# Directory loading
+#----------------------------------------------------------------------
+proc tixDirList:LoadDir {w {npath ""} {vpath ""}} {
+ upvar #0 $w data
+
+ tixBusy $w on $data(w:hlist)
+
+ $data(w:hlist) delete all
+
+ if {![string compare $npath ""]} {
+ set npath [tixFSNormDir $data(-value)]
+ set vpath [tixFSVPath $npath]
+ }
+
+ tixDirList:ListHierachy $w $npath $vpath
+ tixDirList:ListSubDirs $w $npath $vpath
+
+ tixWidgetDoWhenIdle tixBusy $w off $data(w:hlist)
+}
+
+proc tixDirList:ListHierachy {w dir vpath} {
+ upvar #0 $w data
+ uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
+
+ foreach p [tixFSSplit $vpath] {
+ set vpath [lindex $p 0]
+ set text [lindex $p 1]
+ set path [lindex $p 2]
+
+ $data(w:hlist) add $vpath -text $text -data $path \
+ -image [tix getimage openfold]
+ }
+}
+
+proc tixDirList:ListSubDirs {w dir vpath} {
+ upvar #0 $w data
+ uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
+
+ $data(w:hlist) entryconfig $vpath \
+ -image [tix getimage act_fold]
+
+ foreach ent [tixFSListDir $vpath 1 0 0 $data(-showhidden)] {
+ set vp [lindex $ent 0]
+ set name [lindex $ent 1]
+ set path [lindex $ent 2]
+
+ $data(w:hlist) add $vp -text $name -data $path \
+ -image [tix getimage folder]
+ }
+}
+
+proc tixDirList:SetValue {w npath vpath {flag ""}} {
+ upvar #0 $w data
+
+ if {![string compare $flag reload] ||
+ ![$data(w:hlist) info exists $vpath]} {
+ tixDirList:LoadDir $w $npath $vpath
+ }
+
+ tixDirList:HighLight $w $vpath
+
+ set data(-value) [tixFSDisplayName $npath]
+ set data(vpath) $vpath
+ tixDirList:CallCommand $w $data(-value)
+}
+
+proc tixDirList:HighLight {w vpath} {
+ upvar #0 $w data
+
+ if {![tixStrEq $data(vpath) $vpath]} {
+ set old $data(vpath)
+
+ if [$data(w:hlist) info exists $old] {
+ # Un-highlight the originally selected entry by changing its
+ # folder image
+
+ if {[$data(w:hlist) info children $old] == ""} {
+ $data(w:hlist) entryconfig $old\
+ -image [tix getimage folder]
+ } else {
+ $data(w:hlist) entryconfig $old\
+ -image [tix getimage openfold]
+ }
+ }
+ }
+
+ # Highlight the newly selected entry
+ #
+ $data(w:hlist) entryconfig $vpath \
+ -image [tix getimage act_fold]
+ $data(w:hlist) anchor set $vpath
+ $data(w:hlist) select clear
+ $data(w:hlist) select set $vpath
+ $data(w:hlist) see $vpath
+}
+
+#----------------------------------------------------------------------
+# Config options
+#----------------------------------------------------------------------
+proc tixDirList:config-value {w value} {
+ upvar #0 $w data
+
+ tixDirList:chdir $w $value
+ return $data(-value)
+}
+
+proc tixDirList:config-showhidden {w value} {
+ upvar #0 $w data
+
+ tixWidgetDoWhenIdle tixDirList:LoadDir $w
+}
+
+#----------------------------------------------------------------------
+# Public methods
+#----------------------------------------------------------------------
+proc tixDirList:chdir {w value} {
+ upvar #0 $w data
+
+ set path [tixFSNormDir $value]
+ tixDirList:SetValue $w $path [tixFSVPath $path]
+}
View Lorry Controller Status