mingw/lib/tk8.5/xmfbox.tcl

   1 # xmfbox.tcl --
   2 #
   3 #       Implements the "Motif" style file selection dialog for the
   4 #       Unix platform. This implementation is used only if the
   5 #       "::tk_strictMotif" flag is set.
   6 #
   7 # RCS: @(#) $Id: xmfbox.tcl,v 1.31 2007/12/13 15:26:28 dgp Exp $
   8 #
   9 # Copyright (c) 1996 Sun Microsystems, Inc.
  10 # Copyright (c) 1998-2000 Scriptics Corporation
  11 #
  12 # See the file "license.terms" for information on usage and redistribution
  13 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14
  15 namespace eval ::tk::dialog {}
  16 namespace eval ::tk::dialog::file {}
  17
  18
  19 # ::tk::MotifFDialog --
  20 #
  21 #       Implements a file dialog similar to the standard Motif file
  22 #       selection box.
  23 #
  24 # Arguments:
  25 #       type            "open" or "save"
  26 #       args            Options parsed by the procedure.
  27 #
  28 # Results:
  29 #       When -multiple is set to 0, this returns the absolute pathname
  30 #       of the selected file. (NOTE: This is not the same as a single
  31 #       element list.)
  32 #
  33 #       When -multiple is set to > 0, this returns a Tcl list of absolute
  34 #       pathnames. The argument for -multiple is ignored, but for consistency
  35 #       with Windows it defines the maximum amount of memory to allocate for
  36 #       the returned filenames.
  37
  38 proc ::tk::MotifFDialog {type args} {
  39     variable ::tk::Priv
  40     set dataName __tk_filedialog
  41     upvar ::tk::dialog::file::$dataName data
  42
  43     set w [MotifFDialog_Create $dataName $type $args]
  44
  45     # Set a grab and claim the focus too.
  46
  47     ::tk::SetFocusGrab $w $data(sEnt)
  48     $data(sEnt) selection range 0 end
  49
  50     # Wait for the user to respond, then restore the focus and
  51     # return the index of the selected button.  Restore the focus
  52     # before deleting the window, since otherwise the window manager
  53     # may take the focus away so we can't redirect it.  Finally,
  54     # restore any grab that was in effect.
  55
  56     vwait ::tk::Priv(selectFilePath)
  57     set result $Priv(selectFilePath)
  58     ::tk::RestoreFocusGrab $w $data(sEnt) withdraw
  59
  60     return $result
  61 }
  62
  63 # ::tk::MotifFDialog_Create --
  64 #
  65 #       Creates the Motif file dialog (if it doesn't exist yet) and
  66 #       initialize the internal data structure associated with the
  67 #       dialog.
  68 #
  69 #       This procedure is used by ::tk::MotifFDialog to create the
  70 #       dialog. It's also used by the test suite to test the Motif
  71 #       file dialog implementation. User code shouldn't call this
  72 #       procedure directly.
  73 #
  74 # Arguments:
  75 #       dataName        Name of the global "data" array for the file dialog.
  76 #       type            "Save" or "Open"
  77 #       argList         Options parsed by the procedure.
  78 #
  79 # Results:
  80 #       Pathname of the file dialog.
  81
  82 proc ::tk::MotifFDialog_Create {dataName type argList} {
  83     upvar ::tk::dialog::file::$dataName data
  84
  85     MotifFDialog_Config $dataName $type $argList
  86
  87     if {$data(-parent) eq "."} {
  88         set w .$dataName
  89     } else {
  90         set w $data(-parent).$dataName
  91     }
  92
  93     # (re)create the dialog box if necessary
  94     #
  95     if {![winfo exists $w]} {
  96         MotifFDialog_BuildUI $w
  97     } elseif {[winfo class $w] ne "TkMotifFDialog"} {
  98         destroy $w
  99         MotifFDialog_BuildUI $w
 100     } else {
 101         set data(fEnt) $w.top.f1.ent
 102         set data(dList) $w.top.f2.a.l
 103         set data(fList) $w.top.f2.b.l
 104         set data(sEnt) $w.top.f3.ent
 105         set data(okBtn) $w.bot.ok
 106         set data(filterBtn) $w.bot.filter
 107         set data(cancelBtn) $w.bot.cancel
 108     }
 109     MotifFDialog_SetListMode $w
 110
 111     # Dialog boxes should be transient with respect to their parent,
 112     # so that they will always stay on top of their parent window.  However,
 113     # some window managers will create the window as withdrawn if the parent
 114     # window is withdrawn or iconified.  Combined with the grab we put on the
 115     # window, this can hang the entire application.  Therefore we only make
 116     # the dialog transient if the parent is viewable.
 117
 118     if {[winfo viewable [winfo toplevel $data(-parent)]] } {
 119         wm transient $w $data(-parent)
 120     }
 121
 122     MotifFDialog_FileTypes $w
 123     MotifFDialog_Update $w
 124
 125     # Withdraw the window, then update all the geometry information
 126     # so we know how big it wants to be, then center the window in the
 127     # display (Motif style) and de-iconify it.
 128
 129     ::tk::PlaceWindow $w
 130     wm title $w $data(-title)
 131
 132     return $w
 133 }
 134
 135 # ::tk::MotifFDialog_FileTypes --
 136 #
 137 #       Checks the -filetypes option. If present this adds a list of radio-
 138 #       buttons to pick the file types from.
 139 #
 140 # Arguments:
 141 #       w               Pathname of the tk_get*File dialogue.
 142 #
 143 # Results:
 144 #       none
 145
 146 proc ::tk::MotifFDialog_FileTypes {w} {
 147     upvar ::tk::dialog::file::[winfo name $w] data
 148
 149     set f $w.top.f3.types
 150     destroy $f
 151
 152     # No file types: use "*" as the filter and display no radio-buttons
 153     if {$data(-filetypes) eq ""} {
 154         set data(filter) *
 155         return
 156     }
 157
 158     # The filetypes radiobuttons
 159     # set data(fileType) $data(-defaulttype)
 160     # Default type to first entry
 161     set initialTypeName [lindex $data(-filetypes) 0 0]
 162     if {($data(-typevariable) ne "")
 163         && [uplevel 4 [list info exists $data(-typevariable)]]} {
 164         set initialTypeName [uplevel 4 [list set $data(-typevariable)]]
 165     }
 166     set ix 0
 167     set data(fileType) 0
 168     foreach fltr $data(-filetypes) {
 169         set fname [lindex $fltr 0]
 170         if {[string first $initialTypeName $fname] == 0} {
 171             set data(fileType) $ix
 172             break
 173         }
 174         incr ix
 175     }
 176
 177     MotifFDialog_SetFilter $w [lindex $data(-filetypes) $data(fileType)]
 178
 179     #don't produce radiobuttons for only one filetype
 180     if {[llength $data(-filetypes)] == 1} {
 181         return
 182     }
 183
 184     frame $f
 185     set cnt 0
 186     if {$data(-filetypes) ne {}} {
 187         foreach type $data(-filetypes) {
 188             set title  [lindex [lindex $type 0] 0]
 189             set filter [lindex $type 1]
 190             radiobutton $f.b$cnt \
 191                 -text $title \
 192                 -variable ::tk::dialog::file::[winfo name $w](fileType) \
 193                 -value $cnt \
 194                 -command [list tk::MotifFDialog_SetFilter $w $type]
 195             pack $f.b$cnt -side left
 196             incr cnt
 197         }
 198     }
 199     $f.b$data(fileType) invoke
 200
 201     pack $f -side bottom -fill both
 202
 203     return
 204 }
 205
 206 # This proc gets called whenever data(filter) is set
 207 #
 208 proc ::tk::MotifFDialog_SetFilter {w type} {
 209     upvar ::tk::dialog::file::[winfo name $w] data
 210     variable ::tk::Priv
 211
 212     set data(filter) [lindex $type 1]
 213     set Priv(selectFileType) [lindex [lindex $type 0] 0]
 214
 215     MotifFDialog_Update $w
 216 }
 217
 218 # ::tk::MotifFDialog_Config --
 219 #
 220 #       Iterates over the optional arguments to determine the option
 221 #       values for the Motif file dialog; gives default values to
 222 #       unspecified options.
 223 #
 224 # Arguments:
 225 #       dataName        The name of the global variable in which
 226 #                       data for the file dialog is stored.
 227 #       type            "Save" or "Open"
 228 #       argList         Options parsed by the procedure.
 229
 230 proc ::tk::MotifFDialog_Config {dataName type argList} {
 231     upvar ::tk::dialog::file::$dataName data
 232
 233     set data(type) $type
 234
 235     # 1: the configuration specs
 236     #
 237     set specs {
 238         {-defaultextension "" "" ""}
 239         {-filetypes "" "" ""}
 240         {-initialdir "" "" ""}
 241         {-initialfile "" "" ""}
 242         {-parent "" "" "."}
 243         {-title "" "" ""}
 244         {-typevariable "" "" ""}
 245     }
 246     if {$type eq "open"} {
 247         lappend specs {-multiple "" "" "0"}
 248     }
 249
 250     set data(-multiple) 0
 251     # 2: default values depending on the type of the dialog
 252     #
 253     if {![info exists data(selectPath)]} {
 254         # first time the dialog has been popped up
 255         set data(selectPath) [pwd]
 256         set data(selectFile) ""
 257     }
 258
 259     # 3: parse the arguments
 260     #
 261     tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
 262
 263     if {$data(-title) eq ""} {
 264         if {$type eq "open"} {
 265             if {$data(-multiple) != 0} {
 266                 set data(-title) "[mc {Open Multiple Files}]"
 267             } else {
 268                 set data(-title) [mc "Open"]
 269             }
 270         } else {
 271             set data(-title) [mc "Save As"]
 272         }
 273     }
 274
 275     # 4: set the default directory and selection according to the -initial
 276     #    settings
 277     #
 278     if {$data(-initialdir) ne ""} {
 279         if {[file isdirectory $data(-initialdir)]} {
 280             set data(selectPath) [lindex [glob $data(-initialdir)] 0]
 281         } else {
 282             set data(selectPath) [pwd]
 283         }
 284
 285         # Convert the initialdir to an absolute path name.
 286
 287         set old [pwd]
 288         cd $data(selectPath)
 289         set data(selectPath) [pwd]
 290         cd $old
 291     }
 292     set data(selectFile) $data(-initialfile)
 293
 294     # 5. Parse the -filetypes option. It is not used by the motif
 295     #    file dialog, but we check for validity of the value to make sure
 296     #    the application code also runs fine with the TK file dialog.
 297     #
 298     set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)]
 299
 300     if {![info exists data(filter)]} {
 301         set data(filter) *
 302     }
 303     if {![winfo exists $data(-parent)]} {
 304         error "bad window path name \"$data(-parent)\""
 305     }
 306 }
 307
 308 # ::tk::MotifFDialog_BuildUI --
 309 #
 310 #       Builds the UI components of the Motif file dialog.
 311 #
 312 # Arguments:
 313 #       w               Pathname of the dialog to build.
 314 #
 315 # Results:
 316 #       None.
 317
 318 proc ::tk::MotifFDialog_BuildUI {w} {
 319     set dataName [lindex [split $w .] end]
 320     upvar ::tk::dialog::file::$dataName data
 321
 322     # Create the dialog toplevel and internal frames.
 323     #
 324     toplevel $w -class TkMotifFDialog
 325     set top [frame $w.top -relief raised -bd 1]
 326     set bot [frame $w.bot -relief raised -bd 1]
 327
 328     pack $w.bot -side bottom -fill x
 329     pack $w.top -side top -expand yes -fill both
 330
 331     set f1 [frame $top.f1]
 332     set f2 [frame $top.f2]
 333     set f3 [frame $top.f3]
 334
 335     pack $f1 -side top    -fill x
 336     pack $f3 -side bottom -fill x
 337     pack $f2 -expand yes -fill both
 338
 339     set f2a [frame $f2.a]
 340     set f2b [frame $f2.b]
 341
 342     grid $f2a -row 0 -column 0 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
 343         -sticky news
 344     grid $f2b -row 0 -column 1 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
 345         -sticky news
 346     grid rowconfigure $f2 0    -minsize 0   -weight 1
 347     grid columnconfigure $f2 0 -minsize 0   -weight 1
 348     grid columnconfigure $f2 1 -minsize 150 -weight 2
 349
 350     # The Filter box
 351     #
 352     bind [::tk::AmpWidget label $f1.lab -text [mc "Fil&ter:"] -anchor w] \
 353         <<AltUnderlined>> [list focus $f1.ent]
 354     entry $f1.ent
 355     pack $f1.lab -side top -fill x -padx 6 -pady 4
 356     pack $f1.ent -side top -fill x -padx 4 -pady 0
 357     set data(fEnt) $f1.ent
 358
 359     # The file and directory lists
 360     #
 361     set data(dList) [MotifFDialog_MakeSList $w $f2a \
 362             [mc "&Directory:"] DList]
 363     set data(fList) [MotifFDialog_MakeSList $w $f2b \
 364             [mc "Fi&les:"]     FList]
 365
 366     # The Selection box
 367     #
 368     bind [::tk::AmpWidget label $f3.lab -text [mc "&Selection:"] -anchor w] \
 369         <<AltUnderlined>> [list focus $f3.ent]
 370     entry $f3.ent
 371     pack $f3.lab -side top -fill x -padx 6 -pady 0
 372     pack $f3.ent -side top -fill x -padx 4 -pady 4
 373     set data(sEnt) $f3.ent
 374
 375     # The buttons
 376     #
 377     set maxWidth [::tk::mcmaxamp &OK &Filter &Cancel]
 378     set maxWidth [expr {$maxWidth<6?6:$maxWidth}]
 379     set data(okBtn) [::tk::AmpWidget button $bot.ok -text [mc "&OK"] \
 380             -width $maxWidth \
 381             -command [list tk::MotifFDialog_OkCmd $w]]
 382     set data(filterBtn) [::tk::AmpWidget button $bot.filter -text [mc "&Filter"] \
 383             -width $maxWidth \
 384             -command [list tk::MotifFDialog_FilterCmd $w]]
 385     set data(cancelBtn) [::tk::AmpWidget button $bot.cancel -text [mc "&Cancel"] \
 386             -width $maxWidth \
 387             -command [list tk::MotifFDialog_CancelCmd $w]]
 388
 389     pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \
 390         -side left
 391
 392     # Create the bindings:
 393     #
 394     bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A]
 395
 396     bind $data(fEnt) <Return> [list tk::MotifFDialog_ActivateFEnt $w]
 397     bind $data(sEnt) <Return> [list tk::MotifFDialog_ActivateSEnt $w]
 398     bind $w <Escape> [list tk::MotifFDialog_CancelCmd $w]
 399     bind $w.bot <Destroy> {set ::tk::Priv(selectFilePath) {}}
 400
 401     wm protocol $w WM_DELETE_WINDOW [list tk::MotifFDialog_CancelCmd $w]
 402 }
 403
 404 proc ::tk::MotifFDialog_SetListMode {w} {
 405     upvar ::tk::dialog::file::[winfo name $w] data
 406
 407     if {$data(-multiple) != 0} {
 408         set selectmode extended
 409     } else {
 410         set selectmode browse
 411     }
 412     set f $w.top.f2.b
 413     $f.l configure -selectmode $selectmode
 414 }
 415
 416 # ::tk::MotifFDialog_MakeSList --
 417 #
 418 #       Create a scrolled-listbox and set the keyboard accelerator
 419 #       bindings so that the list selection follows what the user
 420 #       types.
 421 #
 422 # Arguments:
 423 #       w               Pathname of the dialog box.
 424 #       f               Frame widget inside which to create the scrolled
 425 #                       listbox. This frame widget already exists.
 426 #       label           The string to display on top of the listbox.
 427 #       under           Sets the -under option of the label.
 428 #       cmdPrefix       Specifies procedures to call when the listbox is
 429 #                       browsed or activated.
 430
 431 proc ::tk::MotifFDialog_MakeSList {w f label cmdPrefix} {
 432     bind [::tk::AmpWidget label $f.lab -text $label -anchor w] \
 433         <<AltUnderlined>> [list focus $f.l]
 434     listbox $f.l -width 12 -height 5 -exportselection 0\
 435         -xscrollcommand [list $f.h set] -yscrollcommand [list $f.v set]
 436     scrollbar $f.v -orient vertical   -takefocus 0 -command [list $f.l yview]
 437     scrollbar $f.h -orient horizontal -takefocus 0 -command [list $f.l xview]
 438     grid $f.lab -row 0 -column 0 -sticky news -rowspan 1 -columnspan 2 \
 439         -padx 2 -pady 2
 440     grid $f.l -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
 441     grid $f.v -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky news
 442     grid $f.h -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky news
 443
 444     grid rowconfigure    $f 0 -weight 0 -minsize 0
 445     grid rowconfigure    $f 1 -weight 1 -minsize 0
 446     grid columnconfigure $f 0 -weight 1 -minsize 0
 447
 448     # bindings for the listboxes
 449     #
 450     set list $f.l
 451     bind $list <<ListboxSelect>> [list tk::MotifFDialog_Browse$cmdPrefix $w]
 452     bind $list <Double-ButtonRelease-1> \
 453             [list tk::MotifFDialog_Activate$cmdPrefix $w]
 454     bind $list <Return> "tk::MotifFDialog_Browse$cmdPrefix [list $w]; \
 455             tk::MotifFDialog_Activate$cmdPrefix [list $w]"
 456
 457     bindtags $list [list Listbox $list [winfo toplevel $list] all]
 458     ListBoxKeyAccel_Set $list
 459
 460     return $f.l
 461 }
 462
 463 # ::tk::MotifFDialog_InterpFilter --
 464 #
 465 #       Interpret the string in the filter entry into two components:
 466 #       the directory and the pattern. If the string is a relative
 467 #       pathname, give a warning to the user and restore the pattern
 468 #       to original.
 469 #
 470 # Arguments:
 471 #       w               pathname of the dialog box.
 472 #
 473 # Results:
 474 #       A list of two elements. The first element is the directory
 475 #       specified # by the filter. The second element is the filter
 476 #       pattern itself.
 477
 478 proc ::tk::MotifFDialog_InterpFilter {w} {
 479     upvar ::tk::dialog::file::[winfo name $w] data
 480
 481     set text [string trim [$data(fEnt) get]]
 482
 483     # Perform tilde substitution
 484     #
 485     set badTilde 0
 486     if {[string index $text 0] eq "~"} {
 487         set list [file split $text]
 488         set tilde [lindex $list 0]
 489         if {[catch {set tilde [glob $tilde]}]} {
 490             set badTilde 1
 491         } else {
 492             set text [eval file join [concat $tilde [lrange $list 1 end]]]
 493         }
 494     }
 495
 496     # If the string is a relative pathname, combine it
 497     # with the current selectPath.
 498
 499     set relative 0
 500     if {[file pathtype $text] eq "relative"} {
 501         set relative 1
 502     } elseif {$badTilde} {
 503         set relative 1
 504     }
 505
 506     if {$relative} {
 507         tk_messageBox -icon warning -type ok \
 508                 -message "\"$text\" must be an absolute pathname"
 509
 510         $data(fEnt) delete 0 end
 511         $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
 512                 $data(filter)]
 513
 514         return [list $data(selectPath) $data(filter)]
 515     }
 516
 517     set resolved [::tk::dialog::file::JoinFile [file dirname $text] [file tail $text]]
 518
 519     if {[file isdirectory $resolved]} {
 520         set dir $resolved
 521         set fil $data(filter)
 522     } else {
 523         set dir [file dirname $resolved]
 524         set fil [file tail    $resolved]
 525     }
 526
 527     return [list $dir $fil]
 528 }
 529
 530 # ::tk::MotifFDialog_Update
 531 #
 532 #       Load the files and synchronize the "filter" and "selection" fields
 533 #       boxes.
 534 #
 535 # Arguments:
 536 #       w               pathname of the dialog box.
 537 #
 538 # Results:
 539 #       None.
 540
 541 proc ::tk::MotifFDialog_Update {w} {
 542     upvar ::tk::dialog::file::[winfo name $w] data
 543
 544     $data(fEnt) delete 0 end
 545     $data(fEnt) insert 0 \
 546             [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
 547     $data(sEnt) delete 0 end
 548     $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
 549             $data(selectFile)]
 550
 551     MotifFDialog_LoadFiles $w
 552 }
 553
 554 # ::tk::MotifFDialog_LoadFiles --
 555 #
 556 #       Loads the files and directories into the two listboxes according
 557 #       to the filter setting.
 558 #
 559 # Arguments:
 560 #       w               pathname of the dialog box.
 561 #
 562 # Results:
 563 #       None.
 564
 565 proc ::tk::MotifFDialog_LoadFiles {w} {
 566     upvar ::tk::dialog::file::[winfo name $w] data
 567
 568     $data(dList) delete 0 end
 569     $data(fList) delete 0 end
 570
 571     set appPWD [pwd]
 572     if {[catch {cd $data(selectPath)}]} {
 573         cd $appPWD
 574
 575         $data(dList) insert end ".."
 576         return
 577     }
 578
 579     # Make the dir and file lists
 580     #
 581     # For speed we only have one glob, which reduces the file system
 582     # calls (good for slow NFS networks).
 583     #
 584     # We also do two smaller sorts (files + dirs) instead of one large sort,
 585     # which gives a small speed increase.
 586     #
 587     set top 0
 588     set dlist ""
 589     set flist ""
 590     foreach f [glob -nocomplain .* *] {
 591         if {[file isdir ./$f]} {
 592             lappend dlist $f
 593         } else {
 594             foreach pat $data(filter) {
 595                 if {[string match $pat $f]} {
 596                     if {[string match .* $f]} {
 597                         incr top
 598                     }
 599                     lappend flist $f
 600                     break
 601                 }
 602             }
 603         }
 604     }
 605     eval [list $data(dList) insert end] [lsort -dictionary $dlist]
 606     eval [list $data(fList) insert end] [lsort -dictionary $flist]
 607
 608     # The user probably doesn't want to see the . files. We adjust the view
 609     # so that the listbox displays all the non-dot files
 610     $data(fList) yview $top
 611
 612     cd $appPWD
 613 }
 614
 615 # ::tk::MotifFDialog_BrowseDList --
 616 #
 617 #       This procedure is called when the directory list is browsed
 618 #       (clicked-over) by the user.
 619 #
 620 # Arguments:
 621 #       w               The pathname of the dialog box.
 622 #
 623 # Results:
 624 #       None.
 625
 626 proc ::tk::MotifFDialog_BrowseDList {w} {
 627     upvar ::tk::dialog::file::[winfo name $w] data
 628
 629     focus $data(dList)
 630     if {[$data(dList) curselection] eq ""} {
 631         return
 632     }
 633     set subdir [$data(dList) get [$data(dList) curselection]]
 634     if {$subdir eq ""} {
 635         return
 636     }
 637
 638     $data(fList) selection clear 0 end
 639
 640     set list [MotifFDialog_InterpFilter $w]
 641     set data(filter) [lindex $list 1]
 642
 643     switch -- $subdir {
 644         . {
 645             set newSpec [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
 646         }
 647         .. {
 648             set newSpec [::tk::dialog::file::JoinFile [file dirname $data(selectPath)] \
 649                 $data(filter)]
 650         }
 651         default {
 652             set newSpec [::tk::dialog::file::JoinFile [::tk::dialog::file::JoinFile \
 653                     $data(selectPath) $subdir] $data(filter)]
 654         }
 655     }
 656
 657     $data(fEnt) delete 0 end
 658     $data(fEnt) insert 0 $newSpec
 659 }
 660
 661 # ::tk::MotifFDialog_ActivateDList --
 662 #
 663 #       This procedure is called when the directory list is activated
 664 #       (double-clicked) by the user.
 665 #
 666 # Arguments:
 667 #       w               The pathname of the dialog box.
 668 #
 669 # Results:
 670 #       None.
 671
 672 proc ::tk::MotifFDialog_ActivateDList {w} {
 673     upvar ::tk::dialog::file::[winfo name $w] data
 674
 675     if {[$data(dList) curselection] eq ""} {
 676         return
 677     }
 678     set subdir [$data(dList) get [$data(dList) curselection]]
 679     if {$subdir eq ""} {
 680         return
 681     }
 682
 683     $data(fList) selection clear 0 end
 684
 685     switch -- $subdir {
 686         . {
 687             set newDir $data(selectPath)
 688         }
 689         .. {
 690             set newDir [file dirname $data(selectPath)]
 691         }
 692         default {
 693             set newDir [::tk::dialog::file::JoinFile $data(selectPath) $subdir]
 694         }
 695     }
 696
 697     set data(selectPath) $newDir
 698     MotifFDialog_Update $w
 699
 700     if {$subdir ne ".."} {
 701         $data(dList) selection set 0
 702         $data(dList) activate 0
 703     } else {
 704         $data(dList) selection set 1
 705         $data(dList) activate 1
 706     }
 707 }
 708
 709 # ::tk::MotifFDialog_BrowseFList --
 710 #
 711 #       This procedure is called when the file list is browsed
 712 #       (clicked-over) by the user.
 713 #
 714 # Arguments:
 715 #       w               The pathname of the dialog box.
 716 #
 717 # Results:
 718 #       None.
 719
 720 proc ::tk::MotifFDialog_BrowseFList {w} {
 721     upvar ::tk::dialog::file::[winfo name $w] data
 722
 723     focus $data(fList)
 724     set data(selectFile) ""
 725     foreach item [$data(fList) curselection] {
 726         lappend data(selectFile) [$data(fList) get $item]
 727     }
 728     if {[llength $data(selectFile)] == 0} {
 729         return
 730     }
 731
 732     $data(dList) selection clear 0 end
 733
 734     $data(fEnt) delete 0 end
 735     $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
 736             $data(filter)]
 737     $data(fEnt) xview end
 738
 739     # if it's a multiple selection box, just put in the filenames
 740     # otherwise put in the full path as usual
 741     $data(sEnt) delete 0 end
 742     if {$data(-multiple) != 0} {
 743         $data(sEnt) insert 0 $data(selectFile)
 744     } else {
 745         $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
 746                 [lindex $data(selectFile) 0]]
 747     }
 748     $data(sEnt) xview end
 749 }
 750
 751 # ::tk::MotifFDialog_ActivateFList --
 752 #
 753 #       This procedure is called when the file list is activated
 754 #       (double-clicked) by the user.
 755 #
 756 # Arguments:
 757 #       w               The pathname of the dialog box.
 758 #
 759 # Results:
 760 #       None.
 761
 762 proc ::tk::MotifFDialog_ActivateFList {w} {
 763     upvar ::tk::dialog::file::[winfo name $w] data
 764
 765     if {[$data(fList) curselection] eq ""} {
 766         return
 767     }
 768     set data(selectFile) [$data(fList) get [$data(fList) curselection]]
 769     if {$data(selectFile) eq ""} {
 770         return
 771     } else {
 772         MotifFDialog_ActivateSEnt $w
 773     }
 774 }
 775
 776 # ::tk::MotifFDialog_ActivateFEnt --
 777 #
 778 #       This procedure is called when the user presses Return inside
 779 #       the "filter" entry. It updates the dialog according to the
 780 #       text inside the filter entry.
 781 #
 782 # Arguments:
 783 #       w               The pathname of the dialog box.
 784 #
 785 # Results:
 786 #       None.
 787
 788 proc ::tk::MotifFDialog_ActivateFEnt {w} {
 789     upvar ::tk::dialog::file::[winfo name $w] data
 790
 791     set list [MotifFDialog_InterpFilter $w]
 792     set data(selectPath) [lindex $list 0]
 793     set data(filter)    [lindex $list 1]
 794
 795     MotifFDialog_Update $w
 796 }
 797
 798 # ::tk::MotifFDialog_ActivateSEnt --
 799 #
 800 #       This procedure is called when the user presses Return inside
 801 #       the "selection" entry. It sets the ::tk::Priv(selectFilePath)
 802 #       variable so that the vwait loop in tk::MotifFDialog will be
 803 #       terminated.
 804 #
 805 # Arguments:
 806 #       w               The pathname of the dialog box.
 807 #
 808 # Results:
 809 #       None.
 810
 811 proc ::tk::MotifFDialog_ActivateSEnt {w} {
 812     variable ::tk::Priv
 813     upvar ::tk::dialog::file::[winfo name $w] data
 814
 815     set selectFilePath [string trim [$data(sEnt) get]]
 816
 817     if {$selectFilePath eq ""} {
 818         MotifFDialog_FilterCmd $w
 819         return
 820     }
 821
 822     if {$data(-multiple) == 0} {
 823         set selectFilePath [list $selectFilePath]
 824     }
 825
 826     if {[file isdirectory [lindex $selectFilePath 0]]} {
 827         set data(selectPath) [lindex [glob $selectFilePath] 0]
 828         set data(selectFile) ""
 829         MotifFDialog_Update $w
 830         return
 831     }
 832
 833     set newFileList ""
 834     foreach item $selectFilePath {
 835         if {[file pathtype $item] ne "absolute"} {
 836             set item [file join $data(selectPath) $item]
 837         } elseif {![file exists [file dirname $item]]} {
 838             tk_messageBox -icon warning -type ok \
 839                     -message [mc {Directory "%1$s" does not exist.} \
 840                     [file dirname $item]]
 841             return
 842         }
 843
 844         if {![file exists $item]} {
 845             if {$data(type) eq "open"} {
 846                 tk_messageBox -icon warning -type ok \
 847                         -message [mc {File "%1$s" does not exist.} $item]
 848                 return
 849             }
 850         } elseif {$data(type) eq "save"} {
 851             set message [format %s%s \
 852                     [mc "File \"%1\$s\" already exists.\n\n" $selectFilePath] \
 853                     [mc {Replace existing file?}]]
 854             set answer [tk_messageBox -icon warning -type yesno \
 855                     -message $message]
 856             if {$answer eq "no"} {
 857                 return
 858             }
 859         }
 860
 861         lappend newFileList $item
 862     }
 863
 864     # Return selected filter
 865     if {[info exists data(-typevariable)] && $data(-typevariable) ne ""
 866         && [info exists data(-filetypes)] && $data(-filetypes) ne ""} {
 867         upvar 2 $data(-typevariable) initialTypeName
 868         set initialTypeName [lindex $data(-filetypes) $data(fileType) 0]
 869     }
 870
 871     if {$data(-multiple) != 0} {
 872         set Priv(selectFilePath) $newFileList
 873     } else {
 874         set Priv(selectFilePath) [lindex $newFileList 0]
 875     }
 876
 877     # Set selectFile and selectPath to first item in list
 878     set Priv(selectFile)     [file tail    [lindex $newFileList 0]]
 879     set Priv(selectPath)     [file dirname [lindex $newFileList 0]]
 880 }
 881
 882
 883 proc ::tk::MotifFDialog_OkCmd {w} {
 884     upvar ::tk::dialog::file::[winfo name $w] data
 885
 886     MotifFDialog_ActivateSEnt $w
 887 }
 888
 889 proc ::tk::MotifFDialog_FilterCmd {w} {
 890     upvar ::tk::dialog::file::[winfo name $w] data
 891
 892     MotifFDialog_ActivateFEnt $w
 893 }
 894
 895 proc ::tk::MotifFDialog_CancelCmd {w} {
 896     variable ::tk::Priv
 897
 898     set Priv(selectFilePath) ""
 899     set Priv(selectFile)     ""
 900     set Priv(selectPath)     ""
 901 }
 902
 903 proc ::tk::ListBoxKeyAccel_Set {w} {
 904     bind Listbox <Any-KeyPress> ""
 905     bind $w <Destroy> [list tk::ListBoxKeyAccel_Unset $w]
 906     bind $w <Any-KeyPress> [list tk::ListBoxKeyAccel_Key $w %A]
 907 }
 908
 909 proc ::tk::ListBoxKeyAccel_Unset {w} {
 910     variable ::tk::Priv
 911
 912     catch {after cancel $Priv(lbAccel,$w,afterId)}
 913     unset -nocomplain Priv(lbAccel,$w) Priv(lbAccel,$w,afterId)
 914 }
 915
 916 # ::tk::ListBoxKeyAccel_Key--
 917 #
 918 #       This procedure maintains a list of recently entered keystrokes
 919 #       over a listbox widget. It arranges an idle event to move the
 920 #       selection of the listbox to the entry that begins with the
 921 #       keystrokes.
 922 #
 923 # Arguments:
 924 #       w               The pathname of the listbox.
 925 #       key             The key which the user just pressed.
 926 #
 927 # Results:
 928 #       None.
 929
 930 proc ::tk::ListBoxKeyAccel_Key {w key} {
 931     variable ::tk::Priv
 932
 933     if { $key eq "" } {
 934         return
 935     }
 936     append Priv(lbAccel,$w) $key
 937     ListBoxKeyAccel_Goto $w $Priv(lbAccel,$w)
 938     catch {
 939         after cancel $Priv(lbAccel,$w,afterId)
 940     }
 941     set Priv(lbAccel,$w,afterId) [after 500 \
 942             [list tk::ListBoxKeyAccel_Reset $w]]
 943 }
 944
 945 proc ::tk::ListBoxKeyAccel_Goto {w string} {
 946     variable ::tk::Priv
 947
 948     set string [string tolower $string]
 949     set end [$w index end]
 950     set theIndex -1
 951
 952     for {set i 0} {$i < $end} {incr i} {
 953         set item [string tolower [$w get $i]]
 954         if {[string compare $string $item] >= 0} {
 955             set theIndex $i
 956         }
 957         if {[string compare $string $item] <= 0} {
 958             set theIndex $i
 959             break
 960         }
 961     }
 962
 963     if {$theIndex >= 0} {
 964         $w selection clear 0 end
 965         $w selection set $theIndex $theIndex
 966         $w activate $theIndex
 967         $w see $theIndex
 968         event generate $w <<ListboxSelect>>
 969     }
 970 }
 971
 972 proc ::tk::ListBoxKeyAccel_Reset {w} {
 973     variable ::tk::Priv
 974
 975     unset -nocomplain Priv(lbAccel,$w)
 976 }
 977
 978 proc ::tk_getFileType {} {
 979     variable ::tk::Priv
 980
 981     return $Priv(selectFileType)
 982 }
 983