1  # tkfbox.tcl --
   2  #
   3  #	Implements the "TK" standard file selection dialog box.  This dialog
   4  #	box is used on the Unix platforms whenever the tk_strictMotif flag is
   5  #	not set.
   6  #
   7  #	The "TK" standard file selection dialog box is similar to the file
   8  #	selection dialog box on Win95(TM).  The user can navigate the
   9  #	directories by clicking on the folder icons or by selecting the
  10  #	"Directory" option menu.  The user can select files by clicking on the
  11  #	file icons or by entering a filename in the "Filename:" entry.
  12  #
  13  # Copyright (c) 1994-1998 Sun Microsystems, Inc.
  14  #
  15  # See the file "license.terms" for information on usage and redistribution
  16  # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  17  #
  18  
  19  namespace eval ::tk::dialog {}
  20  namespace eval ::tk::dialog::file {
  21      namespace import -force ::tk::msgcat::*
  22      variable showHiddenBtn 0
  23      variable showHiddenVar 1
  24  
  25      # Create the images if they did not already exist.
  26      if {![info exists ::tk::Priv(updirImage)]} {
  27  	set ::tk::Priv(updirImage) [image create photo -data {
  28  	    iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABmJLR0QA/gD+AP7rGN
  29  	    SCAAAACXBIWXMAAA3WAAAN1gGQb3mcAAAACXZwQWcAAAAWAAAAFgDcxelYAAAENUlE
  30  	    QVQ4y7WUbWiVZRjHf/f9POcc9+Kc5bC2aIq5sGG0XnTzNU13zAIlFMNc9CEhTCKwCC
  31  	    JIgt7AglaR0RcrolAKg14+GBbiGL6xZiYyy63cmzvu7MVznnOe537rw7bDyvlBoT/c
  32  	    n+6L3/3nf13XLZLJJP+HfICysjKvqqpq+rWKysvLR1tbW+11g+fPn/+bEGIe4KYqCs
  33  	    Owu66u7oG2trah6wJrrRc0NTVhjME5h7Vj5pxzCCE4duxYZUdHx/aGhoZmgJ+yb+wF
  34  	    uCO19RmAffv25f8LFslkktraWtvU1CS6u7vRWmOtxVpbAPu+T0tLS04pFU/J34Wd3S
  35  	    cdFtlfZWeZBU4IcaS5uXn1ZLAEMMY4ay1aa4wx/zpKKYIgoL6+vmjxqoXe5ZLTcsPq
  36  	    bTyycjODpe1y3WMrvDAMV14jCuW0VhhjiJQpOJ5w7Zwjk8/y9R+vsHHNNq6oFMrkeX
  37  	    BxI+8d2sktap3YvOPD0lRQrH+Z81fE7t3WB4gihVKazsuaA20aKSUgAG/seQdy2l6W
  38  	    37+EyopqTv39I6HJUT2zlnlza2jLdgiTaxwmDov6alLHcZUTzXPGGAauWJbfO4dHl9
  39  	    bgJs3HyfNf0N4ZsOa+jbT3/ownY/hO09p1kBULtjBw+Tvq7xzwauds4dWPDleAcP5E
  40  	    xlprgtBRUZRgYCRPTzoHwEi2g6OnX+eFrW/RM9qBE4p43CeTz5ATaU6nDrFm2cPs/+
  41  	    E1SopqkZ7MFJqntXZaa7IKppckwIEvJbg8LWd28OT6nVihCPQQ8UScWCLGqO4hXuQx
  42  	    qDtJ204eWrqWb1ufRspwtABWaqx5gRKUFSdwDnxPcuLcyyxbuIyaqntIBV34MY9YzC
  43  	    Owg+S9YeJFkniRpGPkCLMrZzG3+jbktA/KClMxFoUhiKC0OAbAhd79CO8i6xe/STyW
  44  	    4O7KVRgUJ/sP0heeJV4kEVKw/vZd40sFKxat4mLvp6VLdvnb/XHHGGPIKwBBpC1/9n
  45  	    3DpfRZnn9/AwCxRII9O79kVPdjvByxuET6Ai8mePeTt4lyheXzhOSpCcdWa00uckTG
  46  	    kckbGu76nEhbIm2xznH4VB3OWYaiXqQn8GKSWGIMHuXyPL76LBcupmhp69pz4uMnXi
  47  	    w4VloTGcdQRtGdzmHs1f+RdYZslMZJhzUOHVnceN1ooEiP5JUzdqCQMWCD0JCIeQzn
  48  	    NNpO+clhrCYf5rC+A2cxWmDUWG2oHEOZMEKIwclgMnnLrTeXUV7sUzpNXgU9DmijWV
  49  	    v9LEKCkAIhKIBnlvpks6F21qUZ31u/sbExPa9h0/RzwzMov2nGlG5TmW1YOzzlnSfL
  50  	    mVnyGf19Q7lwZHBp+1fPtflAIgiC7389n9qkihP+lWyeqfUO15ZwQTqlw9H+o2cOvN
  51  	    QJCAHEgEqgYnI0NyALjAJdyWQy7wMa6AEujUdzo3LjcAXwD/XCTKIRjWytAAAAJXRF
  52  	    WHRjcmVhdGUtZGF0ZQAyMDA5LTA0LTA2VDIxOjI1OjQxLTAzOjAw8s+uCAAAACV0RV
  53  	    h0bW9kaWZ5LWRhdGUAMjAwOC0wMS0wM1QxNTowODoyMS0wMjowMJEc/44AAAAZdEVY
  54  	    dFNvZnR3YXJlAHd3dy5pbmtzY2FwZS5vcmeb7jwaAAAAAElFTkSuQmCC
  55  	}]
  56      }
  57      if {![info exists ::tk::Priv(folderImage)]} {
  58  	set ::tk::Priv(folderImage) [image create photo -data {
  59  	    iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiA
  60  	    AAAAlwSFlzAAAN1wAADdcBQiibeAAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBl
  61  	    Lm9yZ5vuPBoAAAHCSURBVDiNpZAxa5NRFIafc+9XLCni4BC6FBycMnbrLpkcgtDVX6
  62  	    C70D/g4lZX/4coxLlgxFkpiiSSUGm/JiXfveee45AmNlhawXc53HvPee55X+l2u/yP
  63  	    qt3d3Tfu/viatwt3fzIYDI5uBJhZr9fr3TMzzAx3B+D09PR+v98/7HQ6z5fNOWdCCG
  64  	    U4HH6s67oAVDlnV1UmkwmllBUkhMD29nYHeLuEAkyn06qU8qqu64MrgIyqYmZrkHa7
  65  	    3drc3KTVahFjJITAaDRiPB4/XFlQVVMtHH5IzJo/P4EA4MyB+erWPQB7++zs7ccYvl
  66  	    U5Z08pMW2cl88eIXLZeDUpXzsBkNQ5eP1+p0opmaoCTgzw6fjs6gLLsp58FB60t0Dc
  67  	    K1Ul54yIEIMQ43Uj68pquDmCeJVztpwzuBNE2LgBoMVpslHMCUEAFgDVxQbzVAiA+a
  68  	    K5uGPmmDtZF3VpoUm2ArhqQaRiUjcMf81p1G60UEVhcjZfAFTVUkrgkS+jc06mDX9n
  69  	    vq4YhJ9nlxZExMwMEaHJRutOdWuIIsJFUoBSuTvHJ4YIfP46unV4qdlsjsBRZRtb/X
  70  	    fHd5+C8+P7+J8BIoxFwovfRxYhnhxjpzEAAAAASUVORK5CYII=
  71  	}]
  72      }
  73      if {![info exists ::tk::Priv(fileImage)]} {
  74  	set ::tk::Priv(fileImage)   [image create photo -data {
  75  	    iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gva
  76  	    eTAAAACXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QQWFA84umAmQgAAANpJREFU
  77  	    OMutkj1uhDAQhb8HSLtbISGfgZ+zbJkix0HmFhwhUdocBnMBGvqtTIqIFSReWKK8ai
  78  	    x73nwzHrVt+zEMwwvH9FrX9TsA1trpqKy10+yUzME4jnjvAZB0LzXHkojjmDRNVyh3
  79  	    A+89zrlVwlKSqKrqVy/J8lAUxSZBSMny4ZLgp54iyPM8UPHGNJ2IomibAKDv+9VlWZ
  80  	    bABbgB5/0WQgSSkC4PF2JF4JzbHN430c4vhAm0TyCJruuClefph4yCBCGT3T3Isoy/
  81  	    KDHGfDZNcz2SZIx547/0BVRRX7n8uT/sAAAAAElFTkSuQmCC
  82  	}]
  83      }
  84  }
  85  
  86  # ::tk::dialog::file:: --
  87  #
  88  #	Implements the TK file selection dialog.  This dialog is used when the
  89  #	tk_strictMotif flag is set to false.  This procedure shouldn't be
  90  #	called directly.  Call tk_getOpenFile or tk_getSaveFile instead.
  91  #
  92  # Arguments:
  93  #	type		"open" or "save"
  94  #	args		Options parsed by the procedure.
  95  #
  96  
  97  proc ::tk::dialog::file:: {type args} {
  98      variable ::tk::Priv
  99      variable showHiddenBtn
 100      set dataName __tk_filedialog
 101      upvar ::tk::dialog::file::$dataName data
 102  
 103      Config $dataName $type $args
 104  
 105      if {$data(-parent) eq "."} {
 106  	set w .$dataName
 107      } else {
 108  	set w $data(-parent).$dataName
 109      }
 110  
 111      # (re)create the dialog box if necessary
 112      #
 113      if {![winfo exists $w]} {
 114  	Create $w TkFDialog
 115      } elseif {[winfo class $w] ne "TkFDialog"} {
 116  	destroy $w
 117  	Create $w TkFDialog
 118      } else {
 119  	set data(dirMenuBtn) $w.contents.f1.menu
 120  	set data(dirMenu) $w.contents.f1.menu.menu
 121  	set data(upBtn) $w.contents.f1.up
 122  	set data(icons) $w.contents.icons
 123  	set data(ent) $w.contents.f2.ent
 124  	set data(typeMenuLab) $w.contents.f2.lab2
 125  	set data(typeMenuBtn) $w.contents.f2.menu
 126  	set data(typeMenu) $data(typeMenuBtn).m
 127  	set data(okBtn) $w.contents.f2.ok
 128  	set data(cancelBtn) $w.contents.f2.cancel
 129  	set data(hiddenBtn) $w.contents.f2.hidden
 130  	SetSelectMode $w $data(-multiple)
 131      }
 132      if {$showHiddenBtn} {
 133  	$data(hiddenBtn) configure -state normal
 134  	grid $data(hiddenBtn)
 135      } else {
 136  	$data(hiddenBtn) configure -state disabled
 137  	grid remove $data(hiddenBtn)
 138      }
 139  
 140      # Make sure subseqent uses of this dialog are independent [Bug 845189]
 141      unset -nocomplain data(extUsed)
 142  
 143      # Dialog boxes should be transient with respect to their parent, so that
 144      # they will always stay on top of their parent window.  However, some
 145      # window managers will create the window as withdrawn if the parent window
 146      # is withdrawn or iconified.  Combined with the grab we put on the window,
 147      # this can hang the entire application.  Therefore we only make the dialog
 148      # transient if the parent is viewable.
 149  
 150      if {[winfo viewable [winfo toplevel $data(-parent)]]} {
 151  	wm transient $w $data(-parent)
 152      }
 153  
 154      # Add traces on the selectPath variable
 155      #
 156  
 157      trace add variable data(selectPath) write \
 158  	    [list ::tk::dialog::file::SetPath $w]
 159      $data(dirMenuBtn) configure \
 160  	    -textvariable ::tk::dialog::file::${dataName}(selectPath)
 161  
 162      # Cleanup previous menu
 163      #
 164      $data(typeMenu) delete 0 end
 165      $data(typeMenuBtn) configure -state normal -text ""
 166  
 167      # Initialize the file types menu
 168      #
 169      if {[llength $data(-filetypes)]} {
 170  	# Default type and name to first entry
 171  	set initialtype     [lindex $data(-filetypes) 0]
 172  	set initialTypeName [lindex $initialtype 0]
 173  	if {$data(-typevariable) ne ""} {
 174  	    upvar #0 $data(-typevariable) typeVariable
 175  	    if {[info exists typeVariable]} {
 176  		set initialTypeName $typeVariable
 177  	    }
 178  	}
 179  	foreach type $data(-filetypes) {
 180  	    set title  [lindex $type 0]
 181  	    set filter [lindex $type 1]
 182  	    $data(typeMenu) add command -label $title \
 183  		-command [list ::tk::dialog::file::SetFilter $w $type]
 184  	    # [string first] avoids glob-pattern char issues
 185  	    if {[string first ${initialTypeName} $title] == 0} {
 186  		set initialtype $type
 187  	    }
 188  	}
 189  	SetFilter $w $initialtype
 190  	$data(typeMenuBtn) configure -state normal
 191  	$data(typeMenuLab) configure -state normal
 192      } else {
 193  	set data(filter) "*"
 194  	$data(typeMenuBtn) configure -state disabled -takefocus 0
 195  	$data(typeMenuLab) configure -state disabled
 196      }
 197      UpdateWhenIdle $w
 198  
 199      # Withdraw the window, then update all the geometry information
 200      # so we know how big it wants to be, then center the window in the
 201      # display (Motif style) and de-iconify it.
 202  
 203      ::tk::PlaceWindow $w widget $data(-parent)
 204      wm title $w $data(-title)
 205  
 206      # Set a grab and claim the focus too.
 207  
 208      ::tk::SetFocusGrab $w $data(ent)
 209      $data(ent) delete 0 end
 210      $data(ent) insert 0 $data(selectFile)
 211      $data(ent) selection range 0 end
 212      $data(ent) icursor end
 213  
 214      # Wait for the user to respond, then restore the focus and return the
 215      # index of the selected button.  Restore the focus before deleting the
 216      # window, since otherwise the window manager may take the focus away so we
 217      # can't redirect it.  Finally, restore any grab that was in effect.
 218  
 219      vwait ::tk::Priv(selectFilePath)
 220  
 221      ::tk::RestoreFocusGrab $w $data(ent) withdraw
 222  
 223      # Cleanup traces on selectPath variable
 224      #
 225  
 226      foreach trace [trace info variable data(selectPath)] {
 227  	trace remove variable data(selectPath) {*}$trace
 228      }
 229      $data(dirMenuBtn) configure -textvariable {}
 230  
 231      return $Priv(selectFilePath)
 232  }
 233  
 234  # ::tk::dialog::file::Config --
 235  #
 236  #	Configures the TK filedialog according to the argument list
 237  #
 238  proc ::tk::dialog::file::Config {dataName type argList} {
 239      upvar ::tk::dialog::file::$dataName data
 240  
 241      set data(type) $type
 242  
 243      # 0: Delete all variable that were set on data(selectPath) the
 244      # last time the file dialog is used. The traces may cause troubles
 245      # if the dialog is now used with a different -parent option.
 246  
 247      foreach trace [trace info variable data(selectPath)] {
 248  	trace remove variable data(selectPath) {*}$trace
 249      }
 250  
 251      # 1: the configuration specs
 252      #
 253      set specs {
 254  	{-defaultextension "" "" ""}
 255  	{-filetypes "" "" ""}
 256  	{-initialdir "" "" ""}
 257  	{-initialfile "" "" ""}
 258  	{-parent "" "" "."}
 259  	{-title "" "" ""}
 260  	{-typevariable "" "" ""}
 261      }
 262  
 263      # The "-multiple" option is only available for the "open" file dialog.
 264      #
 265      if {$type eq "open"} {
 266  	lappend specs {-multiple "" "" "0"}
 267      }
 268  
 269      # The "-confirmoverwrite" option is only for the "save" file dialog.
 270      #
 271      if {$type eq "save"} {
 272  	lappend specs {-confirmoverwrite "" "" "1"}
 273      }
 274  
 275      # 2: default values depending on the type of the dialog
 276      #
 277      if {![info exists data(selectPath)]} {
 278  	# first time the dialog has been popped up
 279  	set data(selectPath) [pwd]
 280  	set data(selectFile) ""
 281      }
 282  
 283      # 3: parse the arguments
 284      #
 285      tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
 286  
 287      if {$data(-title) eq ""} {
 288  	if {$type eq "open"} {
 289  	    set data(-title) [mc "Open"]
 290  	} else {
 291  	    set data(-title) [mc "Save As"]
 292  	}
 293      }
 294  
 295      # 4: set the default directory and selection according to the -initial
 296      #    settings
 297      #
 298      if {$data(-initialdir) ne ""} {
 299  	# Ensure that initialdir is an absolute path name.
 300  	if {[file isdirectory $data(-initialdir)]} {
 301  	    set old [pwd]
 302  	    cd $data(-initialdir)
 303  	    set data(selectPath) [pwd]
 304  	    cd $old
 305  	} else {
 306  	    set data(selectPath) [pwd]
 307  	}
 308      }
 309      set data(selectFile) $data(-initialfile)
 310  
 311      # 5. Parse the -filetypes option
 312      #
 313      set data(origfiletypes) $data(-filetypes)
 314      set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)]
 315  
 316      if {![winfo exists $data(-parent)]} {
 317  	return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \
 318  	    "bad window path name \"$data(-parent)\""
 319      }
 320  
 321      # Set -multiple to a one or zero value (not other boolean types like
 322      # "yes") so we can use it in tests more easily.
 323      if {$type eq "save"} {
 324  	set data(-multiple) 0
 325      } elseif {$data(-multiple)} {
 326  	set data(-multiple) 1
 327      } else {
 328  	set data(-multiple) 0
 329      }
 330  }
 331  
 332  proc ::tk::dialog::file::Create {w class} {
 333      set dataName [lindex [split $w .] end]
 334      upvar ::tk::dialog::file::$dataName data
 335      variable ::tk::Priv
 336      global tk_library
 337  
 338      toplevel $w -class $class
 339      if {[tk windowingsystem] eq "x11"} {wm attributes $w -type dialog}
 340      pack [ttk::frame $w.contents] -expand 1 -fill both
 341      #set w $w.contents
 342  
 343      # f1: the frame with the directory option menu
 344      #
 345      set f1 [ttk::frame $w.contents.f1]
 346      bind [::tk::AmpWidget ttk::label $f1.lab -text [mc "&Directory:"]] \
 347  	    <<AltUnderlined>> [list focus $f1.menu]
 348  
 349      set data(dirMenuBtn) $f1.menu
 350      if {![info exists data(selectPath)]} {
 351  	set data(selectPath) ""
 352      }
 353      set data(dirMenu) $f1.menu.menu
 354      ttk::menubutton $f1.menu -menu $data(dirMenu) -direction flush \
 355  	    -textvariable [format %s(selectPath) ::tk::dialog::file::$dataName]
 356      menu $data(dirMenu) -tearoff 0
 357      $data(dirMenu) add radiobutton -label "" -variable \
 358  	    [format %s(selectPath) ::tk::dialog::file::$dataName]
 359      set data(upBtn) [ttk::button $f1.up]
 360      $data(upBtn) configure -image $Priv(updirImage)
 361  
 362      $f1.menu configure -takefocus 1;# -highlightthickness 2
 363  
 364      pack $data(upBtn) -side right -padx 4 -fill both
 365      pack $f1.lab -side left -padx 4 -fill both
 366      pack $f1.menu -expand yes -fill both -padx 4
 367  
 368      # data(icons): the IconList that list the files and directories.
 369      #
 370      if {$class eq "TkFDialog"} {
 371  	if { $data(-multiple) } {
 372  	    set fNameCaption [mc "File &names:"]
 373  	} else {
 374  	    set fNameCaption [mc "File &name:"]
 375  	}
 376  	set fTypeCaption [mc "Files of &type:"]
 377  	set iconListCommand [list ::tk::dialog::file::OkCmd $w]
 378      } else {
 379  	set fNameCaption [mc "&Selection:"]
 380  	set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w]
 381      }
 382      set data(icons) [::tk::IconList $w.contents.icons \
 383  	    -command $iconListCommand -multiple $data(-multiple)]
 384      bind $data(icons) <<ListboxSelect>> \
 385  	    [list ::tk::dialog::file::ListBrowse $w]
 386  
 387      # f2: the frame with the OK button, cancel button, "file name" field
 388      #     and file types field.
 389      #
 390      set f2 [ttk::frame $w.contents.f2]
 391      bind [::tk::AmpWidget ttk::label $f2.lab -text $fNameCaption -anchor e]\
 392  	    <<AltUnderlined>> [list focus $f2.ent]
 393      # -pady 0
 394      set data(ent) [ttk::entry $f2.ent]
 395  
 396      # The font to use for the icons. The default Canvas font on Unix is just
 397      # deviant.
 398      set ::tk::$w.contents.icons(font) [$data(ent) cget -font]
 399  
 400      # Make the file types bits only if this is a File Dialog
 401      if {$class eq "TkFDialog"} {
 402  	set data(typeMenuLab) [::tk::AmpWidget ttk::label $f2.lab2 \
 403  		-text $fTypeCaption -anchor e]
 404  	# -pady [$f2.lab cget -pady]
 405  	set data(typeMenuBtn) [ttk::menubutton $f2.menu \
 406  		-menu $f2.menu.m]
 407  	# -indicatoron 1
 408  	set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]
 409  	# $data(typeMenuBtn) configure -takefocus 1 -relief raised -anchor w
 410  	bind $data(typeMenuLab) <<AltUnderlined>> [list \
 411  		focus $data(typeMenuBtn)]
 412      }
 413  
 414      # The hidden button is displayed when ::tk::dialog::file::showHiddenBtn is
 415      # true.  Create it disabled so the binding doesn't trigger if it isn't
 416      # shown.
 417      if {$class eq "TkFDialog"} {
 418  	set text [mc "Show &Hidden Files and Directories"]
 419      } else {
 420  	set text [mc "Show &Hidden Directories"]
 421      }
 422      set data(hiddenBtn) [::tk::AmpWidget ttk::checkbutton $f2.hidden \
 423  	    -text $text -state disabled \
 424  	    -variable ::tk::dialog::file::showHiddenVar \
 425  	    -command [list ::tk::dialog::file::UpdateWhenIdle $w]]
 426  # -anchor w -padx 3
 427  
 428      # the okBtn is created after the typeMenu so that the keyboard traversal
 429      # is in the right order, and add binding so that we find out when the
 430      # dialog is destroyed by the user (added here instead of to the overall
 431      # window so no confusion about how much <Destroy> gets called; exactly
 432      # once will do). [Bug 987169]
 433  
 434      set data(okBtn)     [::tk::AmpWidget ttk::button $f2.ok \
 435  	    -text [mc "&OK"]     -default active];# -pady 3]
 436      bind $data(okBtn) <Destroy> [list ::tk::dialog::file::Destroyed $w]
 437      set data(cancelBtn) [::tk::AmpWidget ttk::button $f2.cancel \
 438  	    -text [mc "&Cancel"] -default normal];# -pady 3]
 439  
 440      # grid the widgets in f2
 441      #
 442      grid $f2.lab $f2.ent $data(okBtn) -padx 4 -pady 3 -sticky ew
 443      grid configure $f2.ent -padx 2
 444      if {$class eq "TkFDialog"} {
 445  	grid $data(typeMenuLab) $data(typeMenuBtn) $data(cancelBtn) \
 446  		-padx 4 -sticky ew
 447  	grid configure $data(typeMenuBtn) -padx 0
 448  	grid $data(hiddenBtn) -columnspan 2 -padx 4 -sticky ew
 449      } else {
 450  	grid $data(hiddenBtn) - $data(cancelBtn) -padx 4 -sticky ew
 451      }
 452      grid columnconfigure $f2 1 -weight 1
 453  
 454      # Pack all the frames together. We are done with widget construction.
 455      #
 456      pack $f1 -side top -fill x -pady 4
 457      pack $f2 -side bottom -pady 4 -fill x
 458      pack $data(icons) -expand yes -fill both -padx 4 -pady 1
 459  
 460      # Set up the event handlers that are common to Directory and File Dialogs
 461      #
 462  
 463      wm protocol $w WM_DELETE_WINDOW [list ::tk::dialog::file::CancelCmd $w]
 464      $data(upBtn)     configure -command [list ::tk::dialog::file::UpDirCmd $w]
 465      $data(cancelBtn) configure -command [list ::tk::dialog::file::CancelCmd $w]
 466      bind $w <KeyPress-Escape> [list $data(cancelBtn) invoke]
 467      bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A]
 468  
 469      # Set up event handlers specific to File or Directory Dialogs
 470      #
 471      if {$class eq "TkFDialog"} {
 472  	bind $data(ent) <Return> [list ::tk::dialog::file::ActivateEnt $w]
 473  	$data(okBtn)     configure -command [list ::tk::dialog::file::OkCmd $w]
 474  	bind $w <Alt-t> [format {
 475  	    if {[%s cget -state] eq "normal"} {
 476  		focus %s
 477  	    }
 478  	} $data(typeMenuBtn) $data(typeMenuBtn)]
 479      } else {
 480  	set okCmd [list ::tk::dialog::file::chooseDir::OkCmd $w]
 481  	bind $data(ent) <Return> $okCmd
 482  	$data(okBtn) configure -command $okCmd
 483  	bind $w <Alt-s> [list focus $data(ent)]
 484  	bind $w <Alt-o> [list $data(okBtn) invoke]
 485      }
 486      bind $w <Alt-h> [list $data(hiddenBtn) invoke]
 487      bind $data(ent) <Tab> [list ::tk::dialog::file::CompleteEnt $w]
 488  
 489      # Build the focus group for all the entries
 490      #
 491      ::tk::FocusGroup_Create $w
 492      ::tk::FocusGroup_BindIn $w  $data(ent) [list \
 493  	    ::tk::dialog::file::EntFocusIn $w]
 494      ::tk::FocusGroup_BindOut $w $data(ent) [list \
 495  	    ::tk::dialog::file::EntFocusOut $w]
 496  }
 497  
 498  # ::tk::dialog::file::SetSelectMode --
 499  #
 500  #	Set the select mode of the dialog to single select or multi-select.
 501  #
 502  # Arguments:
 503  #	w		The dialog path.
 504  #	multi		1 if the dialog is multi-select; 0 otherwise.
 505  #
 506  # Results:
 507  #	None.
 508  
 509  proc ::tk::dialog::file::SetSelectMode {w multi} {
 510      set dataName __tk_filedialog
 511      upvar ::tk::dialog::file::$dataName data
 512      if { $multi } {
 513  	set fNameCaption [mc "File &names:"]
 514      } else {
 515  	set fNameCaption [mc "File &name:"]
 516      }
 517      set iconListCommand [list ::tk::dialog::file::OkCmd $w]
 518      ::tk::SetAmpText $w.contents.f2.lab $fNameCaption
 519      $data(icons) configure -multiple $multi -command $iconListCommand
 520      return
 521  }
 522  
 523  # ::tk::dialog::file::UpdateWhenIdle --
 524  #
 525  #	Creates an idle event handler which updates the dialog in idle time.
 526  #	This is important because loading the directory may take a long time
 527  #	and we don't want to load the same directory for multiple times due to
 528  #	multiple concurrent events.
 529  #
 530  proc ::tk::dialog::file::UpdateWhenIdle {w} {
 531      upvar ::tk::dialog::file::[winfo name $w] data
 532  
 533      if {[info exists data(updateId)]} {
 534  	return
 535      }
 536      set data(updateId) [after idle [list ::tk::dialog::file::Update $w]]
 537  }
 538  
 539  # ::tk::dialog::file::Update --
 540  #
 541  #	Loads the files and directories into the IconList widget. Also sets up
 542  #	the directory option menu for quick access to parent directories.
 543  #
 544  proc ::tk::dialog::file::Update {w} {
 545      # This proc may be called within an idle handler. Make sure that the
 546      # window has not been destroyed before this proc is called
 547      if {![winfo exists $w]} {
 548  	return
 549      }
 550      set class [winfo class $w]
 551      if {($class ne "TkFDialog") && ($class ne "TkChooseDir")} {
 552  	return
 553      }
 554  
 555      set dataName [winfo name $w]
 556      upvar ::tk::dialog::file::$dataName data
 557      variable ::tk::Priv
 558      variable showHiddenVar
 559      global tk_library
 560      unset -nocomplain data(updateId)
 561  
 562      set folder $Priv(folderImage)
 563      set file   $Priv(fileImage)
 564  
 565      set appPWD [pwd]
 566      if {[catch {
 567  	cd $data(selectPath)
 568      }]} then {
 569  	# We cannot change directory to $data(selectPath). $data(selectPath)
 570  	# should have been checked before ::tk::dialog::file::Update is
 571  	# called, so we normally won't come to here. Anyways, give an error
 572  	# and abort action.
 573  	tk_messageBox -type ok -parent $w -icon warning -message [mc \
 574  	       "Cannot change to the directory \"%1\$s\".\nPermission denied."\
 575  		$data(selectPath)]
 576  	cd $appPWD
 577  	return
 578      }
 579  
 580      # Turn on the busy cursor. BUG?? We haven't disabled X events, though,
 581      # so the user may still click and cause havoc ...
 582      #
 583      set entCursor [$data(ent) cget -cursor]
 584      set dlgCursor [$w         cget -cursor]
 585      $data(ent) configure -cursor watch
 586      $w         configure -cursor watch
 587      update idletasks
 588  
 589      $data(icons) deleteall
 590  
 591      set showHidden $showHiddenVar
 592  
 593      # Make the dir list. Note that using an explicit [pwd] (instead of '.') is
 594      # better in some VFS cases.
 595      $data(icons) add $folder [GlobFiltered [pwd] d 1]
 596  
 597      if {$class eq "TkFDialog"} {
 598  	# Make the file list if this is a File Dialog, selecting all but
 599  	# 'd'irectory type files.
 600  	#
 601  	$data(icons) add $file [GlobFiltered [pwd] {f b c l p s}]
 602      }
 603  
 604      # Update the Directory: option menu
 605      #
 606      set list ""
 607      set dir ""
 608      foreach subdir [file split $data(selectPath)] {
 609  	set dir [file join $dir $subdir]
 610  	lappend list $dir
 611      }
 612  
 613      $data(dirMenu) delete 0 end
 614      set var [format %s(selectPath) ::tk::dialog::file::$dataName]
 615      foreach path $list {
 616  	$data(dirMenu) add command -label $path -command [list set $var $path]
 617      }
 618  
 619      # Restore the PWD to the application's PWD
 620      #
 621      cd $appPWD
 622  
 623      if {$class eq "TkFDialog"} {
 624  	# Restore the Open/Save Button if this is a File Dialog
 625  	#
 626  	if {$data(type) eq "open"} {
 627  	    ::tk::SetAmpText $data(okBtn) [mc "&Open"]
 628  	} else {
 629  	    ::tk::SetAmpText $data(okBtn) [mc "&Save"]
 630  	}
 631      }
 632  
 633      # turn off the busy cursor.
 634      #
 635      $data(ent) configure -cursor $entCursor
 636      $w         configure -cursor $dlgCursor
 637  }
 638  
 639  # ::tk::dialog::file::SetPathSilently --
 640  #
 641  # 	Sets data(selectPath) without invoking the trace procedure
 642  #
 643  proc ::tk::dialog::file::SetPathSilently {w path} {
 644      upvar ::tk::dialog::file::[winfo name $w] data
 645  
 646      set cb [list ::tk::dialog::file::SetPath $w]
 647      trace remove variable data(selectPath) write $cb
 648      set data(selectPath) $path
 649      trace add variable data(selectPath) write $cb
 650  }
 651  
 652  
 653  # This proc gets called whenever data(selectPath) is set
 654  #
 655  proc ::tk::dialog::file::SetPath {w name1 name2 op} {
 656      if {[winfo exists $w]} {
 657  	upvar ::tk::dialog::file::[winfo name $w] data
 658  	UpdateWhenIdle $w
 659  	# On directory dialogs, we keep the entry in sync with the currentdir.
 660  	if {[winfo class $w] eq "TkChooseDir"} {
 661  	    $data(ent) delete 0 end
 662  	    $data(ent) insert end $data(selectPath)
 663  	}
 664      }
 665  }
 666  
 667  # This proc gets called whenever data(filter) is set
 668  #
 669  proc ::tk::dialog::file::SetFilter {w type} {
 670      upvar ::tk::dialog::file::[winfo name $w] data
 671  
 672      set data(filterType) $type
 673      set data(filter) [lindex $type 1]
 674      $data(typeMenuBtn) configure -text [lindex $type 0] ;#-indicatoron 1
 675  
 676      # If we aren't using a default extension, use the one suppled by the
 677      # filter.
 678      if {![info exists data(extUsed)]} {
 679  	if {[string length $data(-defaultextension)]} {
 680  	    set data(extUsed) 1
 681  	} else {
 682  	    set data(extUsed) 0
 683  	}
 684      }
 685  
 686      if {!$data(extUsed)} {
 687  	# Get the first extension in the list that matches {^\*\.\w+$} and
 688  	# remove all * from the filter.
 689  	set index [lsearch -regexp $data(filter) {^\*\.\w+$}]
 690  	if {$index >= 0} {
 691  	    set data(-defaultextension) \
 692  		    [string trimleft [lindex $data(filter) $index] "*"]
 693  	} else {
 694  	    # Couldn't find anything!  Reset to a safe default...
 695  	    set data(-defaultextension) ""
 696  	}
 697      }
 698  
 699      $data(icons) see 0
 700  
 701      UpdateWhenIdle $w
 702  }
 703  
 704  # tk::dialog::file::ResolveFile --
 705  #
 706  #	Interpret the user's text input in a file selection dialog.  Performs:
 707  #
 708  #	(1) ~ substitution
 709  #	(2) resolve all instances of . and ..
 710  #	(3) check for non-existent files/directories
 711  #	(4) check for chdir permissions
 712  #	(5) conversion of environment variable references to their
 713  #	    contents (once only)
 714  #
 715  # Arguments:
 716  #	context:  the current directory you are in
 717  #	text:	  the text entered by the user
 718  #	defaultext: the default extension to add to files with no extension
 719  #	expandEnv: whether to expand environment variables (yes by default)
 720  #
 721  # Return vaue:
 722  #	[list $flag $directory $file]
 723  #
 724  #	 flag = OK	: valid input
 725  #	      = PATTERN	: valid directory/pattern
 726  #	      = PATH	: the directory does not exist
 727  #	      = FILE	: the directory exists by the file doesn't exist
 728  #	      = CHDIR	: Cannot change to the directory
 729  #	      = ERROR	: Invalid entry
 730  #
 731  #	 directory      : valid only if flag = OK or PATTERN or FILE
 732  #	 file           : valid only if flag = OK or PATTERN
 733  #
 734  #	directory may not be the same as context, because text may contain a
 735  #	subdirectory name
 736  #
 737  proc ::tk::dialog::file::ResolveFile {context text defaultext {expandEnv 1}} {
 738      set appPWD [pwd]
 739  
 740      set path [JoinFile $context $text]
 741  
 742      # If the file has no extension, append the default.  Be careful not to do
 743      # this for directories, otherwise typing a dirname in the box will give
 744      # back "dirname.extension" instead of trying to change dir.
 745      if {
 746  	![file isdirectory $path] && ([file ext $path] eq "") &&
 747  	![string match {$*} [file tail $path]]
 748      } then {
 749  	set path "$path$defaultext"
 750      }
 751  
 752      if {[catch {file exists $path}]} {
 753  	# This "if" block can be safely removed if the following code stop
 754  	# generating errors.
 755  	#
 756  	#	file exists ~nonsuchuser
 757  	#
 758  	return [list ERROR $path ""]
 759      }
 760  
 761      if {[file exists $path]} {
 762  	if {[file isdirectory $path]} {
 763  	    if {[catch {cd $path}]} {
 764  		return [list CHDIR $path ""]
 765  	    }
 766  	    set directory [pwd]
 767  	    set file ""
 768  	    set flag OK
 769  	    cd $appPWD
 770  	} else {
 771  	    if {[catch {cd [file dirname $path]}]} {
 772  		return [list CHDIR [file dirname $path] ""]
 773  	    }
 774  	    set directory [pwd]
 775  	    set file [file tail $path]
 776  	    set flag OK
 777  	    cd $appPWD
 778  	}
 779      } else {
 780  	set dirname [file dirname $path]
 781  	if {[file exists $dirname]} {
 782  	    if {[catch {cd $dirname}]} {
 783  		return [list CHDIR $dirname ""]
 784  	    }
 785  	    set directory [pwd]
 786  	    cd $appPWD
 787  	    set file [file tail $path]
 788  	    # It's nothing else, so check to see if it is an env-reference
 789  	    if {$expandEnv && [string match {$*} $file]} {
 790  		set var [string range $file 1 end]
 791  		if {[info exist ::env($var)]} {
 792  		    return [ResolveFile $context $::env($var) $defaultext 0]
 793  		}
 794  	    }
 795  	    if {[regexp {[*?]} $file]} {
 796  		set flag PATTERN
 797  	    } else {
 798  		set flag FILE
 799  	    }
 800  	} else {
 801  	    set directory $dirname
 802  	    set file [file tail $path]
 803  	    set flag PATH
 804  	    # It's nothing else, so check to see if it is an env-reference
 805  	    if {$expandEnv && [string match {$*} $file]} {
 806  		set var [string range $file 1 end]
 807  		if {[info exist ::env($var)]} {
 808  		    return [ResolveFile $context $::env($var) $defaultext 0]
 809  		}
 810  	    }
 811  	}
 812      }
 813  
 814      return [list $flag $directory $file]
 815  }
 816  
 817  
 818  # Gets called when the entry box gets keyboard focus. We clear the selection
 819  # from the icon list . This way the user can be certain that the input in the
 820  # entry box is the selection.
 821  #
 822  proc ::tk::dialog::file::EntFocusIn {w} {
 823      upvar ::tk::dialog::file::[winfo name $w] data
 824  
 825      if {[$data(ent) get] ne ""} {
 826  	$data(ent) selection range 0 end
 827  	$data(ent) icursor end
 828      } else {
 829  	$data(ent) selection clear
 830      }
 831  
 832      if {[winfo class $w] eq "TkFDialog"} {
 833  	# If this is a File Dialog, make sure the buttons are labeled right.
 834  	if {$data(type) eq "open"} {
 835  	    ::tk::SetAmpText $data(okBtn) [mc "&Open"]
 836  	} else {
 837  	    ::tk::SetAmpText $data(okBtn) [mc "&Save"]
 838  	}
 839      }
 840  }
 841  
 842  proc ::tk::dialog::file::EntFocusOut {w} {
 843      upvar ::tk::dialog::file::[winfo name $w] data
 844  
 845      $data(ent) selection clear
 846  }
 847  
 848  
 849  # Gets called when user presses Return in the "File name" entry.
 850  #
 851  proc ::tk::dialog::file::ActivateEnt {w} {
 852      upvar ::tk::dialog::file::[winfo name $w] data
 853  
 854      set text [$data(ent) get]
 855      if {$data(-multiple)} {
 856  	foreach t $text {
 857  	    VerifyFileName $w $t
 858  	}
 859      } else {
 860  	VerifyFileName $w $text
 861      }
 862  }
 863  
 864  # Verification procedure
 865  #
 866  proc ::tk::dialog::file::VerifyFileName {w filename} {
 867      upvar ::tk::dialog::file::[winfo name $w] data
 868  
 869      set list [ResolveFile $data(selectPath) $filename $data(-defaultextension)]
 870      foreach {flag path file} $list {
 871  	break
 872      }
 873  
 874      switch -- $flag {
 875  	OK {
 876  	    if {$file eq ""} {
 877  		# user has entered an existing (sub)directory
 878  		set data(selectPath) $path
 879  		$data(ent) delete 0 end
 880  	    } else {
 881  		SetPathSilently $w $path
 882  		if {$data(-multiple)} {
 883  		    lappend data(selectFile) $file
 884  		} else {
 885  		    set data(selectFile) $file
 886  		}
 887  		Done $w
 888  	    }
 889  	}
 890  	PATTERN {
 891  	    set data(selectPath) $path
 892  	    set data(filter) $file
 893  	}
 894  	FILE {
 895  	    if {$data(type) eq "open"} {
 896  		tk_messageBox -icon warning -type ok -parent $w \
 897  			-message [mc "File \"%1\$s\"  does not exist." \
 898  			[file join $path $file]]
 899  		$data(ent) selection range 0 end
 900  		$data(ent) icursor end
 901  	    } else {
 902  		SetPathSilently $w $path
 903  		if {$data(-multiple)} {
 904  		    lappend data(selectFile) $file
 905  		} else {
 906  		    set data(selectFile) $file
 907  		}
 908  		Done $w
 909  	    }
 910  	}
 911  	PATH {
 912  	    tk_messageBox -icon warning -type ok -parent $w \
 913  		    -message [mc "Directory \"%1\$s\" does not exist." $path]
 914  	    $data(ent) selection range 0 end
 915  	    $data(ent) icursor end
 916  	}
 917  	CHDIR {
 918  	    tk_messageBox -type ok -parent $w -icon warning -message  \
 919  		[mc "Cannot change to the directory\
 920                       \"%1\$s\".\nPermission denied." $path]
 921  	    $data(ent) selection range 0 end
 922  	    $data(ent) icursor end
 923  	}
 924  	ERROR {
 925  	    tk_messageBox -type ok -parent $w -icon warning -message \
 926  		    [mc "Invalid file name \"%1\$s\"." $path]
 927  	    $data(ent) selection range 0 end
 928  	    $data(ent) icursor end
 929  	}
 930      }
 931  }
 932  
 933  # Gets called when user presses the Alt-s or Alt-o keys.
 934  #
 935  proc ::tk::dialog::file::InvokeBtn {w key} {
 936      upvar ::tk::dialog::file::[winfo name $w] data
 937  
 938      if {[$data(okBtn) cget -text] eq $key} {
 939  	$data(okBtn) invoke
 940      }
 941  }
 942  
 943  # Gets called when user presses the "parent directory" button
 944  #
 945  proc ::tk::dialog::file::UpDirCmd {w} {
 946      upvar ::tk::dialog::file::[winfo name $w] data
 947  
 948      if {$data(selectPath) ne "/"} {
 949  	set data(selectPath) [file dirname $data(selectPath)]
 950      }
 951  }
 952  
 953  # Join a file name to a path name. The "file join" command will break if the
 954  # filename begins with ~
 955  #
 956  proc ::tk::dialog::file::JoinFile {path file} {
 957      if {[string match {~*} $file] && [file exists $path/$file]} {
 958  	return [file join $path ./$file]
 959      } else {
 960  	return [file join $path $file]
 961      }
 962  }
 963  
 964  # Gets called when user presses the "OK" button
 965  #
 966  proc ::tk::dialog::file::OkCmd {w} {
 967      upvar ::tk::dialog::file::[winfo name $w] data
 968  
 969      set filenames {}
 970      foreach item [$data(icons) selection get] {
 971  	lappend filenames [$data(icons) get $item]
 972      }
 973  
 974      if {
 975  	([llength $filenames] && !$data(-multiple)) ||
 976  	($data(-multiple) && ([llength $filenames] == 1))
 977      } then {
 978  	set filename [lindex $filenames 0]
 979  	set file [JoinFile $data(selectPath) $filename]
 980  	if {[file isdirectory $file]} {
 981  	    ListInvoke $w [list $filename]
 982  	    return
 983  	}
 984      }
 985  
 986      ActivateEnt $w
 987  }
 988  
 989  # Gets called when user presses the "Cancel" button
 990  #
 991  proc ::tk::dialog::file::CancelCmd {w} {
 992      upvar ::tk::dialog::file::[winfo name $w] data
 993      variable ::tk::Priv
 994  
 995      bind $data(okBtn) <Destroy> {}
 996      set Priv(selectFilePath) ""
 997  }
 998  
 999  # Gets called when user destroys the dialog directly [Bug 987169]
