fsdialog-97fa62c6a4000075500000000000000000000000001363570464600135535ustar00nobodynobodyfsdialog-97fa62c6a4/doc000075500000000000000000000000001363570464600143205ustar00nobodynobodyfsdialog-97fa62c6a4/doc/entrybox.man000064400000000000000000000025321363570464600167500ustar00nobodynobody[comment {-*- tcl -*- doctools manpage}] [vset libname entrybox] [vset cmdname ttk::entrybox] [manpage_begin [vset libname] n 1.0] [copyright {2017 Schelte Bron}] [moddesc {Tk Themed Widget}] [titledesc {editable text field widget with clear controls}] [require Tk 8.6.6] [require matchbox 1.0] [description] The [widget [vset cmdname]] widget is an extension of the regular ttk::entry widget. It can be used wherever a ttk::entry is currently used, without any other changes to the code. [para] The difference between the [widget [vset cmdname]] widget and the ttk::entry widget is in the interaction with the user. An empty [widget [vset cmdname]] looks just like a ttk::entry. However, when there is any text in the [widget [vset cmdname]], an icon appears on the right-hand side of the widget. The user can click this icon to erase the text. [section "Widget command"] A [widget [vset cmdname]] widget supports the same subcommands as a ttk::entry. As a convenience, one additional subcommand is available: [list_begin definitions] [def "[arg pathName] [method set] [arg value]"] Directly set the value of the [widget [vset cmdname]] to [arg value], replacing any existing text. [list_end] [section "Default bindings"] The [widget [vset cmdname]] has one additional key binding, Control-u, that also erases all text in the [widget [vset cmdname]]. [manpage_end] fsdialog-97fa62c6a4/doc/fsdialog.man000064400000000000000000000066251363570464600166750ustar00nobodynobody[comment {-*- tcl -*- doctools manpage}] [vset libname fsdialog] [vset cmdname ttk::fsdialog] [manpage_begin [vset libname] n 1.0] [copyright {2018 Schelte Bron}] [moddesc {File system dialog boxes}] [titledesc {dialog boxes for the user to select a file or directory.}] [require Tk 8.6.6] [require [vset libname] 1.0] [description] The [package [vset libname]] package installs direct replacements for the original [cmd tk_getOpenFile], [cmd tk_getSaveFile], and [cmd tk_chooseDirectory] commands of Tk. The replacements provide more advanced features for user interaction. See the manual pages of the original commands for the details on their usage. [para] To control the advanced features, the package provides some additional commands. [list_begin definitions] [call [cmd [vset cmdname]] [method configfile] [opt [arg name]]] Specify a configuration file for the dialogs to automatically store and retrieve the preference settings and history. By default, the package will use the file ".config/tcltk/fsdialog.cfg", but only if that file exists. Calling this command without the [arg name] argument will create the default configuration file, so it is guaranteed to be used. Specify an empty string for [arg name] to prevent the use of the default configuration file, even if it exists. [call [cmd [vset cmdname]] [method history] [opt "[arg name] [arg ...]"]] Get or seed the list of files and directories that will be presented to the user in various drop-down lists. That list is normally maintained automatically, but this command makes it available for external storage and loading. [call [cmd [vset cmdname]] [method preferences] \ [opt [arg option]] [opt "[arg value] [arg option] [arg value] [arg ...]"]] Configure preference settings. This command is provide for situations where the use of a specific configuration file for the file system dialogs is not desired. For example, when the preferences are going to be stored as part of the overall application configuration. [para] If no [arg name] or [arg value] arguments are supplied, the command returns a list containing alternating option names and values for the channel. If [arg name] is supplied but no [arg value] then the command returns the current value of the given option. If one or more pairs of [arg name] and [arg value] are supplied, the command sets each of the named options to the corresponding [arg value]; in this case the return value is an empty string. [para] The following settings are available: [list_begin definitions] [def "[option details] [arg boolean]"] Show the short (0) or long (1) version of the file list. Default: 0. [def "[option duopane] [arg boolean]"] Combine files and directories in a single pane (0) or show directories in a separate pane (1). Default: 0. [def "[option hidden] [arg boolean]"] Show hidden files and directories. Default: 0. [def "[option mixed] [arg boolean]"] List directories before files (0) or list all entries without making a distinction between files and directories (1). This setting only has effect when files and directories are shown in a single pane. Default: 0. [def "[option reverse] [arg boolean]"] Show the entries in reverse sorting order. Default: 0. [def "[option sort] [arg property]"] Select which property to use for sorting the entries in the file pane. The directory pane is always sorted by name. Possible values are [const name], [const date], and [const size]. Default: name. [list_end] [list_end] [manpage_end] fsdialog-97fa62c6a4/doc/matchbox.man000064400000000000000000000033721363570464600167060ustar00nobodynobody[comment {-*- tcl -*- doctools manpage}] [vset libname matchbox] [vset cmdname ttk::matchbox] [manpage_begin [vset libname] n 1.0] [copyright {2017 Schelte Bron}] [moddesc {Tk Themed Widget}] [titledesc {text field with popdown selection and completion lists}] [require Tk 8.6.3] [require [vset libname] 1.0] [description] The [widget [vset cmdname]] widget is an extension of the regular ttk::combobox widget. It can be used wherever a ttk::combobox is currently used, without any other changes to the code. [para] The difference between the [widget [vset cmdname]] widget and the ttk::combobox widget is in the interaction with the user. An empty [widget [vset cmdname]] looks just like a ttk::combobox. However, when there is any text in the [widget [vset cmdname]], an icon appears on the right-hand side of the text field. The user can click this icon to erase the text. [section "Widget-specific options"] If the [option -matchcommand] option is specified, an additional drop-down list may be displayed showing possible completions for the entered string. [para] Whenever the user changes the value of the [widget [vset cmdname]] widget, the command specified via the [option -matchcommand] option is invoked with one additional argument; the current value of the widget. The command is expected to return a list of possible completions. These will be presented to the user via the second drop-down list of the widget. If the command returns an empty list, the drop-down list will not be displayed. [para] Note: The match command is not invoked when the user selects an entry from the main drop-down list. [section "Default bindings"] The [widget [vset cmdname]] has one additional key binding, Control-u, that also erases all text in the [widget [vset cmdname]]. [manpage_end] fsdialog-97fa62c6a4/fsdialog.tcl000064400000000000000000002145101363570464600161310ustar00nobodynobody# A file selection mega widget # Copyright (C) Schelte Bron. Freely redistributable. # Version 2.0 - 20 Mar 2020 namespace eval ttk::fsdialog { package require Tk 8.6.6- package require matchbox if {[catch {package require fswatch}]} { proc ::fswatch args {} } namespace export tk_getOpenFile tk_getSaveFile tk_chooseDirectory namespace ensemble create -subcommands {preferences configfile} variable config { prefs { details 0 duopane 0 hidden 0 mixed 0 reverse 0 sort name } history {} filedialog { geometry 700x480 sashpos 240 } dirdialog { geometry 400x380 } } variable defaultcfgfile [file normalize ~/.config/tcltk/fsdialog.cfg] variable cfgfile $defaultcfgfile cfgtime 0 package require msgcat msgcat::mcload [file join [file dirname [info script]] msgs] } proc ttk::fsdialog::tk_getOpenFile {args} { return [dialog getOpenFile __ttk_filedialog $args] } proc ttk::fsdialog::tk_getSaveFile {args} { return [dialog getSaveFile __ttk_filedialog $args] } proc ttk::fsdialog::tk_chooseDirectory {args} { return [dialog chooseDirectory __ttk_dirdialog $args] } proc ttk::fsdialog::joinfile {path file} { # Join a file name to a path name. The "file join" command will # break if the filename begins with ~ if {[string match {~*} $file] && [file exists $path/$file]} { return [file join $path ./$file] } else { return [file join $path $file] } } proc ttk::fsdialog::dialog {cmd child arglist} { variable result if {[llength $arglist] % 2 == 0 && [dict exists $arglist -parent]} { set parent [dict get $arglist -parent] } else { set parent . } if {[winfo exists $parent]} { if {$parent eq "."} { set w .$child } else { set w $parent.$child } } else { return -code error "bad window path name \"$parent\"" } set var [namespace which -variable result]($w) $cmd $w {*}$arglist -resultvariable $var wm transient $w $parent vwait $var return $result($w) } proc ttk::fsdialog::preferences {args} { variable config variable cfgtime if {$cfgtime == 0} readcfg set prefs [dict get $config prefs] set argc [llength $args] if {$argc == 0} { return $prefs } elseif {$argc == 1} { set arg [lindex $args 0] if {[dict exists $prefs $arg]} { return [dict get $prefs $arg] } else { error "unknown preference name: \"$arg\"" } } elseif {$argc % 2 == 0} { set merge [dict merge $prefs $args] if {[dict size $merge] > [dict size $prefs]} { error "unknown preference name:\ \"[lindex [dict keys $merge] [dict size $prefs]]\"" } dict set config prefs $merge savecfg } else { error "missing value for preference: \"[lindex $args end]\"" } return } proc ttk::fsdialog::configfile {{file ""}} { if {[llength [info level 0]] < 2} { variable defaultcfgfile set file $defaultcfgfile } variable cfgfile [file normalize $file] if {$cfgfile eq ""} return # Create the containing directory, if necessary. file mkdir [file dirname $cfgfile] # Create the config file if it does not exists. # This will not change the timestamp if the file does exist. close [open $cfgfile {WRONLY CREAT}] readcfg } proc ttk::fsdialog::readcfg {} { variable cfgfile variable cfgtime variable config if {[file readable $cfgfile] && [file mtime $cfgfile] > $cfgtime \ && ![catch {open $cfgfile RDONLY} fd]} { set data [read $fd] close $fd set cfgtime [file mtime $cfgfile] catch { if {[dict exists $data history]} { set history [lmap n [dict get $data history] { set file [string trimleft $n] if {$file eq ""} continue set file }] dict set config history $history } } catch { dict set data prefs \ [dict remove $data history filedialog dirdialog] } foreach n {prefs filedialog dirdialog} { catch { if {![dict exists $data $n]} continue set merge [dict merge [dict get $config $n] [dict get $data $n]] foreach k [dict keys [dict get $config $n]] { dict set config $n $k [dict get $merge $k] } } } } elseif {$cfgtime == 0} { set cfgtime [clock seconds] } if {[llength [dict get $config history]] == 0} { set history {} foreach n [list / ~/.. ~ ~/Documents ~/Desktop [pwd]] { set dir [file nativename [file normalize $n]] if {$dir ni $history} {lappend history $dir} } dict set config history $history } return $config } proc ttk::fsdialog::savecfg {} { variable cfgfile variable config # Only save the configuration if the file already exists if {[catch {open $cfgfile {WRONLY TRUNC}} fd]} return dict for {key val} [dict get $config prefs] { puts $fd [list $key $val] } append hist \n " " [join [dict get $config history] "\n "] \n puts $fd [list history $hist] foreach n {filedialog dirdialog} { set str "" set settings [lmap {key val} [dict get $config $n] { list $key $val }] append str \n " " [join $settings "\n "] \n puts $fd [list $n $str] } close $fd variable cfgtime [clock seconds] } proc ttk::fsdialog::history {args} { variable config set history [dict get $config history] if {[llength $args] == 0} { return $history } foreach entry $args { set history [lsearch -all -inline -exact -not $history $entry] } dict set config history [lrange [linsert $history 0 {*}$args] 0 49] return } proc ttk::fsdialog::histdirs {{size 10}} { # Only return existing directories set rc {} foreach n [glob -nocomplain {*}[history]] { if {![file isdirectory $n]} {set n [file dirname $n]} if {$n ni $rc} {lappend rc $n} } return [lrange $rc 0 [expr {$size - 1}]] } proc ttk::fsdialog::histfiles {{size 10}} { # Only return existing files return [lrange \ [glob -nocomplain -type f {*}[history]] 0 [expr {$size - 1}]] } proc ttk::fsdialog::subdirs {dir} { file stat $dir stat return [expr {$stat(nlink) != 2}] } proc ttk::fsdialog::fontwidth {font args} { return [::tcl::mathfunc::max {*}[lmap str $args {font measure $font $str}]] } proc ttk::fsdialog::geometry {dlg args} { variable config if {$dlg ni {filedialog dirdialog}} { error "invalid dialog: \"$dlg\"; must be: filedialog or dirdialog" } set data [dict get $config $dlg] set argc [llength $args] if {$argc == 0} { return $data } elseif {$argc == 1} { set arg [lindex $args 0] if {[dict exists $data $arg]} { return [dict get $data $arg] } else { error "unknown option: \"$arg\"" } } elseif {$argc % 2 == 0} { set merge [dict merge $data $args] if {[dict size $merge] > [dict size $data]} { error "unknown preference name:\ \"[lindex [dict keys $merge] [dict size $data]]\"" } dict set config $dlg $merge } else { error "missing value for option: \"[lindex $args end]\"" } return } if {$::tcl_platform(platform) eq "windows"} { proc ttk::fsdialog::subdirs {dir} { try { set subdirs [glob -nocomplain -directory $dir -types d *] set hidden [glob -nocomplain -directory $dir -types {hidden d} *] return [expr {[llength $subdirs] + [llength $hidden] > 2}] } on error {} { return 0 } } } proc ttk::fsdialog::posixerror {w errorcode {problem "Operation failed"} args} { set top [winfo toplevel $w] set reason [mc [string toupper [lindex $errorcode end] 0 0]] # Avoid multple popups for the same error. Last one wins. coroutine warning#$top warning $top [mc $problem {*}$args].\n$reason. } proc ttk::fsdialog::warning {w message} { set coro [list [info coroutine]] after cancel $coro after idle $coro yield protect $w { tk_messageBox -type ok -icon warning -parent $w -message $message } } proc ttk::fsdialog::buttonname {str} { return [string tolower [string map {& ""} $str]] } proc ttk::fsdialog::protect {w body} { # Destroying any toplevel in the path leading up to a tk_messageBox # causes a segfault. As a work-around, clicking the close button on # any of those toplevel windows is temporarily disabled. set win $w set stack {} while {$win ne ""} { set win [winfo toplevel $win] lappend stack $win [wm protocol $win WM_DELETE_WINDOW] wm protocol $win WM_DELETE_WINDOW { } set win [winfo parent $win] } set rc [uplevel 1 $body] foreach {win cmd} $stack { wm protocol $win WM_DELETE_WINDOW $cmd } return $rc } proc ttk::fsdialog::dim {image} { return [image create photo \ -data [$image cget -data] -format {png -alpha 0.3}] } proc ttk::fsdialog::optadd {pattern option {priority userDefault}} { set style [ttk::style configure .] if {[dict exists $style $option]} { option add $pattern [dict get $style $option] $priority } } proc ttk::fsdialog::mc {args} { ::msgcat::mc {*}$args } # Create the images if they did not already exist. namespace eval ::ttk::fsdialog { variable image if {![info exists ::tk::Priv(updirImage)]} { set ::tk::Priv(updirImage) [image create photo -data { iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABmJLR0QA/gD+AP7rGN SCAAAACXBIWXMAAA3WAAAN1gGQb3mcAAAACXZwQWcAAAAWAAAAFgDcxelYAAAENUlE QVQ4y7WUbWiVZRjHf/f9POcc9+Kc5bC2aIq5sGG0XnTzNU13zAIlFMNc9CEhTCKwCC JIgt7AglaR0RcrolAKg14+GBbiGL6xZiYyy63cmzvu7MVznnOe537rw7bDyvlBoT/c n+6L3/3nf13XLZLJJP+HfICysjKvqqpq+rWKysvLR1tbW+11g+fPn/+bEGIe4KYqCs Owu66u7oG2trah6wJrrRc0NTVhjME5h7Vj5pxzCCE4duxYZUdHx/aGhoZmgJ+yb+wF uCO19RmAffv25f8LFslkktraWtvU1CS6u7vRWmOtxVpbAPu+T0tLS04pFU/J34Wd3S cdFtlfZWeZBU4IcaS5uXn1ZLAEMMY4ay1aa4wx/zpKKYIgoL6+vmjxqoXe5ZLTcsPq bTyycjODpe1y3WMrvDAMV14jCuW0VhhjiJQpOJ5w7Zwjk8/y9R+vsHHNNq6oFMrkeX BxI+8d2sktap3YvOPD0lRQrH+Z81fE7t3WB4gihVKazsuaA20aKSUgAG/seQdy2l6W 37+EyopqTv39I6HJUT2zlnlza2jLdgiTaxwmDov6alLHcZUTzXPGGAauWJbfO4dHl9 bgJs3HyfNf0N4ZsOa+jbT3/ownY/hO09p1kBULtjBw+Tvq7xzwauds4dWPDleAcP5E xlprgtBRUZRgYCRPTzoHwEi2g6OnX+eFrW/RM9qBE4p43CeTz5ATaU6nDrFm2cPs/+ E1SopqkZ7MFJqntXZaa7IKppckwIEvJbg8LWd28OT6nVihCPQQ8UScWCLGqO4hXuQx qDtJ204eWrqWb1ufRspwtABWaqx5gRKUFSdwDnxPcuLcyyxbuIyaqntIBV34MY9YzC Owg+S9YeJFkniRpGPkCLMrZzG3+jbktA/KClMxFoUhiKC0OAbAhd79CO8i6xe/STyW 4O7KVRgUJ/sP0heeJV4kEVKw/vZd40sFKxat4mLvp6VLdvnb/XHHGGPIKwBBpC1/9n 3DpfRZnn9/AwCxRII9O79kVPdjvByxuET6Ai8mePeTt4lyheXzhOSpCcdWa00uckTG kckbGu76nEhbIm2xznH4VB3OWYaiXqQn8GKSWGIMHuXyPL76LBcupmhp69pz4uMnXi w4VloTGcdQRtGdzmHs1f+RdYZslMZJhzUOHVnceN1ooEiP5JUzdqCQMWCD0JCIeQzn NNpO+clhrCYf5rC+A2cxWmDUWG2oHEOZMEKIwclgMnnLrTeXUV7sUzpNXgU9DmijWV v9LEKCkAIhKIBnlvpks6F21qUZ31u/sbExPa9h0/RzwzMov2nGlG5TmW1YOzzlnSfL mVnyGf19Q7lwZHBp+1fPtflAIgiC7389n9qkihP+lWyeqfUO15ZwQTqlw9H+o2cOvN QJCAHEgEqgYnI0NyALjAJdyWQy7wMa6AEujUdzo3LjcAXwD/XCTKIRjWytAAAAJXRF WHRjcmVhdGUtZGF0ZQAyMDA5LTA0LTA2VDIxOjI1OjQxLTAzOjAw8s+uCAAAACV0RV h0bW9kaWZ5LWRhdGUAMjAwOC0wMS0wM1QxNTowODoyMS0wMjowMJEc/44AAAAZdEVY dFNvZnR3YXJlAHd3dy5pbmtzY2FwZS5vcmeb7jwaAAAAAElFTkSuQmCC }] } if {![info exists ::tk::Priv(folderImage)]} { set ::tk::Priv(folderImage) [image create photo -data { iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiA AAAAlwSFlzAAAN1wAADdcBQiibeAAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBl Lm9yZ5vuPBoAAAHCSURBVDiNpZAxa5NRFIafc+9XLCni4BC6FBycMnbrLpkcgtDVX6 C70D/g4lZX/4coxLlgxFkpiiSSUGm/JiXfveee45AmNlhawXc53HvPee55X+l2u/yP qt3d3Tfu/viatwt3fzIYDI5uBJhZr9fr3TMzzAx3B+D09PR+v98/7HQ6z5fNOWdCCG U4HH6s67oAVDlnV1UmkwmllBUkhMD29nYHeLuEAkyn06qU8qqu64MrgIyqYmZrkHa7 3drc3KTVahFjJITAaDRiPB4/XFlQVVMtHH5IzJo/P4EA4MyB+erWPQB7++zs7ccYvl U5Z08pMW2cl88eIXLZeDUpXzsBkNQ5eP1+p0opmaoCTgzw6fjs6gLLsp58FB60t0Dc K1Ul54yIEIMQ43Uj68pquDmCeJVztpwzuBNE2LgBoMVpslHMCUEAFgDVxQbzVAiA+a K5uGPmmDtZF3VpoUm2ArhqQaRiUjcMf81p1G60UEVhcjZfAFTVUkrgkS+jc06mDX9n vq4YhJ9nlxZExMwMEaHJRutOdWuIIsJFUoBSuTvHJ4YIfP46unV4qdlsjsBRZRtb/X fHd5+C8+P7+J8BIoxFwovfRxYhnhxjpzEAAAAASUVORK5CYII= }] } if {![info exists ::tk::Priv(fileImage)]} { set ::tk::Priv(fileImage) [image create photo -data { iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gva eTAAAACXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QQWFA84umAmQgAAANpJREFU OMutkj1uhDAQhb8HSLtbISGfgZ+zbJkix0HmFhwhUdocBnMBGvqtTIqIFSReWKK8ai x73nwzHrVt+zEMwwvH9FrX9TsA1trpqKy10+yUzME4jnjvAZB0LzXHkojjmDRNVyh3 A+89zrlVwlKSqKrqVy/J8lAUxSZBSMny4ZLgp54iyPM8UPHGNJ2IomibAKDv+9VlWZ bABbgB5/0WQgSSkC4PF2JF4JzbHN430c4vhAm0TyCJruuClefph4yCBCGT3T3Isoy/ KDHGfDZNcz2SZIx547/0BVRRX7n8uT/sAAAAAElFTkSuQmCC }] } if {![info exists ::tk::Priv(upImage)]} { set ::tk::Priv(upImage) [image create photo -data { iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABHNCSVQICAgIfAhk iAAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAAL/SURBVDiN tZRNaFxVFMd/5368eZkxRmQsbTEGxbZC0IWMpU5SbCmxILapFCO2LgSlWbhLbFJB cKErP0BcCIqCdeEiUAviQoJIwIgW3biwCoYGjTImTIXWTjsz7+O4yLzwUkuSgjlw uPdd7vmd/z33vCuqymaY2RTqZoLdRjfunXTvg2zfNh8PT01p8r+AByf9S9vv6DuG QWr627vA6Hox65ZiYMIdva1Ufvlg9WhpaM+RYs+t5eN7J4IX1ouTtbpicCyoFEul macOniidr8+SpBG7ynv4dPrjxpVW48i3b0Rf3rTiR8al13o3/cSBZ0uLV+f46/IF apfmWLh8nsf2PVnyzp0ZnAx33RR4cFK6U2dnDu97pie1LS5c/BFnHNZ4fl36nkZS Z6h6qBuNv6qOye0bAo+MiFXc54/uHundUt5qfln6Dmt8xx2I8MPCF5RuKcrAg0Nb jHfTlVHx64Jrd9v3qv1Du/t3VPxPta+xYvHOUwgCfGBQ28Z45dzCWfruvMfdf+9D /V099vSa4IEX/fh9d1WO7a8Mhz/XZjFOCMMCYVggCD2RaeAKQlAw4CPO/XmGygMP h33bdg5XJ/ypPGulK6rj7vG+rTumnjt0qss5j5KikjAzf5pYWtSvzXMt+Wc5SuHw zpNoqmgKzXaLs9OfXK1f/OPp2bfizyD3gxgr478vznW98sHzAFgvzVdPfBj6wNFo LxLZBt4bBFAF44R3PnqtGbc17CCKOBkDVoNnX4/2X1cWNdbiA8+V1hK+YDAGEEFV sVaI2xp+82Yk19d3FfhGZozQiP9GbYwLBOMEEUFTRewNeRsEi6WZXkIMGCs4bzBO iNspsjZ3dVfIsjkRKWRrzbgBCppCmihJpGgC6EpMUUQKIrJKpMuAgO98u84cVTjQ O4pKirEgIizfHqTpyhvTDcRAJCJxNne5BDYHdUD95NvHy2sfmHomImcKJKKqmeI8 NBuzZKbjHb2kHY+BJFMJtIG2qqb/eTY7SWzOM6jtbElz8CQHV83B/gXtSQriGSyg 6AAAAABJRU5ErkJggg== }] } if {![info exists ::tk::Priv(prevImage)]} { set ::tk::Priv(prevImage) [image create photo -data { iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABHNCSVQICAgIfAhk iAAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAANNSURBVDiN tZVNaFxVGIaf75xz782fUvsjGI00BY2IoILGmJks2igRqcH6H4pdSOmmK2sToS6i iBsRhIouTDetYnVRjSJCLbYbFSKdKiiIQZRY04ihNmnoZGbuufdzMXeSMaZjXPTA yzmLj+d7v5d77hFV5Uosc0WogPs/xb37gwERDoRtvv/UqPpGtWt23DcS7r1+U+eH RmzfWgz9J1heEpMbdm/e3HH7q3sGD7RY49K1GGnYeWBYWnPixrtv3Zq/r/vRpsCF a2E2Buefl3bBneq/e0fnnV33Bt9Of07P5kGMo1JecIu5/cE/6sUwG7T69lr2q4Jz I+Ed1jSdGNy285rrNt1gJ6Y+BZQkTXhh11vNRgyCILKc5OjY7vXgHbA6uPc5t721 ue3ow1ufbjORMjH1CUYs1gR8MXkYIw4jBmssgkFEyG95vHEUueFg37qrN7y8o39X y/nFKX4+ewZrApwJSDUlTROscRix+NRgMsdJGqMosho4P+IOtm/seGYg/1jL5Plv mJ77aRmoCYGkpLZCRTyJxqDgCInsVXiNWXmDlx0b2jGIkhD7EmVfJBaLotgQwGNQ jBXEVL1pqmgJiumFf0WxlP5XzckT5/78/dBHJ9+9dNOGbrquvYeyL5KaEtgKLoKw 2RK1WJpaLVFr9Rw0G1KpXB6so5p+/Zrf99fsheFjxw8X14cd9HQ+RBAE2MDgQkMQ mSp8CWpxkcFYQYGFc8u8pShEJACiiTf8B7c9VZwZT947cn/v9ra+zielMPsxaio8 uOVZnHPYwKCqpF5JfHVHYOYMLSISq2rsMqgDwkzRD+8n392Y55Hjfvyd3F3bNuZv 2elOzx5DU3j90CvlcjGOVo4uMDd/FgOEIpLUHNtMrqbfvkz+mP+VocSfPDh/cb4r 1zMUaiLEZQ0KY/6B8kUWgHKmUrbXWK7hT2h+moXC28neQuH0yc9OjJcXi6VG5fUr rTlOMvk69xVAfAktjKUvVoZ+mbxUPLKHNI3EUMxcxlmdX6FqFKrqRSSLqtqxrpED 3PdHk7HK4MyP6zbL7iRmLhvd18FjYBEoqapK/Y2RKj0Aomx3dRNIJs1UP2UZKKsu vypyucdURCzV79zWqTZNbaIESHQVyN9x5li6vCTOrQAAAABJRU5ErkJggg== }] } if {![info exists ::tk::Priv(nextImage)]} { set ::tk::Priv(nextImage) [image create photo -data { iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABHNCSVQICAgIfAhk iAAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAAM0SURBVDiN tZVbaB1VFIa/NbPn5GLtRSkpKNYnb+2DhQo1idCCVgRBRa36IlKlFHxpSUkLgqJg UaQ+9EVQS2nMQ4haCiliSzSGJqYqmhY1NMZL1KSxxgTTk+TMZc9ePpw5dZI20Yd0 wc/MhjXf2v/ai9miqlyN8K4K9f+CG5uDrvom8+CSg9WxeW3dLe83Nhd2LykYYMfD L1Svu3njq/fsNW9v2yb+koF9P+CRzdtrNq27/+nza03nludl2WL5Jr9oaA7+wFF3 WXUjoXO2+sz5Tho3bK1asWxVw8d9bf2b9sqW06/ryJXAkh+3hj2B7t/ZMidB1aEo Th1dQ60IHnesaWBsfNQd62r521p77+cH4v7/BL+y411O/dSeQRXFkboUpw6nltRZ UrXcVnc3Gnsc/eTwTCksPnXqDdsxx+X8SqmzRLZEZEvEaUhkQ5I0IklDYhsSpyGx LfHN7ye4mI7x5AM7r1lx7eq2hj1B06Jg6xJKSZHJ2TEuFIcZn/6NqdKfhLZIQkgq EU5inMQMXOhhaOILHrvvmdob6256ubHZHKxwzHxwMZxkeOJblHKLxAM/8PCd4Ac+ BVPAMz7iBCcpaqLyUxBEblgQnLhoDjSo8jCFsjwjeL4FLM4pt66sZ03hdj48cWR2 anriUG9tumtBcD78wMMPPEyVd6mAZwRPPNav2oo/u5y2jsOz01Mz+04fTN8B4KV5 YBEJ6pvKy8c37EMAz0gZbgTfCCfH3qS2poY7r3+I8ZEpPXa8ZWbyl+jZ79pdN1AL GBGJVDUxGdQABYXxt9r2r75s50bi3c+9WKj2l7Pxukc59/25tPOzkxPDvbp9tM8N ATX8OwgqImllxz7g9x2w64GqTNWV9/om0+tS5a6VT9DT3RN/ffbLnwc+sLsujvAX UAAckGaygFm0x/kISyEffdoRDw4O9pw54l5LI2YWSXcVcL6anykGBMoj0n68Nf71 h9FDZ99zrVlukinOvsur3ApVtSJCBiJnzQImTfSrH/tHWgaOuu6skMtBKvAEKAGh quqcf4WU6UHW24Dy1FQcSM6BznMZAZGq2kushS5TEfEpn7SfU8VN/rBSvQLkHy0n h7/z4dY0AAAAAElFTkSuQmCC }] } if {![info exists ::tk::Priv(homeImage)]} { set ::tk::Priv(homeImage) [image create photo -data { iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABmJLR0QA/wD/AP+g vaeTAAAACXBIWXMAAA3XAAAN1wFCKJt4AAAAB3RJTUUH1QoOFCMCb8BVTwAAAyVJ REFUOMullcFvG0UUh7+Z7Dq1G+NtnEBdRG0hVTSiqkAoNFIvHCCgKmotWVUiCMpf 4FO1FQKVf2CFVEgFJyCIHIKg0jpSLz330AMHGkI5EEEPkRM1iZ1CXLvx7gyHXa/W TZ1E6kij3Z2Z9703v3lvVnCINg85oBp+vjkNv/G8bR7emge9Y9t6x7b1POjQ0b5N HAQFfi3adte46zgAJ6ZhrZetPAz00Z070XhtcZHQUXW/yOVB0Na9ewxks13zh4GL /aDeygrSMJCFQmf7FG2bzUoFKQSDFy/2lEX2gupqFZlOR9A/Jy6w+uEUruMwdOkS ntb7Ri5i0Gngx6Jto+v1YPLYMVzHofHxR2ycfo2XXjzOqfo2q1evUrRt1isVEj0i j4N10bah2YTdXchkcB2HJ/YV/n35BCMjr5NKJmm1WqTW1nkwMxPAXZeElBF8OmQa IfRIx4FuNhGDg7iOg/7CQWazvJEvkM/ng3kNu6+cxLx1i4VSialymXXX3XN4RvhM RdqE0L7vv8UzTM6fG8OyrMhAaw2AZVlk795lYWyMqXL54HS7fvMX/LnvaBsGo6Nv MzAwgO/7Xb3dbuP7Pv3ZLOP377MwOxtPANml8e2zZ2ceLi3NnVv5i08/+2RPBDe+ +hqlFNe/nEWLPrTXQhhH0P4TPr92jUo6zdCZM+UPlpdvxKVgfGnph8uTpbkLg0Ex jIycRgiBEIFv3/fRWqOFpK8wjreyiMi/h35wG601lckShZOvfsPy8rOl6GiYSCQw TRPDMDBNE6VUBK9u7QDw+9+b+L6KbBzH0c/S2IiDpZRIKUnIVQxRQymFUgqPBH/8 swXAw/pjPNEf2RBkl4hL0QccjYM7EihyNFsBNJfL8c75Ud5PHkXq47wrTTbWiIOz BAXiGaEHoxcY+kkmQSkFwKP6JmJ7q/tSqtX2VLIRG5AdbS3LIpPJIJAEfMHw8DCN RoOJiYk9GZNKRWXQAHQHKEIp0pcnS7Xn+dv8/NNNE/DioXfk6A8P4IVQryEgGc75 4dqd8L0NbAP/ARvA49iarvtYPCWLAMzYrogZ6rD7YddPR/8/aWZWKFzoJj8AAAAA SUVORK5CYII= }] } if {![info exists ::tk::Priv(reloadImage)]} { set ::tk::Priv(reloadImage) [image create photo -data { iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABHNCSVQICAgIfAhk iAAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAATmSURBVDiN tZVpTBRnGMf/7zszO7uzSzmWW+QQa5GgFkWoaBuPmiatMWnaEIKamKYC1k+2TROT Jv3SNDE1adJaFCQ1toCkNGm1sUdiPEqtCgRBWwVCPRAWAXGBved4n35gIRx+8Esn +WeSmWd+85tnnpmXERH+j40/S1FZWYv0LHUb9jdnl77bkgAA7GnGJZXfrlAU9SMw bDVNK00QFIkzP+ds1BJ0QZBoERT4o6O20pi55qV9p1MEp79MC1s76ysezAMzBlb6 XnM9wMpffnGpbWVOsuxyquCcQdcNBEIGHjyatG70egIj4wGJMRz2c+ULl6Rz6Lzd EmIFMZHVUbtnYB5444Hmk9lpcWV7Xl+tRQwLE/4wYjQVmqpA4gDjDKBpA38wgkud 98PX/x7SScCzqTBr2a3+EWNyIph37cSuQXkGWlT1XUmCS3t7e/Ey7euWdjHmDXLO AWEREYOZ6naFSgoynIUvpEpEQMggbF2fay/Kz7D3P3wS82pRFuvqHTZ1IYl5L88u K9XPuVRn/ZlOmgoYzGFXwpYQ31+rreAhjhTPiH/7uda+Hz79pjXY1jNMTlXC0HgI TwIm1uenM0XmsCwB2R6eDwbDawPDk8wdF+Ndnp16Q9dNLyA+B4CbNRXe9vqKtis1 5eWGbm38/Upf+4kfO4LxDo7MJA2Xbo1CkTgsIVhkoTEJqJpDHcrMSK6N1ewNYLzP Ipt34cS01VV06YZ5aCqgSzEOBUPjIQgAdoXDsogpQhYAMNtjS4hgosvxZYzD/rOu q48pwk7FLE2eWgguqmpcpcjS2eq3itSkeA1piU5sLkiGqkgwBTGbtQDsSEvPOYvL 4szeNwQAoHLFovkuqmpIY8R/syzSjra0R0gQiADC9F4IsulWQABzPpDiqqYxBrgW 0QAQwce42P7E5u5x+UYcT6sBAIWgtp/aO0oEkuccj2v4ZIdskzkABsaAsG7i47rW yP2RyfevH9/dHa2LTNvXKUC8VlpQGHbH6PHd/z4sHRx9XEeExHmtABGz22RcuDUC BkJpXhKazt+JDIz6jrYd39Ww0E4WzhRJFcdUh++nybBImvD7q2yybM2cnzNu05aG KZCR6AQD0N0/RpyxVcXvNC9d9NwSnrMssWHSF9x9+97gh75AOJtx3J298awwiDEA a3LiMDgexJCX48iBLfam8z3bzl3p7ympbvpKWNQBYgNcsWQi6YhDVeJ67g5ttikS uWM1wzsRql8EnpZmCIZ05C+JRcS00HnPi1cKM6Xi/HSt487wB57HvrBnzMfGJ4JO ycaQ4taQl5OMxDgna/ylK6yZeuMiMGeM3X80hUM1lyY4A9+xablty7osuzdgwiKg MC9NLrBSXYxN988QBNMUmPBH0PjrDb9lGAcvntwbnpUkIjDGpPWVDUas0xbo77q4 w9Nx5lHulsqd7iW51aufT8vIz01RMlNjmdNhQ8QQMEwLkwEdXb0ecfXmQz04MXK4 +/TBGgBhAGEi0mfA9nX7Grx+z+2y3nOf/QPAEY09fe3ONSkrt5UrWvxacKY6VcUI RkyJCBAR35+jfa3HBq42dQMIRRMkouAMmK3efezNmw37LwOwA1DnRIlGkpxuJSGj ICHoHfYGRvu8APToXEeiUB+ACBHRoqWJMSbNgc1EBiBh+jdvRWNEowMwiciay/kP KWlcmnLc32AAAAAASUVORK5CYII= }] } if {![info exists ::tk::Priv(newfolderImage)]} { set ::tk::Priv(newfolderImage) [image create photo -data { iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABmJLR0QAAAAAAAD5 Q7t/AAAACXBIWXMAAA3XAAAN1wFCKJt4AAAAB3RJTUUH1QsRDwMVXP7WwgAAAtNJ REFUOMvVlU1rE0Ecxn8zO4lNNFWrNlRBhQpCTQ9aQRREv4E3ETz5dhJRz4LgF7An ERVvXop4qBc9qdCDoGhrqyVpfUHUNmnaNG3eNtndGQ/ZjTFabRUPDjyzM/vf/c0z /52Zhf+tCIALF89f8bR7uTVYq9UA0J4+duvm7YEVg8+dP2tOnTiz5EPXb1wjl8vt vTtw70VrzM0cEUAIcFR80PwA3r/vAOl0ekn48KuXOI6DMaYhSxoOH4j1nz6aTwJh YBgYVvHBsgpe7OnZhZTWkuDNm7d817csQ+f6OUJ66GLN2ptFtCulUx+FTve7mSMD Ksjl+PgbHk0YRr4sJ4OGHfEFjh9MsWfnblx1bJOlOihVhtbPZO5f7o6nXzQcJxK9 XH08yqWTh7Ad75dYicvG6Du616WJRrqw1AaEkCgrQr4S7gbWNsCvX48BMF+qkV2s /uaLa4pRxWq5FikmiVlDhEI7cZ2XvE+H6dtOTgLYtk0i0bvspWSQzFc28Wamj1R2 K9nZp+RzA3yekzwc2Qow9YPj5RbPKGbLnRRr7XzKd7NKVbBUF28zYwAFBVAul+uO H4+ucH9JbDeK7UYBWBNyqTpqUsUHjfxTxz8rCwsFpLtYrA/ZtCoAImGrKZf4mwG0 MWgNWhu0Nni+3CaV7SrSeBMAKth9gWPX01RdDSYAg8BghN/BYBD1oDBgBAbDmjbF zPy8I71yCZANcCLRS1/yGdKSVB1dZwgaA7SC8Otgah0xSWZ2UUg7+wRQyj9AGBtP 0r6uk3S+iu07DngNeHNtaIwciyiqjiabL3hq7jlAWAFRgLauHrbFLJLTJQSgmxPd aPtpqNvHUDewKqT5PJkyhUKp8Ck5UQQiCqiMjo6d+XBn5Nbfnu3F1IP+6anpqWAu FtAGxICI3w77K0Z8y/R3Z3hwzwCer5qvCrAomuDKV6gJSgtYtFy1H9OA2yT9z/55 XwFw92OAfbBE1wAAAABJRU5ErkJggg== }] } if {![info exists ::tk::Priv(optionsmenuImage)]} { set ::tk::Priv(optionsmenuImage) [image create photo -data { iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABmJLR0QA/wD/AP+g vaeTAAAACXBIWXMAAAsRAAALEQF/ZF+RAAAAB3RJTUUH1QkaCxgledlRSQAABAxJ REFUOMullX9MlHUcx1/PcQIp4KGWcoSIzWlWwgmjDe4WhbgWCs5labKmFstq/eFY Cxnu25PEUf/QBuTI1ppjLcwtc9omsWkt2JQfZzupQyV2uziQHpEuQLg7nqc/5Lkd 50Ftfbdnez7Pvs9r7+/n834/j0TEEkII4P258j2gV5bldv7vEkJoo7dHtJmZac3l +k0TQmgVFRXFgPQvr0qAQS8MUTaYmz49gaaqpJrN7Nu3l4SEhPOAthA8p7wl5YMT 59Sc8pZTkWBJCJEFIMvyMGC2133EzPQ9MjIyIlVFQrMA77HDOzEvZ01OeUu7Dpaq q6tlwCGEOK7DrVYrkvTAgdQogh1dn+2np6eHg/nLCi3p8YUARmBJTEzMsTcPl2OI iX0XqN6yZQubNm1E01QkScI/M3lFCJEly/K1KGoZGBjA4/Hw4feTAObQ0Zqbm52l JTufXLr0IQJ+P5qmoWlaCJBkSqa21g5gnmuVDnV0Nr1E3tun9a2W7pNl10JgIURK fHz8r89vLzQ9/sRTSJIUmpVv/O59+HITtfY6APMF74bVgONq8yvB3De+MgJF3SfL 2qMOQwiRlZ6e/rnb7c7Wn+Xm5ga2bStc8vdf42iaxrLEJFpbW2nqjOXnhhexvnNm nspwrrSIn1MAG9BaVXWUsTsK12/+wcdn3Xx7vJiCI2cXhAKa9B8CkwU41lqKOXHh Bt9U5VP1RTclmwO4XP2WsIHq/Yvuy3DTK0Mer16vSk3jcv0uDtS1scsSz8slRdTU 1OgDHQVmFzV8OHTP9o1kbl6PoozxScsVVqWmUbEjBbPJyPqMdaQ+moYsywCWSCsa FoO+WmpFnVBINJkotCShDHlw9f6EzWYjPi6WO3/e5v43C4ee3KhgHfr67kwO7X6G tos/8GNPPxiMzAaDIa/KsszKh1cjSdKCcEMk9OhrVvYX53H6u3a6+gbJs9lwuW4R 8E8D4PP5FL/fny3LMitWPQIQgsfFxYXgBj1FypDHK7/1LHu2Z3PqzEUGPV6Kiktw uW7hdd+ko1/FGBzdUF9ff9dut98YGRmx6spn/H4OHjxAZWUlgCMEVoY8jiNlT1Na kEnrucsMerzYniucBw2M9lqmFHcSsAJY6XQ6A06ns1iWZcypaTQ2NuLz+UKdMOp3 6evSmFU1RocGH4BO/N5WoLguBeaEJAOGzs7OIDA8MTGxt6Gh4euxsTFUVb0aCATs oeSte8Gu7cg3Y8m28FiKiV/6bnG1q4uOfpUp96X80b42JWImaphVZ4EZYBKYBoLA rBFgxZqUrec7vL16g+5NTdDRrxJnmCxQk1PHASXM9zpQ/6Ooc/CgDp0X6a2HvrSM jQz36nVCYuza660VI+ExDYNKUWKszl0aoP0DjPbe8WKg6ioAAAAASUVORK5CYII= }] variable arrow [image create photo -data { iVBORw0KGgoAAAANSUhEUgAAAAgAAAAFCAQAAADSmGXeAAAAJUlEQVQI12NM/s+A ApgY0AAjAwOymrmMjAwMCKG5jHCZ5P8wQQAXTQgsrBlJzwAAAABJRU5ErkJggg== }] $::tk::Priv(optionsmenuImage) copy $arrow -to 15 18 image delete $arrow unset arrow } if {![info exists ::tk::Priv(sortdownImage)]} { set ::tk::Priv(sortdownImage) [image create photo -data { iVBORw0KGgoAAAANSUhEUgAAAAwAAAAICAYAAADN5B7xAAAAa0lEQVQY06XQsQ2D UBAD0AdSoKAgHb/NLozBBozAENAwAnOxAiPQHBKJoigCSy7O9km+4yIqtKi/eHV4 FeQhPtBhQHEKF6F1kXlDwoIJZXAKLR2h7GPpiRlrzC/02H7d02AMNv8+IZ1r3MIO qOkJqF7di88AAAAASUVORK5CYII= }] } if {![info exists ::tk::Priv(sortupImage)]} { set ::tk::Priv(sortupImage) [image create photo -data { iVBORw0KGgoAAAANSUhEUgAAAAwAAAAICAYAAADN5B7xAAAAZElEQVQY063QsQmA UBAD0IeCFhb+ToexdChnsBBHsHEfl7G3uUJULMRA4EgCCcdPaIM35A9agwEdNuxn M7uEE6YI7XGntxkrZpTBObTbvIQFI4qTXoS2XJsq9Kgfmuvwqk/vOwC8jgvQxnTb GgAAAABJRU5ErkJggg== }] } # Create dimmer versions of images for the disabled state set ::tk::Priv(upDimImage) [dim $::tk::Priv(upImage)] set ::tk::Priv(prevDimImage) [dim $::tk::Priv(prevImage)] set ::tk::Priv(nextDimImage) [dim $::tk::Priv(nextImage)] image create photo ::ttk::fsdialog::blank16 -height 16 -width 16 image create photo ::ttk::fsdialog::radio16 -data { R0lGODlhEAAQAMIAAJyZi////83OxQAAAP///////////////yH5BAEKAAEALAAA AAAQABAAAAMtGLrc/jCAOaNsAGYn3A5DuHTMFp4KuZjnkGJK6waq8qEvzGlNzQlA n2VILC4SADs= } image create photo ::ttk::fsdialog::check16 -data { R0lGODlhEAAQAMIAAExOTFRSVPz+/AQCBP///////////////yH5BAEKAAQALAAA AAAQABAAAAM4CAHcvkEAQqu18uqat+4eFoTEwE3eYFLCWK2lelqyChMtbd84+sqX 3IXH8pFwrmNPyRI4n9CoIAEAOw== } variable stylesettings [ttk::style configure .] if {[dict exists $stylesettings -selectbackground]} { option add *TkFDialog*selectBackground \ [dict get $stylesettings -selectbackground] userDefault option add *TkFDialog*inactiveSelectBackground \ [dict get $stylesettings -selectbackground] userDefault option add *TkFDialog*Menu.activeBackground \ [dict get $stylesettings -selectbackground] userDefault option add *TkFDialog*Menu.activeBorderWidth 0 userDefault } if {[dict exists $stylesettings -selectforeground]} { option add *TkFDialog*selectForeground \ [dict get $stylesettings -selectforeground] userDefault option add *TkFDialog*Menu.activeForeground \ [dict get $stylesettings -selectforeground] userDefault } option add *TkFDialog*Menu.borderWidth 1 startupFile option add *TkFDialog*Menu.relief solid startupFile } # Borderless treeview ttk::style configure Borderless.Treeview -borderwidth 0 -padding 1 # Create a treeview style without an indicator ttk::style layout Listbox.Treeview { Treeview.padding -sticky nswe -children { Treeview.treearea -sticky nswe } } ttk::style configure Listbox.Treeview.Heading -padding {4 0} ttk::style configure Listbox.Treeview.Item -padding {2 0} ttk::style layout Listbox.Treeview.Item { Treeitem.padding -sticky nswe -children { Treeitem.image -side left -sticky {} Treeitem.focus -side left -sticky {} -children { Treeitem.text -side left -sticky {} } } } # Helper megawidgets ::tk::Megawidget create ::ttk::fsdialog::FocusWidget ::tk::SimpleWidget { variable w hull options method GetSpecs {} { return { {-cursor cursor Cursor {}} {-takefocus takeFocus TakeFocus ::ttk::takefocus} } } method CreateHull {} { set hull [ttk::frame $w -style TEntry -padding 2] bind $w [namespace code [list theWidget state focus]] bind $w [namespace code [list theWidget state !focus]] } } ::tk::Megawidget create ::ttk::fsdialog::dirlist ::ttk::fsdialog::FocusWidget { variable hull options destructor { my variable fd fswatch close $fd next } method GetSpecs {} { return { {-cursor cursor Cursor {}} {-height height Height 300} {-takefocus takeFocus TakeFocus {}} {-title {} {} {}} {-width width Width 200} } } method CreateHull {} { my variable w next $w configure -height $options(-height) -width $options(-width) grid propagate $w 0 } method Create {} { my variable options variable watch {} variable tv $hull.treeview ttk::treeview $tv -style Borderless.Treeview -selectmode browse \ -columns watch -displaycolumns {} \ -yscrollcommand [list $hull.vscroll set] \ -xscrollcommand [list $hull.hscroll set] if {$options(-title) eq ""} { $tv configure -show tree } else { $tv configure -show {tree headings} $tv heading #0 -text $options(-title) -anchor w } $tv tag configure dir -image $::tk::Priv(folderImage) $tv column #0 -width 40 -stretch 1 ttk::scrollbar $hull.vscroll -orient vertical \ -command [list $tv yview] ttk::scrollbar $hull.hscroll -orient horizontal \ -command [list $tv xview] grid $tv $hull.vscroll -sticky ns grid $hull.hscroll -sticky ew grid $tv -sticky nesw grid columnconfigure $hull $tv -weight 1 grid rowconfigure $hull $tv -weight 1 oo::define [self class] forward selection $tv selection bind $tv [list [namespace which my] Map %W] bind $tv <> [list [namespace which my] Open] bind $tv <> [list [namespace which my] Close] bind $tv <> \ [list event generate $hull <>] variable fd [fswatch create [list [namespace which my] Watch]] } method Build {path} { my variable tv if {![$tv exists $path]} { set parent [file dirname $path] if {$parent ne $path} { my Build $parent } else { foreach n [file volumes] { $tv insert {} end \ -id $n -text [file nativename $n] -tags dir $tv insert $n end -id $n. } } if {![$tv exists $path]} { my Glob $parent {.* *} } my Glob $path } } method Open {} { my variable tv try { set path [$tv focus] if {![$tv tag has visited $path]} { my Glob $path } set dirpath {} while {$path ne ""} { lappend dirpath $path set path [$tv parent $path] } $tv tag add open $dirpath set dir [file nativename $path] } trap POSIX {- err} { ttk::fsdialog::posixerror $tv [dict get $err -errorcode] \ {Cannot change to the directory "%s"} [file nativename $path] after idle [list $tv item $path -open false] } } method Close {} { my variable tv $tv tag remove open [list [$tv focus]] } method Glob {dir {pat *}} { my variable tv fd watch set list [glob -nocomplain -directory $dir -tails -type d {*}$pat] set sort [lsort -dictionary $list] $tv delete [$tv children $dir] set w [$tv column #0 -width] set offs [expr {[llength [file split $dir]] * 20 + 40}] foreach d $sort { if {$d in {. ..}} continue if {[string match */ $dir]} {set id $dir$d} else {set id $dir/$d} $tv insert $dir end -id $id -text $d -tags dir set w [expr {max($w, $offs + [font measure TkDefaultFont $d])}] if {[ttk::fsdialog::subdirs $id]} { $tv insert $id end -id [file join $id .] } } $tv tag add visited [list $dir] if {[$tv set $dir watch] eq ""} { set id [fswatch add $fd $dir \ {create delete move deleteself moveself}] $tv set $dir watch $id dict set watch $id $dir } $tv column #0 -width $w } method Watch {event} { my variable tv fd watch set id [dict get $event watch] if {[dict get $event isdir] == 0} { if {[dict get $event event] eq "ignored"} { fswatch remove $fd $id dict unset watch $id } return } if {![dict exists $watch $id]} return set dir [dict get $watch $id] set name [dict get $event name] set node $dir/$name switch [dict get $event event] { delete - movedfrom { set cwd [lindex [$tv selection] 0] $tv delete [list $node] while {![$tv exists $cwd]} { if {$cwd eq [set cwd [file dirname $cwd]]} break if {[$tv exists $cwd]} { $tv selection set [list $cwd] } } } create - movedto { set list [lmap n [$tv children $dir] {$tv item $n -text}] set x [lsearch -bisect -dictionary $list $name] if {![$tv exists $node]} { $tv insert $dir [incr x] -id $node \ -text $name -open 0 -tags dir } if {[ttk::fsdialog::subdirs $node]} { $tv insert $node end -id [file join $node .] } } } } method Map {tv} { # Make sure the selected directory is in view when the window # becomes visible for the first time bind $tv {} $tv see [lindex [$tv selection] 0] } method close {dir} { my variable tv $tv item $dir -open 0 $tv tag remove open [list $dir] } method open {dir} { my variable tv $tv item $dir -open 1 $tv focus $dir my Open } method set {dir} { my variable tv if {![$tv exists $dir]} { if {[file isdirectory $dir]} { my Build [file normalize $dir] } else { throw {POSIX ENOENT {no such file or directory}} \ "couldn't change working directory to \"$dir\":\ no such file or directory" } } my open $dir $tv selection set [list $dir] $tv yview moveto 1 $tv see $dir } method get {} { my variable tv return [lindex [$tv selection] 0] } method reload {} { my variable tv set cwd [lindex [$tv selection] 0] foreach dir [$tv tag has open] { if {[$tv exists $dir]} { $tv item $dir -open 1 $tv tag add open [list $dir] my Glob $dir } } while {![$tv exists $cwd]} { if {$cwd eq [set cwd [file dirname $cwd]]} return } my set $cwd } forward state theWidget state } ::tk::Megawidget create ::ttk::fsdialog::FileList {} { constructor {args} { namespace path [linsert [namespace path] end ::ttk::fsdialog] next {*}$args } destructor { my variable fd fswatch close $fd next } method GetSpecs {} { return { {-command "" "" ""} {-cursor "" "" ""} {-filter "" "" *} {-font "" "" "TkIconFont"} {-hidden "" "" 0} {-mixed "" "" files} {-multiple "" "" 0} {-reverse "" "" 0} {-sortkey "" "" name} } } method Create {} { variable files {} watchid {} modified {} variable fd [fswatch create [list [namespace which my] Watch]] } method Watch {event} { my variable fd modified options switch [dict get $event event] { delete - movedfrom { my Delete [dict get $event name] } create - movedto { if {![dict get $event isdir] || $options(-mixed) ne "files"} { my Insert [dict get $event name] } } attrib { my Update [dict get $event name] } modify - closewrite { set name [dict get $event name] if {$name ni $modified} { lappend modified $name } } } } method Hidden {name} { my variable cwd global tcl_platform if {$tcl_platform(platform) eq "unix"} { return [expr {[string index $name 0] eq "."}] } else { set attr [file attributes [jojnfile $cwd $name]] return [dict get $attr -hidden] } } method Delete {name} { my variable files set files [lsearch -all -inline -exact -not -index 0 $files $name] } method Insert {name} { my variable cwd files sortargs try { set file [joinfile $cwd $name] set new [my FileStat $name [my Hidden $name]] set val [lindex $new [lindex $sortargs 1]] set x [lsearch -bisect {*}$sortargs $files $val] set files [linsert $files [incr x] $new] return $new } on error {- err} { # puts [dict get $err -errorinfo] return } } method Update {name} { my variable files try { set new [my FileStat $name [my Hidden $name]] set x [lsearch -index 0 -exact $files $name] lset files $x $new return $new } on error {- err} { # puts [dict get $err -errorinfo] return } } method FileStat {name hidden} { file stat $name stat if {$stat(type) eq "directory"} { set type dir } else { set type file } if {$hidden} { set hide hidden } else { set hide $type } return [list [regsub {^\./} [file tail $name] {}] $stat(size) \ $stat(mtime) $stat(mode) $stat(uid) $stat(gid) $type $hide] } method SortFiles {} { my variable files options sortargs modified # Update any modified files foreach n $modified { set x [lsearch -index 0 -exact $files $n] if {$x >= 0} {lset files $x [my FileStat $n [my Hidden $n]]} } set modified {} switch $options(-sortkey) { date { set sortargs [list -index 2 -integer] } size { set sortargs [list -index 1 -integer] } default { set sortargs [list -index 0 -dictionary] } } if {$options(-reverse)} { lappend sortargs -decreasing } set files [lsort {*}$sortargs $files] my Refresh } method Refresh {} { set sel [my selection get] my Display [my Filter] my selection set $sel } method Filter {} { my variable files options if {$options(-hidden)} { if {$options(-mixed) ne "files"} { set list $files } else { set list [lsearch -all -inline -index 6 -exact $files file] } } elseif {$options(-mixed) eq "files"} { set list [lsearch -all -inline -index 7 -exact $files file] } else { set list [lsearch -all -inline -index 7 -exact -not $files hidden] } if {$options(-mixed) eq "split"} { set list [lsort -index 6 $list] } if {$options(-filter) eq "*"} { } elseif {$options(-mixed) eq "files"} { set list [lsearch -all -inline -index 0 $list $options(-filter)] } else { set keep [lsearch -all -index 0 $list $options(-filter)] set k [lindex $keep [set x 0]] set i -1 set list [lmap n $list { if {[incr i] == $k} { set k [lindex $keep [incr x]] } elseif {[lindex $n 6] eq "file"} { continue } set n }] } return $list } method configure {args} { my variable options files set save [array get options] set rc [next {*}$args] dict for {key val} $save { if {$options($key) eq $val} {dict unset save $key} } if {[dict exists $save -sortkey]} { my SortFiles } elseif {[dict exists $save -reverse]} { set files [lreverse $files] } if {[dict size [dict remove $save -cursor -multiple -sortkey]]} { my Refresh } return $rc } method changedir {dir} { my variable cwd files fd watchid modified set modified {} if {$watchid ne ""} { fswatch remove $fd $watchid } set cwd [file join [pwd] [file normalize $dir]] set files {} foreach n [glob -nocomplain -directory $cwd *] { # Dangling symbolic links may produce an error catch {lappend files [my FileStat $n 0]} } foreach n [glob -nocomplain -directory $cwd -types hidden *] { catch {lappend files [my FileStat $n 1]} } set watchid [fswatch add $fd $cwd \ {create delete move attrib closewrite modify}] my SortFiles } method clear {} { my variable fd watchid if {$watchid ne ""} { fswatch remove $fd $watchid set watchid "" } } method invoke {} { my variable options if {$options(-command) ne "" && [llength [my selection]]} { uplevel #0 $options(-command) } } } auto_load tk::IconList ::tk::Megawidget create ::ttk::fsdialog::ShortFileList \ {::ttk::fsdialog::FileList tk::IconList} { method Create {} { my variable parts image set parts {} dict set image dir $::tk::Priv(folderImage) dict set image file $::tk::Priv(fileImage) next nextto tk::IconList } method Update {name} { my variable modified if {$name ni $modified} {lappend modified $name} } method Display {list} { my variable image options set names [lmap n $list {lindex $n 0}] my deleteall my add [dict get $image file] $names if {$options(-mixed) ne "files"} { set img [dict get $image dir] foreach n [lsearch -all -index 6 -exact $list dir] { my ItemImage $n $img } } } method ItemImage {item image} { my variable canvas list set iTag [lindex $list $item 0] $canvas itemconfigure $iTag -image $image } method Position {str} { my variable itemList set rec [lsearch -index 2 -exact -inline \ [dict values [array get itemList]] $str] return [lindex $rec 3] } method SelectRange {item1 item2} { set i1 [my index $item1] set i2 [my index $item2] if {$i1 eq "" || $i2 eq ""} return if {$i1 > $i2} {lassign [list $i2 $i1] i1 i2} set items {} for {set j $i1} {$j <= $i2} {incr j} { lappend items [my get $j] } my selection set $items } method Btn1 {x y} { my variable canvas focus $canvas set i [my index @$x,$y] if {$i eq ""} return my selection set [list [my get $i]] my selection anchor $i } method CtrlBtn1 {x y} { my variable options canvas if {$options(-multiple)} { focus $canvas set i [my index @$x,$y] if {$i eq ""} return set str [my get $i] if {$str in [my selection]} { my selection remove [list $str] } else { my selection add [list $str] my selection anchor $i } } else { my Btn1 $x $y } } method ShiftBtn1 {x y} { my variable options canvas if {$options(-multiple)} { focus $canvas set i [my index @$x,$y] if {$i eq ""} return if {[my index anchor] eq ""} { my selection anchor $i } my SelectRange anchor $i } else { my Btn1 $x $y } } method Motion1 {x y} { variable oldX $x oldY $y set i [my index @$x,$y] if {$i eq ""} return my selection set [list [my get $i]] } method ShiftMotion1 {x y} { variable oldX $x oldY $y set i [my index @$x,$y] if {$i eq ""} return my SelectRange anchor $i } method FocusOut {} { my state !focus } method deleteall {} { my variable canvas sbar index selected rect list itemList my variable maxIW maxIH maxTW maxTH numItems noScroll selection $canvas delete all unset -nocomplain selected rect list itemList set maxIW 1 set maxIH 1 set maxTW 1 set maxTH 1 set numItems 0 set noScroll 1 set selection {} set index(anchor) "" } method deleteall {} { my variable canvas sbar set xview [$canvas xview] next $canvas xview moveto [lindex $xview 0] } method image {type img} { my variable image dict set image $type $img } method clear {} { my deleteall next } method exists {item} { return [expr {[my Position $item] ne ""}] } method selection {{method get} {items {}}} { switch $method { get { return [lmap n [next $method $items] {my get $n}] } set - add { if {$method eq "set"} {next clear 0 end} foreach n $items { set x [my Position $n] if {$x ne ""} {next set $x} } } anchor { return [next $method {*}$items] } } } method see {item} { next [my Position $item] } unexport add deleteall } ::tk::Megawidget create ::ttk::fsdialog::LongFileList \ {::ttk::fsdialog::FileList ::ttk::fsdialog::FocusWidget} { method Create {} { my variable w tv options variable owner {} group {} perm {} timeformat {%Y-%m-%d %T} variable sort {item none dir down} next set tv [ttk::treeview $w.tv -style Listbox.Treeview \ -yscrollcommand [list $w.vs set] -xscrollcommand [list $w.hs set] \ -columns {size date perm owner group filler}] if {$::tcl_platform(platform) eq "windows"} { $tv configure -displaycolumns {size date perm} } oo::define [self class] forward exists $tv exists ttk::scrollbar $w.vs -orient vertical \ -command [list $tv yview] ttk::scrollbar $w.hs -orient horizontal \ -command [list $tv xview] grid $tv $w.vs -sticky ns grid $tv -sticky nesw grid $w.hs -sticky ew grid columnconfigure $w $tv -weight 1 grid rowconfigure $w $tv -weight 1 $tv heading #0 -text [mc Name] -anchor w \ -command [namespace code [list my ToggleSort name]] $tv column #0 -stretch 0 $tv heading size -text [mc Size] -anchor w \ -command [namespace code [list my ToggleSort size]] $tv column size -width 100 -anchor e -stretch 0 $tv heading date -text [mc Date] -anchor w \ -command [namespace code [list my ToggleSort date]] $tv column date -width [fontwidth TkDefaultFont \ [clock format 0 -format *$timeformat*]] -stretch 0 $tv heading perm -text [mc Permissions] -anchor w $tv column perm -stretch 0 \ -width [fontwidth TkDefaultFont *[mc Permissions]* drwxrwxrwx] $tv heading owner -text [mc Owner] -anchor w $tv column owner -stretch 0 \ -width [fontwidth TkDefaultFont *[mc Owner]*] $tv heading group -text [mc Group] -anchor w $tv column group -stretch 0 \ -width [fontwidth TkDefaultFont *[mc Group]*] $tv column filler -width 0 -minwidth 0 -stretch 1 $tv tag configure dir -image $::tk::Priv(folderImage) $tv tag configure file -image $::tk::Priv(fileImage) bind $tv <> \ [list event generate $w <>] bind $tv \ [list [namespace which my] invoke] } method Owner {file uid gid} { my variable cwd owner group if {![dict exists $owner $uid] || ![dict exists $group $gid]} { set attr [file attributes [joinfile $cwd $file]] if {[dict exists $attr -owner]} { dict set owner $uid [dict get $attr -owner] } else { dict set owner $uid $uid } if {[dict exists $attr -group]} { dict set group $gid [dict get $attr -group] } else { dict set group $gid $gid } } return [list [dict get $owner $uid] [dict get $group $gid]] } method Permissions {type mode} { my variable perm if {![dict exists $perm $type $mode]} { if {$type eq "file"} { set str - } else { set str [string index $type 0] } set chars {r w x r w x r w x} if {$mode & 0o4000} {lset chars 2 s} if {$mode & 0o2000} {lset chars 5 s} if {$mode & 0o1000} {lset chars 8 t} set bits [split [format %09b [expr {$mode & 0o777}]] {}] foreach b $bits c $chars { if {$b} {append str $c} else {append str -} } dict set perm $type $mode $str } return [dict get $perm $type $mode] } method Values {rec} { my variable timeformat lassign $rec name size time mode uid gid type set perm [my Permissions $type $mode] set date [clock format $time -format $timeformat] lassign [my Owner $name $uid $gid] owner group return [list $name $type $size $date $perm $owner $group] } method Display {list} { my variable tv $tv delete [$tv children {}] foreach n $list { set values [lassign [my Values $n] name type] $tv insert {} end -id $name -text $name -tags $type -values $values } } method Delete {name} { my variable tv if {[$tv exists $name]} { $tv delete $name } next $name } method Insert {name} { my variable tv set rec [next $name] if {[llength $rec] == 0} return set list [my Filter] set x [lsearch -index 0 -exact $list $name] if {$x < 0} return set values [lassign [my Values $rec] name type] $tv insert {} $x -id $name -text $name -tags $type -values $values } method Update {name} { my variable tv options set rec [next $name] if {[llength $rec] == 0} return if {[$tv exists $name]} { set old [linsert [$tv item $name -values] 0 [$tv item $name -text]] $tv item $name -values [lassign [my Values $rec] - -] set x [dict get {name 0 size 1 date 2} $options(-sortkey)] if {[lindex $rec $x] != [lindex $old $x]} { my SortFiles } } } method ToggleSort {column} { my variable w options dict set opts -sortkey $column dict set opts -reverse \ [expr {$options(-sortkey) eq $column && !$options(-reverse)}] my configure {*}$opts event generate $w <> } method configure {args} { my variable tv options set sortkey $options(-sortkey) next {*}$args if {$options(-sortkey) ne $sortkey} { if {$sortkey ni [$tv cget -columns]} { $tv heading #0 -image {} } else { $tv heading $sortkey -image {} } } if {$options(-reverse)} { set image $::tk::Priv(sortupImage) } else { set image $::tk::Priv(sortdownImage) } if {$options(-sortkey) ni [$tv cget -columns]} { $tv heading #0 -image $image } else { $tv heading $options(-sortkey) -image $image } if {$options(-multiple)} { $tv configure -selectmode extended } else { $tv configure -selectmode browse } } method clear {} { my variable tv $tv delete [$tv children {}] next } method selection {{method get} {items {}}} { # oo::objdefine [self] forward selection $tv selection my variable tv switch $method { get { return [$tv selection] } default { $tv selection $method [lmap n $items { if {![$tv exists $n]} continue set n }] } } } method see {item} { my variable tv if {[$tv exists $item]} {$tv see $item} } } ::tk::Megawidget create ::ttk::fsdialog::chooseDirectory {} { constructor {args} { variable result "" namespace path [linsert [namespace path] end ::ttk::fsdialog] next {*}$args } destructor { my variable options result next savecfg uplevel #0 [list set $options(-resultvariable) $result] } method GetSpecs {} { return { {-cursor cursor Cursor {}} {-height height Height 300} {-initialdir "" "" ""} {-parent "" "" ""} {-mustexist "" "" 0} {-resultvariable "" "" ""} {-takefocus takeFocus TakeFocus {}} {-title "" "" ""} {-width width Width 200} } } method GetSpecs {} { return { {-initialdir "" "" ""} {-parent "" "" ""} {-resultvariable "" "" ""} {-title "" "" ""} } } method CreateHull {} { my variable w hull toplevel $w -class TkFDialog # The framework will add a binding to the hull widget. This # means the hull widget should never be a toplevel, because a toplevel # widget receives events for all of its children. place [set hull [ttk::frame $w.bg]] -relwidth 1 -relheight 1 wm protocol $w WM_DELETE_WINDOW [list [namespace which my] Cancel] } method Create {} { my variable w namespace upvar ::tk Priv img wm geometry $w [dict get [readcfg] dirdialog geometry] variable toolbar [ttk::frame $w.toolbar] set list [histdirs] foreach n [file volumes] {if {$n ni $list} {lappend list $n}} variable dirbox [ttk::matchbox $w.toolbar.dir \ -matchcommand [list [namespace which my] DirMatchCommand] \ -textvariable [my varname dir] \ -values [lmap n $list {file nativename $n}]] foreach n {home reload newfolder} { set image [list $img(${n}Image)] if {[info exists img(${n}DimImage)]} { lappend image disabled $img(${n}DimImage) } ttk::button $w.toolbar.$n -style Toolbutton -image $image \ -command [list [namespace which my] Button[string totitle $n]] pack $w.toolbar.$n -side left } pack $toolbar.dir -fill x -expand 1 -padx 2 grid $toolbar -sticky news -padx 2 grid [ttk::separator $w.sep] -padx 0 -pady 2 -sticky ew variable dirlist [dirlist $w.list -width 400 \ -title Folder] grid $w.list -sticky news -padx 4 -pady 2 grid columnconfigure $w all -weight 1 grid rowconfigure $w $w.list -weight 1 ttk::frame $w.buttonbar ttk::button $w.buttonbar.cancel -text [mc Cancel] -width 0 \ -command [list [namespace which my] Cancel] ttk::button $w.buttonbar.ok -text [mc OK] -width 0 \ -command [list [namespace which my] Done] grid $w.buttonbar.cancel $w.buttonbar.ok -padx 4 -pady 4 -sticky ew grid columnconfigure $w.buttonbar all -uniform buttons grid $w.buttonbar -sticky e variable cwd [pwd] $dirlist set $cwd $dirbox set [file nativename $cwd] $dirbox icursor end $dirbox xview moveto 1 $dirbox validate bind $dirbox <> \ [namespace code {my ChangeDir [%W get]}] bind $dirbox <> \ [namespace code {my ChangeDir [%W get]}] bind $dirbox <> \ [namespace code {my ChangeDir [%W get]}] bind $dirlist <> \ [namespace code {my ChangeDir [%W get]}] } method GlobEscape {str} { set map {\\ \\\\ ? \\? * \\* [ \\[ ] \\] \{ \\\{ \} \\\}} return [string map $map $str] } method DirMatchCommand {str} { set str [file normalize $str] if {[string index $str 0] ni {{} ~} } { set esc [my GlobEscape $str] set list [lsort -dictionary [glob -nocomplain -types d -- $esc*]] return [lmap n $list {file nativename $n}] } } method ChangeDir {dir} { my variable cwd dirlist dirbox try { set path [file join $cwd [file normalize $dir]] set dir [file nativename $path] if {$path ne $cwd} { $dirlist set $path set cwd $path } else { $dirbox set $dir $dirbox icursor end $dirbox xview moveto 1 $dirbox validate } } trap POSIX {- err} { posixerror $dirlist [dict get $err -errorcode] \ {Cannot change to the directory "%s"} $dir } return $cwd } method ReloadDir {} { my variable dirlist $dirlist reload } method ButtonHome {} { my ChangeDir [file normalize ~] } method ButtonReload {} { my ReloadDir } method ButtonNewfolder {} { my variable w cwd dirlist set top [toplevel $w.new] place [ttk::frame $top.b] -relwidth 1 -relheight 1 wm transient $top $w wm title $top [mc "New Folder"] ttk::label $top.l \ -text "[mc {Create new folder in}]:\n[file nativename $cwd]" grid $top.l -columnspan 4 -sticky ew -padx 8 -pady {8 0} ttk::entrybox $top.e -width 40 grid $top.e -columnspan 4 -sticky ew -padx 8 -pady 4 ttk::separator $top.sep grid $top.sep -columnspan 4 -sticky ew -padx 8 -pady 4 ttk::button $top.b1 -width 0 -text [mc Cancel] \ -command [list destroy $top] ttk::button $top.b2 -width 0 -text [mc OK] \ -command [list [namespace which my] MakeDir $top.e] grid x $top.b1 $top.b2 x -padx 12 -sticky ew -pady {4 12} grid columnconfigure $top all -weight 1 grid columnconfigure $top [list $top.b1 $top.b2] \ -uniform buttons -weight 0 grab $top wm resizable $top 0 0 focus $top.e bind $top.e [list $top.b1 invoke] bind $top.e [list $top.b2 invoke] } method MakeDir {e} { my variable w cwd try { set dir [file normalize [joinfile $cwd [$e get]]] set name [file tail $dir] file mkdir $dir destroy [winfo toplevel $e] my ChangeDir $dir } trap POSIX {- err} { posixerror $e [dict get $err -errorcode] \ {Cannot create directory "%s"} [file nativename $dir] } } method Done {} { my variable cwd result set result $cwd history $result my Cancel } method Cancel {} { my variable w set geometry [lindex [split [wm geometry $w] +] 0] geometry dirdialog geometry $geometry my destroy } } ::tk::Megawidget create ::ttk::fsdialog::getSaveFile \ ::ttk::fsdialog::chooseDirectory { variable options destructor { set ::tk::Priv(button) "" next } method GetSpecs {} { return { {-confirmoverwrite "" "" "1"} {-defaultextension "" "" ""} {-filetypes "" "" ""} {-initialdir "" "" ""} {-initialfile "" "" ""} {-parent "" "" ""} {-title "" "" ""} {-typevariable "" "" ""} {-resultvariable "" "" ""} } } method CreateHull {} { my variable w hull toplevel $w -class TkFDialog # The framework will add a binding to the hull widget. This # means the hull widget should never be a toplevel, because a toplevel # widget receives events for all of its children. place [set hull [ttk::frame $w.bg]] -relwidth 1 -relheight 1 wm protocol $w WM_DELETE_WINDOW [list [namespace which my] Cancel] } method Create {{title {Save As}} {action Save}} { my variable w dir cwd filter pref variable text {} files {} owner {} group {} result {} array set pref [dict get [readcfg] prefs] namespace upvar ::tk Priv img set geometry [geometry filedialog] wm geometry $w [dict get $geometry geometry] # Build the toolbar variable toolbar [ttk::frame $w.toolbar] foreach n {up prev next home reload newfolder} { set image [list $img(${n}Image)] if {[info exists img(${n}DimImage)]} { lappend image disabled $img(${n}DimImage) } ttk::button $w.toolbar.$n -style Toolbutton -image $image \ -command [list [namespace which my] Button[string totitle $n]] pack $w.toolbar.$n -side left } ttk::menubutton $w.toolbar.options -style Toolbutton \ -image [list $img(optionsmenuImage)] $w.toolbar.options configure \ -menu [menu $w.toolbar.options.menu -tearoff 0] $w.toolbar.options.menu add cascade -label " [mc Sorting]" \ -compound left -image ::ttk::fsdialog::blank16 \ -menu [menu $w.toolbar.options.menu.sort -tearoff 0] $w.toolbar.options.menu add separator $w.toolbar.options.menu add radiobutton -label [mc "Short View"] \ -compound left -image ::ttk::fsdialog::blank16 -indicatoron 0 \ -selectimage ::ttk::fsdialog::radio16 \ -variable [my varname pref(details)] -value 0 \ -command [list [namespace which my] Layout] $w.toolbar.options.menu add radiobutton -label [mc "Detailed View"] \ -compound left -image ::ttk::fsdialog::blank16 -indicatoron 0 \ -selectimage ::ttk::fsdialog::radio16 \ -variable [my varname pref(details)] -value 1 \ -command [list [namespace which my] Layout] $w.toolbar.options.menu add separator $w.toolbar.options.menu add checkbutton -label [mc "Show Hidden Files"] \ -compound left -image ::ttk::fsdialog::blank16 -indicatoron 0 \ -selectimage ::ttk::fsdialog::check16 \ -variable [my varname pref(hidden)] \ -command [list [namespace which my] Reconfigure] $w.toolbar.options.menu add checkbutton -label [mc "Separate Folders"] \ -compound left -image ::ttk::fsdialog::blank16 -indicatoron 0 \ -selectimage ::ttk::fsdialog::check16 \ -variable [my varname pref(duopane)] \ -command [list [namespace which my] Layout] $w.toolbar.options.menu.sort add radiobutton -label [mc "By Name"] \ -compound left -image ::ttk::fsdialog::blank16 -indicatoron 0 \ -selectimage ::ttk::fsdialog::radio16 \ -variable [my varname pref(sort)] -value name \ -command [list [namespace which my] Reconfigure] $w.toolbar.options.menu.sort add radiobutton -label [mc "By Date"] \ -compound left -image ::ttk::fsdialog::blank16 -indicatoron 0 \ -selectimage ::ttk::fsdialog::radio16 \ -variable [my varname pref(sort)] -value date \ -command [list [namespace which my] Reconfigure] $w.toolbar.options.menu.sort add radiobutton -label [mc "By Size"] \ -compound left -image ::ttk::fsdialog::blank16 -indicatoron 0 \ -selectimage ::ttk::fsdialog::radio16 \ -variable [my varname pref(sort)] -value size \ -command [list [namespace which my] Reconfigure] $w.toolbar.options.menu.sort add separator $w.toolbar.options.menu.sort add checkbutton -label [mc "Reverse"] \ -compound left -image ::ttk::fsdialog::blank16 -indicatoron 0 \ -selectimage ::ttk::fsdialog::check16 \ -variable [my varname pref(reverse)] \ -command [list [namespace which my] Reconfigure] $w.toolbar.options.menu.sort add checkbutton -label [mc "Folders First"] \ -compound left -image ::ttk::fsdialog::blank16 -indicatoron 0 \ -selectimage ::ttk::fsdialog::check16 \ -variable [my varname pref(mixed)] -onvalue 0 -offvalue 1 \ -command [list [namespace which my] Reconfigure] pack $w.toolbar.options -side left $w.toolbar.prev state disabled $w.toolbar.next state disabled set list [histdirs] foreach n [file volumes] {if {$n ni $list} {lappend list $n}} variable dirbox [ttk::matchbox $w.toolbar.dir \ -matchcommand [list [namespace which my] DirMatchCommand] \ -textvariable [my varname dir] \ -values [lmap n $list {file nativename $n}]] pack $dirbox -fill x -expand 1 -padx 2 -pady 2 grid $w.toolbar - - -sticky ew ttk::separator $w.separator grid $w.separator - - -sticky ew # Build the file area ttk::panedwindow $w.filearea -orient horizontal -width 700 -height 400 ttk::label $w.fnlab -anchor e -text [mc Location]: variable dirlist [dirlist $w.filearea.dirs -width 250] ShortFileList $w.filearea.files -command [list $w.openbutton invoke] LongFileList $w.filearea.details -command [list $w.openbutton invoke] if {$pref(duopane)} { $w.filearea add $dirlist bind $w.filearea \ [list $w.filearea sashpos 0 [dict get $geometry sashpos]] bind $w.filearea +[list bind $w.filearea {}] } if {$pref(details)} { variable filelist $w.filearea.details } else { variable filelist $w.filearea.files } $w.filearea add $filelist grid $w.filearea - - -sticky nesw -padx 2 -pady 2 grid rowconfigure $w $w.filearea -weight 1 # Build the control area ttk::matchbox $w.fnent -textvariable [my varname text] -validate key \ -validatecommand [list [namespace which my] FileValidate %P] \ -matchcommand [list [namespace which my] FileMatchCommand] ttk::label $w.ftlab -anchor e -text [mc Filter]: ttk::matchbox $w.ftent -textvariable [my varname filter] ttk::button $w.openbutton -width 0 \ -command [list [namespace which my] Done] ttk::button $w.cancbutton -width 0 -text [mc Cancel] \ -command [list [namespace which my] Cancel] variable types [::tk::FDGetFileTypes $options(-filetypes)] if {[llength $types] == 0} { set options(-filetypes) [list [list [mc {All files}] *]] set types [::tk::FDGetFileTypes $options(-filetypes)] } $w.ftent configure -values [lmap n $types {lindex $n 0}] set select 0 if {$options(-typevariable) ne ""} { upvar #0 $options(-typevariable) type if {[info exists type]} { set select [lsearch -exact -index 0 $options(-filetypes) $type] if {$select < 0} {$w.ftent set $type} } } if {$select >= 0} {$w.ftent current $select} grid $w.fnlab $w.fnent $w.openbutton -sticky ew -padx 2 -pady 2 grid $w.ftlab $w.ftent $w.cancbutton -sticky ew -padx 2 grid columnconfigure $w $w.fnent -weight 1 if {$options(-title) ne ""} { wm title $w $options(-title) } else { wm title $w [mc $title] } $w.openbutton configure -text [mc $action] set cwd [file normalize $options(-initialdir)] if {![file isdirectory $cwd]} {set cwd [pwd]} $w.fnent set $options(-initialfile) my SelectFilter $w.ftent my Reconfigure variable trail [list $cwd] pos 0 my TrailPos $pos # Bindings bind $w.fnent [list $w.openbutton invoke] bind $w.fnent <> \ [list [namespace which my] SelectFile %W] bind $w.ftent <> \ [list [namespace which my] SelectFilter %W] bind $w.ftent <> \ [list [namespace which my] SelectFilter %W] bind $w.ftent <> \ [list [namespace which my] SelectFilter %W] bind $dirbox <> \ [namespace code {my ChangeDir [%W get]}] bind $dirbox <> \ [namespace code {my ChangeDir [%W get]}] bind $dirbox <> \ [namespace code {my ChangeDir [%W get]}] bind $dirlist <> \ [namespace code {my ChangeDir [%W get]}] bind $w.filearea.files <> \ [list after idle [list [namespace which my] ListBrowse 1]] bind $w.filearea.details <> \ [list [namespace which my] ListBrowse 2] bind $w.filearea.details <> \ [list [namespace which my] UpdateSortPrefs %W] } method ListBrowse {args} { my variable w cwd text filelist set list [$filelist selection] if {[llength $list] != 1} return set file [lindex $list 0] set path [joinfile $cwd $file] if {[file isdirectory $path]} { my ChangeDir $path } else { set text $file } } method ButtonUp {} { my variable cwd my ChangeDir [file dirname $cwd] } method ButtonPrev {} { my variable pos if {$pos > 0} { my TrailPos [incr pos -1] } } method ButtonNext {} { my variable trail pos if {$pos < [llength $trail] - 1} { my TrailPos [incr pos] } } method SelectFile {win} { my variable cwd text set file [joinfile $cwd [$win get]] if {[file isdir $file]} { my ChangeDir $file set text "" } else { $win validate } } method SelectFilter {win} { my variable w types filelist text set type [$win current] if {$type < 0} { set pat [$win get] } else { set pat [lindex $types $type 1] } $filelist configure -filter $pat set values [lsearch -all -inline [histfiles] $pat] $w.fnent configure -values $values my FileValidate $text } method ChangeDir {dir} { my variable cwd trail pos if {$cwd ne [next $dir]} { set trail [lrange $trail 0 $pos] lappend trail $cwd my TrailPos [incr pos] } } method TrailPos {index} { my variable cwd trail pos toolbar dirbox dirlist set pos $index $dirlist set [lindex $trail $pos] set cwd [$dirlist get] $dirbox set [file nativename $cwd] $dirbox icursor end $dirbox xview moveto 1 $dirbox validate if {[file dirname $cwd] ne $cwd} { $toolbar.up state !disabled } else { $toolbar.up state disabled } if {$pos > 0} { $toolbar.prev state !disabled } else { $toolbar.prev state disabled } if {$pos < [llength $trail] - 1} { $toolbar.next state !disabled } else { $toolbar.next state disabled } my ReloadDir } method ReloadDir {} { my variable w filelist cwd types try { next set type [$w.ftent current] if {$type < 0} { set pat [$w.ftent get] } else { set pat [lindex $types $type 1] } $filelist changedir $cwd my FileValidate [$w.fnent get] } trap POSIX {- err} { posixerror $w [dict get $err -errorcode] \ {Cannot change to the directory "%s"} $cwd } } method Reconfigure {} { my variable filelist pref if {$pref(duopane)} { set show files } elseif {$pref(mixed)} { set show mixed } else { set show split } $filelist configure -sortkey $pref(sort) -reverse $pref(reverse) \ -hidden $pref(hidden) -mixed $show preferences {*}[array get pref] } method Layout {} { my variable w pref dirlist filelist set panes [$w.filearea panes] if {$pref(duopane)} { if {$dirlist ni $panes} { $w.filearea insert 0 $dirlist $w.filearea sashpos 0 [geometry filedialog sashpos] } } else { if {$dirlist in $panes} { geometry filedialog sashpos [$w.filearea sashpos 0] $w.filearea forget $dirlist } } if {$pref(details)} { set newfilelist $w.filearea.details } else { set newfilelist $w.filearea.files } if {$newfilelist ne $filelist} { $filelist clear if {$filelist in $panes} { $w.filearea forget $filelist } set filelist $newfilelist my SelectFilter $w.ftent my Reconfigure $w.filearea add $filelist my ReloadDir } else { my Reconfigure } } method FileMatchCommand {str} { my variable cwd if {$str eq ""} return set esc [my GlobEscape $str] if {[file pathtype $str] eq "relative" || [string index $str 0] eq "~"} { set l [expr {[string length $cwd] + 1}] set list [lmap n [glob -nocomplain -dir $cwd -- $esc*] { string range $n $l end }] } else { set list [glob -nocomplain -- $esc*] } return [lsort -dictionary $list] } method FileValidate {str} { my variable cwd filelist if {$str ne "" && [file isfile [set file [joinfile $cwd $str]]]} { set file [file normalize $file] $filelist selection set [list $str] $filelist see $str } else { $filelist selection set {} } return true } method UpdateSortPrefs {w} { my variable pref set pref(sort) [$w cget -sortkey] set pref(reverse) [$w cget -reverse] preferences {*}[array get pref] } method Result {value {multiple 0}} { my variable w types result set result $value if {$multiple} {history {*}$value} else {history $value} if {$options(-typevariable) ne ""} { upvar #0 $options(-typevariable) pattern set type [$w.ftent current] if {$type < 0} { set pattern [$w.ftent get] } else { set pattern [lindex $options(-filetypes) $type 0] } } my Cancel } method Cancel {} { my variable w set geometry [lindex [split [wm geometry $w] +] 0] geometry filedialog geometry $geometry if {[llength [$w.filearea panes]] > 1} { geometry filedialog sashpos [$w.filearea sashpos 0] } my destroy } method Done {} { global answer my variable w options cwd text if {$text eq ""} return set file [file normalize [joinfile $cwd $text]] if {[file isdirectory $file]} { my ChangeDir $file $w.fnent set "" } else { if {$options(-confirmoverwrite)} { if {[file exists $file]} { $w.fnent set $text $w.fnent icursor end set answer [protect $w { tk_messageBox -type yesno -icon warning -parent $w \ -message [mc {File "%s" already exists.\ Do you want to overwrite it?} [file nativename $file]] }] if {$answer ne "yes"} return } } my Result $file } } } ::tk::Megawidget create ::ttk::fsdialog::getOpenFile \ ::ttk::fsdialog::getSaveFile { variable options method GetSpecs {} { set spec \ [lsearch -all -inline -exact -not -index 0 [next] -confirmoverwrite] return [linsert $spec end {-multiple "" "" "0"}] } method Create {} { next Open Open if {$options(-multiple)} { my variable w $w.filearea.files configure -multiple 1 $w.filearea.details configure -multiple 1 } } method FileSplit {str} { if {[string is list $str]} {return $str} set list {} foreach {l s} [split $str {"}] { lappend list {*}[split $l { }] $s } return $list } method FileValidate {str} { if {!$options(-multiple)} {return [next $str]} my variable filelist cwd set list [lmap n [my FileSplit $str] { set file [file normalize [joinfile $cwd $n]] if {[file dirname $file] ne $cwd} continue set name [file tail $file] if {![$filelist exists $name]} continue set name }] $filelist selection set $list return true } method ListBrowse {args} { if {!$options(-multiple)} {return [next]} my variable w cwd text filelist set sel [$filelist selection] set new {} set chg 0 set list [lmap n [my FileSplit $text] { set file [file normalize [joinfile $cwd $n]] if {[file dirname $file] eq $cwd} { regsub {^./} [file tail $file] {} name if {[$filelist exists $name]} { if {$name ni $sel} {set chg 1;continue} lappend new $name } } set n }] foreach file $sel { if {$file ni $new} {set chg 1;lappend list $file} } if {$chg} { set text $list $w.fnent icursor end } } method NormalizeFileList {} { if {$options(-multiple)} { my variable w cwd text set text [lmap n [my FileSplit $text] { set file [file normalize [joinfile $cwd $n]] if {[file exists $file]} { set file } else { set n } }] $w.fnent icursor end } } method ChangeDir {dir} { my variable cwd if {$dir ne $cwd} {my NormalizeFileList} next $dir } method TrailPos {index} { my variable cwd trail if {[lindex $trail $index] ne $cwd} {my NormalizeFileList} next $index } method Done {} { my variable w dir text if {$options(-multiple)} { set files [my FileSplit $text] if {[llength $files] == 0} return set missing {} set list [lmap s $files { set file [file normalize [joinfile $dir $s]] if {![file exists $file]} { lappend missing [mc {File "%s" does not exist.} \ [file nativename $file]] continue } set file }] if {[llength $missing]} { protect $w { tk_messageBox -type ok -icon warning -parent $w \ -message [join $missing \n] } } if {[llength $list]} { my Result $list 1 } } elseif {$text ne ""} { set file [file normalize [joinfile $dir $text]] if {[file isdirectory $file]} { my ChangeDir $file $w.fnent set "" } elseif {[file exists $file]} { my Result $file } else { $w.fnent set $text protect $w { tk_messageBox -type ok -icon warning -parent $w \ -message [mc {File "%s" does not exist.} \ [file nativename $file]] } } } } } namespace import -force ::ttk::fsdialog::* package provide fsdialog 2.0 fsdialog-97fa62c6a4/license.txt000064400000000000000000000013401363570464600160130ustar00nobodynobodyCopyright (c) 2006-2014, Schelte Bron Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. fsdialog-97fa62c6a4/matchbox.tcl000064400000000000000000000245611363570464600161530ustar00nobodynobody# A combobox widget with suggestions # Copyright (C) Schelte Bron. Freely redistributable. # Version 1.0 - 26 Nov 2017 namespace eval ::ttk::matchbox { # /usr/share/icons/oxygen/16x16/actions/edit-clear-locationbar-rtl.png variable clear [image create photo [namespace current]::clear -data { iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAMAAAAoLQ9TAAAAA3NCSVQICAjb4U/g AAAACXBIWXMAAAG7AAABuwE67OPiAAAAGXRFWHRTb2Z0d2FyZQB3d3cuaW5rc2Nh cGUub3Jnm+48GgAAATVQTFRF////AAAAOkI6AAAALDIsAAAAICAgAAAAFRUSAAAA BQUFPT48AAAAPT47Y2NjAAAAAQEBMDEvAgICJCUkAgICGBgXBAQEDQ0NAQEBAgIC BAQEBQUFBgYGBwcHCAgIDAwMDQ0NEBAQFBQTFBQUGRkZICAgISIhIiIiJycmLzAu MTExMjMxNzc3Ojo6PT47Pz8/QUFBQUI/REVDRUVFR0dHSkpKSktIS0tLTU5LTk5O Tk9NUFBQU1NTVFRUVlZVVldUWFlWWVlZW1tbZGRjZGZiZmhkaGhoampqamtncXFx dXV1eXl5enp6hISEhoaGioqKkJCQn5+frKysrq6usrKxt7i3wcHBxMXExsbGz9DP 1NTU3t7e4eHh5+fn6enp6urq7e3t8PDw8/Pz9PT0+vr6+/v7/Pz8dUr3qgAAABh0 Uk5TAB8fLi4/P1RUZWW4ysrU5eXl8PD4+P39CqmsmgAAAJ1JREFUGBmdwQMWAgEA BcCfbdu2bdt2W3v/I4Q9QO81A/yJLgpTBPhiyurjQb837LR9+GArijNiUh8R86Ib b1xVqrZ/3BcEecnZAfA10UyydHg8yVshYgQg8UdCweCUJJ9Tj1MLgKe2WG2Jw/V0 PeZ0OrxxlAb99rwpr887lx4fLLkjvszHKqtGwIAvhtSbrja7rWrWBApNaKaI8dsL XHIcGL0rDy8AAAAASUVORK5CYII= }] variable blank [image create photo [namespace current]::blank \ -width 16 -height 16] ttk::style element create clrbutton \ image [list $blank {!alternate !readonly !disabled} $clear] ttk::style layout TMatchbox { Combobox.field -sticky nswe -children { Combobox.downarrow -side right -sticky ns Combobox.padding -expand 1 -sticky nswe -children { clrbutton -side right Combobox.textarea -sticky nswe } } } ttk::style layout ClrTEntry { Entry.field -sticky nswe -children { Entry.padding -sticky nswe -children { clrbutton -side right Entry.textarea -sticky nswe } } } event add <> proc Motion {w x y} { $w instate {!readonly !disabled} { set elem [$w identify $x $y] if {$elem eq "textarea" || \ $elem eq "clrbutton" && [$w instate alternate]} { ttk::setCursor $w text return } } ttk::setCursor $w "" } proc Press {w x y} { if {[winfo exists $w.top] && [winfo ismapped $w.top]} { grab release $w wm withdraw $w.top return } set e [$w identify element $x $y] if {$e eq "clrbutton" && [$w instate {!disabled !readonly}]} { focus $w event generate $w <> } elseif {[winfo class $w] eq "TMatchbox"} { ::ttk::combobox::Press "" $w $x $y } else { ::ttk::entry::Press $w $x } } ::ttk::copyBindings TCombobox TMatchbox ::ttk::copyBindings TEntry ClrTEntry bind TMatchbox <> {%W delete 0 end} bind TMatchbox [list [namespace current]::Motion %W %x %y] bind TMatchbox <1> [list [namespace current]::Press %W %x %y] bind ClrTEntry <> {%W delete 0 end} bind ClrTEntry [list [namespace current]::Motion %W %x %y] bind ClrTEntry <1> [list [namespace current]::Press %W %x %y] option add *TMatchbox*Listbox.font TkTextFont option add *TMatchbox*Listbox.relief flat option add *TMatchbox*Listbox.highlightThickness 0 switch -- [tk windowingsystem] { x11 { option add *TMatchbox*Listbox.background white } aqua { option add *TMatchbox*Listbox.borderWidth 0 } } } ::tk::Megawidget create ::ttk::entrybox {} { method GetSpecs {} { my variable w if {![winfo exists $w]} { ttk::entry $w -class ClrTEntry -style ClrTEntry return [$w configure] } else { return [theWidget configure] } } method CreateHull {} { my variable w hull set hull $w } method Create {} { my variable w options $w configure {*}[dict remove [array get options] -class -style] my VarTrace my UpdateIcon } method VarTrace {{oldvar ""}} { my variable options set cmd [list [namespace which my] UpdateIcon] if {$oldvar ne ""} { trace remove variable $oldvar write $cmd } set var $options(-textvariable) if {$var ne ""} { trace add variable $var write $cmd } } method Update {} { my UpdateIcon } method UpdateIcon {{var {}} {arg {}} {op command}} { if {$op eq "command"} { set str [theWidget get] } else { upvar 1 $var str } if {[info exists str] && $str ne ""} { theWidget state !alternate } else { theWidget state alternate } } method configure {args} { my variable options set saved [array get options] set rc [next {*}$args] if {[llength $rc]} {return $rc} set opts [dict map {opt val} $args {set options($opt)}] if {[dict get $saved -textvariable] != $options(-textvariable)} { my VarTrace [dict get $saved -textvariable] } theWidget configure {*}[dict remove $opts -matchcommand -class -style] return } method delete {args} { set rc [theWidget delete {*}$args] my Update return $rc } method insert {index value} { set rc [theWidget insert $index $value] my Update return $rc } method set {value} { set disabled [theWidget state !disabled] theWidget delete 0 end set rc [theWidget insert end $value] theWidget state $disabled my UpdateIcon return $rc } forward bbox theWidget bbox forward current theWidget current forward get theWidget get forward icursor theWidget icursor forward identify theWidget identify forward index theWidget index forward instate theWidget instate forward selection theWidget selection forward state theWidget state forward validate theWidget validate forward xview theWidget xview } ::tk::Megawidget create ::ttk::matchbox ::ttk::entrybox { method GetSpecs {} { return { {-height height Height 10} {-postcommand postCommand PostCommand {}} {-values values Values {}} {-exportselection exportSelection ExportSelection 1} {-font font Font TkTextFont} {-invalidcommand invalidCommand InvalidCommand {}} {-justify justify Justify left} {-show show Show {}} {-state state State normal} {-textvariable textVariable Variable {}} {-validate validate Validate none} {-validatecommand validateCommand ValidateCommand {}} {-width width Width 20} {-xscrollcommand xScrollCommand ScrollCommand {}} {-foreground textColor TextColor {}} {-background windowColor WindowColor {}} {-takefocus takeFocus TakeFocus ttk::takefocus} {-cursor cursor Cursor {}} {-style style Style TMatchbox} {-class {} {} TMatchbox} {-matchcommand matchCommand MatchCommand {}} } } method CreateHull {} { my variable w hull options set opts [dict remove [array get options] -matchcommand] set hull [ttk::combobox $w {*}$opts] } method Create {} { my variable w listbox matchlist variable str set listbox [toplevel $w.top \ -relief solid -borderwidth 1 -background white] frame $listbox.wf listbox $listbox.lb -width 1 -exportselection 0 \ -selectforeground black -selectbackground #c2e0f5 \ -listvariable [namespace which -variable matchlist] \ -yscrollcommand [list $listbox.sb set] ttk::scrollbar $listbox.sb -command [list $listbox.lb yview] wm overrideredirect $listbox 1 grid $listbox.lb $listbox.sb -sticky ns grid $listbox.lb -sticky nesw -padx 0 grid $listbox.wf - -row 0 grid columnconfigure $listbox $listbox.lb -weight 1 wm withdraw $listbox bind $w [namespace code [list my Arrow down]] bind $w [namespace code [list my Arrow up]] bind $w [namespace code [list my Select]] bind $w [namespace code [list my Escape]] bind $listbox.lb [list $w configure -cursor ""] bind $listbox.lb <> [namespace code [list my Pick]] my VarTrace my UpdateIcon } method Update {} { my variable options matchlist listbox str set str [theWidget get] my UpdateIcon set cmd $options(-matchcommand) if {$cmd ne ""} { set matchlist [uplevel #0 [linsert $cmd end $str]] $listbox.lb selection clear 0 end set size [llength $matchlist] set exact [expr {$size == 1 && [lindex $matchlist 0] eq $str}] if {$size && !$exact} { if {$size > 15} { grid $listbox.sb $listbox.lb configure -height 15 } else { grid remove $listbox.sb $listbox.lb configure -height 0 } if {![winfo ismapped $listbox]} {my MapListBox} } else { if {[winfo ismapped $listbox]} {my UnmapListBox} } } } method MapListBox {} { my variable w listbox set x [expr {[winfo rootx $w] + 5}] set y [expr {[winfo rooty $w] + [winfo height $w] - 4}] set h [expr {[winfo reqheight $listbox.lb] + 2}] if {$y + $h > [winfo screenheight $w]} { set y [expr {[winfo rooty $w] - [winfo screenheight $w] + 4}] } set l [expr {[winfo width $w] - 2 - 10}] $listbox.wf configure -width $l $listbox.lb selection clear 0 end wm geometry $listbox [format {%+d%+d} $x $y] wm deiconify $listbox grab -global $w } method UnmapListBox {} { my variable w listbox wm withdraw $listbox grab release $w } method Arrow {dir} { my variable listbox if {![winfo ismapped $listbox]} return set sel [$listbox.lb curselection] if {[llength $sel] != 1} { set x -1 } else { set x [lindex $sel 0] } set size [$listbox.lb size] $listbox.lb selection clear $x if {$dir eq "down"} { if {[incr x] >= $size} {set x 0} } else { if {[incr x -1] < 0} {set x [expr {$size - 1}]} } $listbox.lb selection set $x $listbox.lb see $x theWidget set [$listbox.lb get $x] theWidget icursor end theWidget xview moveto 1 theWidget validate return -code break } method Select {} { my variable w str listbox if {[winfo ismapped $listbox]} { my UnmapListBox set str [theWidget get] event generate $w <> } else { event generate $w <> } } method Escape {} { my variable str my UnmapListBox theWidget set $str } method Pick {} { my variable w listbox str set str [lmap n [$listbox.lb curselection] {$listbox.lb get $n}] my UnmapListBox theWidget set $str theWidget icursor end theWidget xview moveto 1 theWidget validate } method selection {args} { # Ttk incorrectly overwrites the primary selection when the user # selects a combobox entry from the popdown list. if {[lindex [info level -1] 0] ne "SelectEntry"} { return [theWidget selection {*}$args] } } method set {value} { variable str $value set rc [theWidget set $value] my UpdateIcon my UnmapListBox return $rc } forward current theWidget current } package provide matchbox 1.0 fsdialog-97fa62c6a4/msgs000075500000000000000000000000001363570464600145245ustar00nobodynobodyfsdialog-97fa62c6a4/msgs/de.msg000064400000000000000000000032651363570464600157110ustar00nobodynobodynamespace eval ::ttk::fsdialog { ::msgcat::mcset de Open Öffnen ::msgcat::mcset de Save Speichern ::msgcat::mcset de {Save As} {Speichern unter} ::msgcat::mcset de Cancel Abbrechen ::msgcat::mcset de {All Files} {Alle Dateien} ::msgcat::mcset de Location Ort ::msgcat::mcset de Filter Dateityp ::msgcat::mcset de Name Name ::msgcat::mcset de Size Größe ::msgcat::mcset de Date Änderungsdatum ::msgcat::mcset de Permissions Berechtigungen ::msgcat::mcset de Owner Besitzer ::msgcat::mcset de Group Gruppe ::msgcat::mcset de Folder Ordner ::msgcat::mcset de Sorting Sortierung ::msgcat::mcset de Reverse Umgekehrt ::msgcat::mcset de {Short View} {Listenansicht} ::msgcat::mcset de {Detailed View} {Detailansicht} ::msgcat::mcset de {Show Hidden Files} {Verborgene Dateien anzeigen} ::msgcat::mcset de {Separate Folders} {Seitenleiste} ::msgcat::mcset de {By Name} {Nach Namen} ::msgcat::mcset de {By Date} {Nach Datum} ::msgcat::mcset de {By Size} {Nach Größe} ::msgcat::mcset de {Folders First} {Ordner zuerst} ::msgcat::mcset de {New Folder} {Neuer Ordner} ::msgcat::mcset de {Create new folder in} {Neuer Ordner erstellen in} ::msgcat::mcset de {File "%s" already exists. Do you want to overwrite it?} {Datei "%s" existiert bereits. Soll sie überschrieben werden?} ::msgcat::mcset de {File "%s" does not exist.} {Datei "%s" existiert nicht.} ::msgcat::mcset de {Cannot change to the directory "%s". Permission denied.} {Kann nicht in das Verzeichnis "%s" wechseln. Keine Berechtigung.} } fsdialog-97fa62c6a4/msgs/en.msg000064400000000000000000000021001363570464600157060ustar00nobodynobodynamespace eval ::ttk::fsdialog { ::msgcat::mcset en Open ::msgcat::mcset en Save ::msgcat::mcset en {Save As} ::msgcat::mcset en Cancel ::msgcat::mcset en Location ::msgcat::mcset en Filter ::msgcat::mcset en Name ::msgcat::mcset en Size ::msgcat::mcset en Date ::msgcat::mcset en Permissions ::msgcat::mcset en Owner ::msgcat::mcset en Group ::msgcat::mcset en Folder ::msgcat::mcset en Sorting ::msgcat::mcset en Reverse ::msgcat::mcset en {Short View} ::msgcat::mcset en {Detailed View} ::msgcat::mcset en {Show Hidden Files} ::msgcat::mcset en {Separate Folders} ::msgcat::mcset en {By Name} ::msgcat::mcset en {By Date} ::msgcat::mcset en {By Size} ::msgcat::mcset en {Folders First} ::msgcat::mcset en {New Folder} ::msgcat::mcset en {Create new folder in} ::msgcat::mcset en {File "%s" already exists. Do you want to overwrite it?} ::msgcat::mcset en {File "%s" does not exist.} ::msgcat::mcset en {Cannot change to the directory "%s". Permission denied.} } fsdialog-97fa62c6a4/msgs/pl.msg000064400000000000000000000033361363570464600157330ustar00nobodynobodynamespace eval ::ttk::fsdialog { ::msgcat::mcset pl Open {Otwórz} ::msgcat::mcset pl Save Zapisz ::msgcat::mcset pl {Save As} {Zapisz pod nazwą} ::msgcat::mcset pl Cancel Zaniechaj ::msgcat::mcset pl {All Files} {Wszystkie pliki} ::msgcat::mcset pl Clear Wyczyść ::msgcat::mcset pl Location Lokalizacja ::msgcat::mcset pl Filter {Rodzaj pliku} ::msgcat::mcset pl Name Nazwa ::msgcat::mcset pl Size Rozmiar ::msgcat::mcset pl Date {Data modyfikacji} ::msgcat::mcset pl Permissions {Prawa dostępu} ::msgcat::mcset pl Owner Właściciel ::msgcat::mcset pl Group Grupa ::msgcat::mcset pl Folder Katalog ::msgcat::mcset pl Sorting Sortowanie ::msgcat::mcset pl Reverse Odwrotnie ::msgcat::mcset pl {Short View} {Widok listy} ::msgcat::mcset pl {Detailed View} {Widok szczegółowy} ::msgcat::mcset pl {Show Hidden Files} {Pokaż ukryte pliki} ::msgcat::mcset pl {Separate Folders} {Katalogi osobno} ::msgcat::mcset pl {By Name} {Według nazwy} ::msgcat::mcset pl {By Date} {Według daty} ::msgcat::mcset pl {By Size} {Według rozmiaru} ::msgcat::mcset pl {Folders First} {Najpierw katalogi} ::msgcat::mcset pl {New Folder} {Nowy katalog} ::msgcat::mcset pl {Create new folder in} {Utwórz nowy katalog w} ::msgcat::mcset pl {File "%s" already exists. Do you want to overwrite it?} "Istnieje już plik o nazwie\n\"%s\"\nCzy przekasować ten plik?" ::msgcat::mcset pl {File "%s" does not exist.} "Nie stwierdzono obecności pliku o nazwie\n\"%s\"" ::msgcat::mcset pl {Cannot change to the directory "%s". Permission denied.} "Nie udało się przejść do katalogu\n\"%s\"\n(odmowa dostępu)" } fsdialog-97fa62c6a4/msgs/pt_br.msg000064400000000000000000000033511363570464600164230ustar00nobodynobody#(C) Carlos A. R. de Souza. Distributable under the ISC license. namespace eval ::ttk::fsdialog { ::msgcat::mcset pt_BR Open Abrir ::msgcat::mcset pt_BR Save Salvar ::msgcat::mcset pt_BR {Save As} {Salvar como} ::msgcat::mcset pt_BR Cancel Cancelar ::msgcat::mcset pt_BR {All Files} {Todos os Ficheiros} ::msgcat::mcset pt_BR Location Localização ::msgcat::mcset pt_BR Filter Filtro ::msgcat::mcset pt_BR Name Nome ::msgcat::mcset pt_BR Size Tamanho ::msgcat::mcset pt_BR Date Data ::msgcat::mcset pt_BR Permissions Permissões ::msgcat::mcset pt_BR Owner Dono ::msgcat::mcset pt_BR Group Grupo ::msgcat::mcset pt_BR Folder Pasta ::msgcat::mcset pt_BR Sorting Filtragem ::msgcat::mcset pt_BR Reverse {Ao contrário} ::msgcat::mcset pt_BR {Short View} {Visão resumida} ::msgcat::mcset pt_BR {Detailed View} {Visão detalhada} ::msgcat::mcset pt_BR {Show Hidden Files} {Mostrar arquivos ocultos} ::msgcat::mcset pt_BR {Separate Folders} {Separar pastas} ::msgcat::mcset pt_BR {By Name} {Por nome} ::msgcat::mcset pt_BR {By Date} {Por data} ::msgcat::mcset pt_BR {By Size} {Por tamanho} ::msgcat::mcset pt_BR {Folders First} {Pastas primeiro} ::msgcat::mcset pt_BR {New Folder} {Nova pasta} ::msgcat::mcset pt_BR {Create new folder in} {Criar nova pasta em} ::msgcat::mcset pt_BR {File "%s" already exists. Do you want to overwrite it?} \ {O arquivo "%s" já existe. Deseja sobreescrevê-lo?} ::msgcat::mcset pt_BR {File "%s" does not exist.} {O arquivo "%s" não existe} ::msgcat::mcset pt_BR {Cannot change to the directory "%s". Permission denied.} \ {Não é possível visualizar a pasta "%s". Permissão negada.} } fsdialog-97fa62c6a4/msgs/sv.msg000064400000000000000000000035311363570464600157450ustar00nobodynobodynamespace eval ::ttk::fsdialog { ::msgcat::mcset sv Open Öppna ::msgcat::mcset sv Save Spara ::msgcat::mcset sv {Save As} {Spara som} ::msgcat::mcset sv Cancel Avbryt ::msgcat::mcset sv {All Files} {Samtliga filer} ::msgcat::mcset sv Location Plats ::msgcat::mcset sv Filter Filter ::msgcat::mcset sv Name Namn ::msgcat::mcset sv Size Storlek ::msgcat::mcset sv Date Datum ::msgcat::mcset sv Permissions Behörigheter ::msgcat::mcset sv Owner Ägare ::msgcat::mcset sv Group Grupp ::msgcat::mcset sv Folder Mapp ::msgcat::mcset sv Sorting Sortering ::msgcat::mcset sv Reverse Omvänd ::msgcat::mcset sv {Short View} {Enkel vy} ::msgcat::mcset sv {Detailed View} {Detaljerad vy} ::msgcat::mcset sv {Show Hidden Files} {Visa dolda filer} ::msgcat::mcset sv {Separate Folders} {Mappar separat} ::msgcat::mcset sv {By Name} {Efter namn} ::msgcat::mcset sv {By Date} {Efter datum} ::msgcat::mcset sv {By Size} {Efter storlek} ::msgcat::mcset sv {Folders First} {Mappar först} ::msgcat::mcset sv {New Folder} {Ny mapp} ::msgcat::mcset sv {Create new folder in} {Skapa ny mapp i} ::msgcat::mcset sv {File "%s" already exists. Do you want to overwrite it?} {Filen "%s" finns redan. Vill du skriva över den?} ::msgcat::mcset sv {File "%s" does not exist.} {Filen "%s" finns ej.} ::msgcat::mcset sv {Cannot change to the directory "%s". Permission denied.} {Kan ej skifta till mappen "%s". Ej tillräcklig behörighet.} } fsdialog-97fa62c6a4/pkgIndex.tcl000064400000000000000000000002341363570464600161060ustar00nobodynobodypackage ifneeded fsdialog 2.0 \ [list source [file join $dir fsdialog.tcl]] package ifneeded matchbox 1.0 \ [list source [file join $dir matchbox.tcl]]