1000  #
1001  proc ::tk::dialog::file::Destroyed {w} {
1002      upvar ::tk::dialog::file::[winfo name $w] data
1003      variable ::tk::Priv
1004  
1005      set Priv(selectFilePath) ""
1006  }
1007  
1008  # Gets called when user browses the IconList widget (dragging mouse, arrow
1009  # keys, etc)
1010  #
1011  proc ::tk::dialog::file::ListBrowse {w} {
1012      upvar ::tk::dialog::file::[winfo name $w] data
1013  
1014      set text {}
1015      foreach item [$data(icons) selection get] {
1016  	lappend text [$data(icons) get $item]
1017      }
1018      if {[llength $text] == 0} {
1019  	return
1020      }
1021      if {$data(-multiple)} {
1022  	set newtext {}
1023  	foreach file $text {
1024  	    set fullfile [JoinFile $data(selectPath) $file]
1025  	    if { ![file isdirectory $fullfile] } {
1026  		lappend newtext $file
1027  	    }
1028  	}
1029  	set text $newtext
1030  	set isDir 0
1031      } else {
1032  	set text [lindex $text 0]
1033  	set file [JoinFile $data(selectPath) $text]
1034  	set isDir [file isdirectory $file]
1035      }
1036      if {!$isDir} {
1037  	$data(ent) delete 0 end
1038  	$data(ent) insert 0 $text
1039  
1040  	if {[winfo class $w] eq "TkFDialog"} {
1041  	    if {$data(type) eq "open"} {
1042  		::tk::SetAmpText $data(okBtn) [mc "&Open"]
1043  	    } else {
1044  		::tk::SetAmpText $data(okBtn) [mc "&Save"]
1045  	    }
1046  	}
1047      } elseif {[winfo class $w] eq "TkFDialog"} {
1048  	::tk::SetAmpText $data(okBtn) [mc "&Open"]
1049      }
1050  }
1051  
1052  # Gets called when user invokes the IconList widget (double-click, Return key,
1053  # etc)
1054  #
1055  proc ::tk::dialog::file::ListInvoke {w filenames} {
1056      upvar ::tk::dialog::file::[winfo name $w] data
1057  
1058      if {[llength $filenames] == 0} {
1059  	return
1060      }
1061  
1062      set file [JoinFile $data(selectPath) [lindex $filenames 0]]
1063  
1064      set class [winfo class $w]
1065      if {$class eq "TkChooseDir" || [file isdirectory $file]} {
1066  	set appPWD [pwd]
1067  	if {[catch {cd $file}]} {
1068  	    tk_messageBox -type ok -parent $w -icon warning -message \
1069  		    [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $file]
1070  	} else {
1071  	    cd $appPWD
1072  	    set data(selectPath) $file
1073  	}
1074      } else {
1075  	if {$data(-multiple)} {
1076  	    set data(selectFile) $filenames
1077  	} else {
1078  	    set data(selectFile) $file
1079  	}
1080  	Done $w
1081      }
1082  }
1083  
1084  # ::tk::dialog::file::Done --
1085  #
1086  #	Gets called when user has input a valid filename.  Pops up a dialog
1087  #	box to confirm selection when necessary.  Sets the
1088  #	tk::Priv(selectFilePath) variable, which will break the "vwait" loop
1089  #	in ::tk::dialog::file:: and return the selected filename to the script
1090  #	that calls tk_getOpenFile or tk_getSaveFile
1091  #
1092  proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
1093      upvar ::tk::dialog::file::[winfo name $w] data
1094      variable ::tk::Priv
1095  
1096      if {$selectFilePath eq ""} {
1097  	if {$data(-multiple)} {
1098  	    set selectFilePath {}
1099  	    foreach f $data(selectFile) {
1100  		lappend selectFilePath [JoinFile $data(selectPath) $f]
1101  	    }
1102  	} else {
1103  	    set selectFilePath [JoinFile $data(selectPath) $data(selectFile)]
1104  	}
1105  
1106  	set Priv(selectFile) $data(selectFile)
1107  	set Priv(selectPath) $data(selectPath)
1108  
1109  	if {($data(type) eq "save") && $data(-confirmoverwrite) && [file exists $selectFilePath]} {
1110  	    set reply [tk_messageBox -icon warning -type yesno -parent $w \
1111  		    -message [mc "File \"%1\$s\" already exists.\nDo you want\
1112  		    to overwrite it?" $selectFilePath]]
1113  	    if {$reply eq "no"} {
1114  		return
1115  	    }
1116  	}
1117  	if {
1118  	    [info exists data(-typevariable)] && $data(-typevariable) ne ""
1119  	    && [info exists data(-filetypes)] && [llength $data(-filetypes)]
1120  	    && [info exists data(filterType)] && $data(filterType) ne ""
1121  	} then {
1122  	    upvar #0 $data(-typevariable) typeVariable
1123  	    set typeVariable [lindex $data(origfiletypes) \
1124  	            [lsearch -exact $data(-filetypes) $data(filterType)] 0]
1125  
1126  	}
1127      }
1128      bind $data(okBtn) <Destroy> {}
1129      set Priv(selectFilePath) $selectFilePath
1130  }
1131  
1132  # ::tk::dialog::file::GlobFiltered --
1133  #
1134  #	Gets called to do globbing, returning the results and filtering them
1135  #	according to the current filter (and removing the entries for '.' and
1136  #	'..' which are never shown). Deals with evil cases such as where the
1137  #	user is supplying a filter which is an invalid list or where it has an
1138  #	unbalanced brace. The resulting list will be dictionary sorted.
1139  #
1140  #	Arguments:
1141  #	  dir		 Which directory to search
1142  #	  type		 List of filetypes to look for ('d' or 'f b c l p s')
1143  #	  overrideFilter Whether to ignore the filter for this search.
1144  #
1145  #	NB: Assumes that the caller has mapped the state variable to 'data'.
1146  #
1147  proc ::tk::dialog::file::GlobFiltered {dir type {overrideFilter 0}} {
1148      variable showHiddenVar
1149      upvar 1 data(filter) filter
1150  
1151      if {$filter eq "*" || $overrideFilter} {
1152  	set patterns [list *]
1153  	if {$showHiddenVar} {
1154  	    lappend patterns .*
1155  	}
1156      } elseif {[string is list $filter]} {
1157  	set patterns $filter
1158      } else {
1159  	# Invalid list; assume we can use non-whitespace sequences as words
1160  	set patterns [regexp -inline -all {\S+} $filter]
1161      }
1162  
1163      set opts [list -tails -directory $dir -type $type -nocomplain]
1164  
1165      set result {}
1166      catch {
1167  	# We have a catch because we might have a really bad pattern (e.g.,
1168  	# with an unbalanced brace); even [glob -nocomplain] doesn't like it.
1169  	# Using a catch ensures that it just means we match nothing instead of
1170  	# throwing a nasty error at the user...
1171  	foreach f [glob {*}$opts -- {*}$patterns] {
1172  	    if {$f eq "." || $f eq ".."} {
1173  		continue
1174  	    }
1175  	    # See ticket [1641721], $f might be a link pointing to a dir
1176  	    if {$type != "d" && [file isdir [file join $dir $f]]} {
1177  		continue
1178  	    }
1179  	    lappend result $f
1180  	}
1181      }
1182      return [lsort -dictionary -unique $result]
1183  }
1184  
1185  proc ::tk::dialog::file::CompleteEnt {w} {
1186      upvar ::tk::dialog::file::[winfo name $w] data
1187      set f [$data(ent) get]
1188      if {$data(-multiple)} {
1189  	if {![string is list $f] || [llength $f] != 1} {
1190  	    return -code break
1191  	}
1192  	set f [lindex $f 0]
1193      }
1194  
1195      # Get list of matching filenames and dirnames
1196      set files [if {[winfo class $w] eq "TkFDialog"} {
1197  	GlobFiltered $data(selectPath) {f b c l p s}
1198      }]
1199      set dirs2 {}
1200      foreach d [GlobFiltered $data(selectPath) d] {lappend dirs2 $d/}
1201  
1202      set targets [concat \
1203  	    [lsearch -glob -all -inline $files $f*] \
1204  	    [lsearch -glob -all -inline $dirs2 $f*]]
1205  
1206      if {[llength $targets] == 1} {
1207  	# We have a winner!
1208  	set f [lindex $targets 0]
1209      } elseif {$f in $targets || [llength $targets] == 0} {
1210  	if {[string length $f] > 0} {
1211  	    bell
1212  	}
1213  	return
1214      } elseif {[llength $targets] > 1} {
1215  	# Multiple possibles
1216  	if {[string length $f] == 0} {
1217  	    return
1218  	}
1219  	set t0 [lindex $targets 0]
1220  	for {set len [string length $t0]} {$len>0} {} {
1221  	    set allmatch 1
1222  	    foreach s $targets {
1223  		if {![string equal -length $len $s $t0]} {
1224  		    set allmatch 0
1225  		    break
1226  		}
1227  	    }
1228  	    incr len -1
1229  	    if {$allmatch} break
1230  	}
1231  	set f [string range $t0 0 $len]
1232      }
1233  
1234      if {$data(-multiple)} {
1235  	set f [list $f]
1236      }
1237      $data(ent) delete 0 end
1238      $data(ent) insert 0 $f
1239      return -code break
1240  }