tk/library/tkfbox.tcl

   1 # tkfbox.tcl --
   2 #
   3 #       Implements the "TK" standard file selection dialog box. This
   4 #       dialog box is used on the Unix platforms whenever the tk_strictMotif
   5 #       flag is not set.
   6 #
   7 #       The "TK" standard file selection dialog box is similar to the
   8 #       file selection dialog box on Win95(TM). The user can navigate
   9 #       the directories by clicking on the folder icons or by
  10 #       selectinf the "Directory" option menu. The user can select
  11 #       files by clicking on the file icons or by entering a filename
  12 #       in the "Filename:" entry.
  13 #
  14 # RCS: @(#) $Id$
  15 #
  16 # Copyright (c) 1994-1998 Sun Microsystems, Inc.
  17 #
  18 # See the file "license.terms" for information on usage and redistribution
  19 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  20 #
  21
  22 #----------------------------------------------------------------------
  23 #
  24 #                     I C O N   L I S T
  25 #
  26 # This is a pseudo-widget that implements the icon list inside the
  27 # tkFDialog dialog box.
  28 #
  29 #----------------------------------------------------------------------
  30
  31 # tkIconList --
  32 #
  33 #       Creates an IconList widget.
  34 #
  35 proc tkIconList {w args} {
  36     upvar #0 $w data
  37
  38     tkIconList_Config $w $args
  39     tkIconList_Create $w
  40 }
  41
  42 # tkIconList_Config --
  43 #
  44 #       Configure the widget variables of IconList, according to the command
  45 #       line arguments.
  46 #
  47 proc tkIconList_Config {w argList} {
  48     upvar #0 $w data
  49
  50     # 1: the configuration specs
  51     #
  52     set specs {
  53         {-browsecmd "" "" ""}
  54         {-command "" "" ""}
  55     }
  56
  57     # 2: parse the arguments
  58     #
  59     tclParseConfigSpec $w $specs "" $argList
  60 }
  61
  62 # tkIconList_Create --
  63 #
  64 #       Creates an IconList widget by assembling a canvas widget and a
  65 #       scrollbar widget. Sets all the bindings necessary for the IconList's
  66 #       operations.
  67 #
  68 proc tkIconList_Create {w} {
  69     upvar #0 $w data
  70
  71     frame $w
  72     set data(sbar)   [scrollbar $w.sbar -orient horizontal \
  73         -highlightthickness 0 -takefocus 0]
  74     set data(canvas) [canvas $w.canvas -bd 2 -relief sunken \
  75         -width 400 -height 120 -takefocus 1]
  76     pack $data(sbar) -side bottom -fill x -padx 2
  77     pack $data(canvas) -expand yes -fill both
  78
  79     $data(sbar) config -command [list $data(canvas) xview]
  80     $data(canvas) config -xscrollcommand [list $data(sbar) set]
  81
  82     # Initializes the max icon/text width and height and other variables
  83     #
  84     set data(maxIW) 1
  85     set data(maxIH) 1
  86     set data(maxTW) 1
  87     set data(maxTH) 1
  88     set data(numItems) 0
  89     set data(curItem)  {}
  90     set data(noScroll) 1
  91
  92     # Creates the event bindings.
  93     #
  94     bind $data(canvas) <Configure>      [list tkIconList_Arrange $w]
  95
  96     bind $data(canvas) <1>              [list tkIconList_Btn1 $w %x %y]
  97     bind $data(canvas) <B1-Motion>      [list tkIconList_Motion1 $w %x %y]
  98     bind $data(canvas) <B1-Leave>       [list tkIconList_Leave1 $w %x %y]
  99     bind $data(canvas) <B1-Enter>       [list tkCancelRepeat]
 100     bind $data(canvas) <ButtonRelease-1> [list tkCancelRepeat]
 101     bind $data(canvas) <Double-ButtonRelease-1> \
 102             [list tkIconList_Double1 $w %x %y]
 103
 104     bind $data(canvas) <Up>             [list tkIconList_UpDown $w -1]
 105     bind $data(canvas) <Down>           [list tkIconList_UpDown $w  1]
 106     bind $data(canvas) <Left>           [list tkIconList_LeftRight $w -1]
 107     bind $data(canvas) <Right>          [list tkIconList_LeftRight $w  1]
 108     bind $data(canvas) <Return>         [list tkIconList_ReturnKey $w]
 109     bind $data(canvas) <KeyPress>       [list tkIconList_KeyPress $w %A]
 110     bind $data(canvas) <Control-KeyPress> ";"
 111     bind $data(canvas) <Alt-KeyPress>   ";"
 112
 113     bind $data(canvas) <FocusIn>        [list tkIconList_FocusIn $w]
 114
 115     return $w
 116 }
 117
 118 # tkIconList_AutoScan --
 119 #
 120 # This procedure is invoked when the mouse leaves an entry window
 121 # with button 1 down.  It scrolls the window up, down, left, or
 122 # right, depending on where the mouse left the window, and reschedules
 123 # itself as an "after" command so that the window continues to scroll until
 124 # the mouse moves back into the window or the mouse button is released.
 125 #
 126 # Arguments:
 127 # w -           The IconList window.
 128 #
 129 proc tkIconList_AutoScan {w} {
 130     upvar #0 $w data
 131     global tkPriv
 132
 133     if {![winfo exists $w]} return
 134     set x $tkPriv(x)
 135     set y $tkPriv(y)
 136
 137     if {$data(noScroll)} {
 138         return
 139     }
 140     if {$x >= [winfo width $data(canvas)]} {
 141         $data(canvas) xview scroll 1 units
 142     } elseif {$x < 0} {
 143         $data(canvas) xview scroll -1 units
 144     } elseif {$y >= [winfo height $data(canvas)]} {
 145         # do nothing
 146     } elseif {$y < 0} {
 147         # do nothing
 148     } else {
 149         return
 150     }
 151
 152     tkIconList_Motion1 $w $x $y
 153     set tkPriv(afterId) [after 50 [list tkIconList_AutoScan $w]]
 154 }
 155
 156 # Deletes all the items inside the canvas subwidget and reset the IconList's
 157 # state.
 158 #
 159 proc tkIconList_DeleteAll {w} {
 160     upvar #0 $w data
 161     upvar #0 $w:itemList itemList
 162
 163     $data(canvas) delete all
 164     catch {unset data(selected)}
 165     catch {unset data(rect)}
 166     catch {unset data(list)}
 167     catch {unset itemList}
 168     set data(maxIW) 1
 169     set data(maxIH) 1
 170     set data(maxTW) 1
 171     set data(maxTH) 1
 172     set data(numItems) 0
 173     set data(curItem)  {}
 174     set data(noScroll) 1
 175     $data(sbar) set 0.0 1.0
 176     $data(canvas) xview moveto 0
 177 }
 178
 179 # Adds an icon into the IconList with the designated image and text
 180 #
 181 proc tkIconList_Add {w image text} {
 182     upvar #0 $w data
 183     upvar #0 $w:itemList itemList
 184     upvar #0 $w:textList textList
 185
 186     set iTag [$data(canvas) create image 0 0 -image $image -anchor nw]
 187     set tTag [$data(canvas) create text  0 0 -text  $text  -anchor nw \
 188         -font $data(font)]
 189     set rTag [$data(canvas) create rect  0 0 0 0 -fill "" -outline ""]
 190
 191     set b [$data(canvas) bbox $iTag]
 192     set iW [expr {[lindex $b 2]-[lindex $b 0]}]
 193     set iH [expr {[lindex $b 3]-[lindex $b 1]}]
 194     if {$data(maxIW) < $iW} {
 195         set data(maxIW) $iW
 196     }
 197     if {$data(maxIH) < $iH} {
 198         set data(maxIH) $iH
 199     }
 200
 201     set b [$data(canvas) bbox $tTag]
 202     set tW [expr {[lindex $b 2]-[lindex $b 0]}]
 203     set tH [expr {[lindex $b 3]-[lindex $b 1]}]
 204     if {$data(maxTW) < $tW} {
 205         set data(maxTW) $tW
 206     }
 207     if {$data(maxTH) < $tH} {
 208         set data(maxTH) $tH
 209     }
 210
 211     lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW $tH $data(numItems)]
 212     set itemList($rTag) [list $iTag $tTag $text $data(numItems)]
 213     set textList($data(numItems)) [string tolower $text]
 214     incr data(numItems)
 215 }
 216
 217 # Places the icons in a column-major arrangement.
 218 #
 219 proc tkIconList_Arrange {w} {
 220     upvar #0 $w data
 221
 222     if {![info exists data(list)]} {
 223         if {[info exists data(canvas)] && [winfo exists $data(canvas)]} {
 224             set data(noScroll) 1
 225             $data(sbar) config -command ""
 226         }
 227         return
 228     }
 229
 230     set W [winfo width  $data(canvas)]
 231     set H [winfo height $data(canvas)]
 232     set pad [expr {[$data(canvas) cget -highlightthickness] + \
 233             [$data(canvas) cget -bd]}]
 234     if {$pad < 2} {
 235         set pad 2
 236     }
 237
 238     incr W -[expr {$pad*2}]
 239     incr H -[expr {$pad*2}]
 240
 241     set dx [expr {$data(maxIW) + $data(maxTW) + 8}]
 242     if {$data(maxTH) > $data(maxIH)} {
 243         set dy $data(maxTH)
 244     } else {
 245         set dy $data(maxIH)
 246     }
 247     incr dy 2
 248     set shift [expr {$data(maxIW) + 4}]
 249
 250     set x [expr {$pad * 2}]
 251     set y [expr {$pad * 1}] ; # Why * 1 ?
 252     set usedColumn 0
 253     foreach sublist $data(list) {
 254         set usedColumn 1
 255         set iTag [lindex $sublist 0]
 256         set tTag [lindex $sublist 1]
 257         set rTag [lindex $sublist 2]
 258         set iW   [lindex $sublist 3]
 259         set iH   [lindex $sublist 4]
 260         set tW   [lindex $sublist 5]
 261         set tH   [lindex $sublist 6]
 262
 263         set i_dy [expr {($dy - $iH)/2}]
 264         set t_dy [expr {($dy - $tH)/2}]
 265
 266         $data(canvas) coords $iTag $x                    [expr {$y + $i_dy}]
 267         $data(canvas) coords $tTag [expr {$x + $shift}]  [expr {$y + $t_dy}]
 268         $data(canvas) coords $tTag [expr {$x + $shift}]  [expr {$y + $t_dy}]
 269         $data(canvas) coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]
 270
 271         incr y $dy
 272         if {($y + $dy) > $H} {
 273             set y [expr {$pad * 1}] ; # *1 ?
 274             incr x $dx
 275             set usedColumn 0
 276         }
 277     }
 278
 279     if {$usedColumn} {
 280         set sW [expr {$x + $dx}]
 281     } else {
 282         set sW $x
 283     }
 284
 285     if {$sW < $W} {
 286         $data(canvas) config -scrollregion [list $pad $pad $sW $H]
 287         $data(sbar) config -command ""
 288         $data(canvas) xview moveto 0
 289         set data(noScroll) 1
 290     } else {
 291         $data(canvas) config -scrollregion [list $pad $pad $sW $H]
 292         $data(sbar) config -command [list $data(canvas) xview]
 293         set data(noScroll) 0
 294     }
 295
 296     set data(itemsPerColumn) [expr {($H-$pad)/$dy}]
 297     if {$data(itemsPerColumn) < 1} {
 298         set data(itemsPerColumn) 1
 299     }
 300
 301     if {$data(curItem) != ""} {
 302         tkIconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 0
 303     }
 304 }
 305
 306 # Gets called when the user invokes the IconList (usually by double-clicking
 307 # or pressing the Return key).
 308 #
 309 proc tkIconList_Invoke {w} {
 310     upvar #0 $w data
 311
 312     if {$data(-command) != "" && [info exists data(selected)]} {
 313         uplevel #0 $data(-command)
 314     }
 315 }
 316
 317 # tkIconList_See --
 318 #
 319 #       If the item is not (completely) visible, scroll the canvas so that
 320 #       it becomes visible.
 321 proc tkIconList_See {w rTag} {
 322     upvar #0 $w data
 323     upvar #0 $w:itemList itemList
 324
 325     if {$data(noScroll)} {
 326         return
 327     }
 328     set sRegion [$data(canvas) cget -scrollregion]
 329     if {[string equal $sRegion {}]} {
 330         return
 331     }
 332
 333     if {![info exists itemList($rTag)]} {
 334         return
 335     }
 336
 337
 338     set bbox [$data(canvas) bbox $rTag]
 339     set pad [expr {[$data(canvas) cget -highlightthickness] + \
 340             [$data(canvas) cget -bd]}]
 341
 342     set x1 [lindex $bbox 0]
 343     set x2 [lindex $bbox 2]
 344     incr x1 -[expr {$pad * 2}]
 345     incr x2 -[expr {$pad * 1}] ; # *1 ?
 346
 347     set cW [expr {[winfo width $data(canvas)] - $pad*2}]
 348
 349     set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}]
 350     set dispX [expr {int([lindex [$data(canvas) xview] 0]*$scrollW)}]
 351     set oldDispX $dispX
 352
 353     # check if out of the right edge
 354     #
 355     if {($x2 - $dispX) >= $cW} {
 356         set dispX [expr {$x2 - $cW}]
 357     }
 358     # check if out of the left edge
 359     #
 360     if {($x1 - $dispX) < 0} {
 361         set dispX $x1
 362     }
 363
 364     if {$oldDispX != $dispX} {
 365         set fraction [expr {double($dispX)/double($scrollW)}]
 366         $data(canvas) xview moveto $fraction
 367     }
 368 }
 369
 370 proc tkIconList_SelectAtXY {w x y} {
 371     upvar #0 $w data
 372
 373     tkIconList_Select $w [$data(canvas) find closest \
 374             [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]
 375 }
 376
 377 proc tkIconList_Select {w rTag {callBrowse 1}} {
 378     upvar #0 $w data
 379     upvar #0 $w:itemList itemList
 380
 381     if {![info exists itemList($rTag)]} {
 382         return
 383     }
 384     set iTag   [lindex $itemList($rTag) 0]
 385     set tTag   [lindex $itemList($rTag) 1]
 386     set text   [lindex $itemList($rTag) 2]
 387     set serial [lindex $itemList($rTag) 3]
 388
 389     if {![info exists data(rect)]} {
 390         set data(rect) [$data(canvas) create rect 0 0 0 0 \
 391                 -fill #a0a0ff -outline #a0a0ff]
 392     }
 393     $data(canvas) lower $data(rect)
 394     set bbox [$data(canvas) bbox $tTag]
 395     eval [list $data(canvas) coords $data(rect)] $bbox
 396
 397     set data(curItem) $serial
 398     set data(selected) $text
 399
 400     if {$callBrowse && $data(-browsecmd) != ""} {
 401         eval $data(-browsecmd) [list $text]
 402     }
 403 }
 404
 405 proc tkIconList_Unselect {w} {
 406     upvar #0 $w data
 407
 408     if {[info exists data(rect)]} {
 409         $data(canvas) delete $data(rect)
 410         unset data(rect)
 411     }
 412     if {[info exists data(selected)]} {
 413         unset data(selected)
 414     }
 415     #set data(curItem)  {}
 416 }
 417
 418 # Returns the selected item
 419 #
 420 proc tkIconList_Get {w} {
 421     upvar #0 $w data
 422
 423     if {[info exists data(selected)]} {
 424         return $data(selected)
 425     } else {
 426         return ""
 427     }
 428 }
 429
 430
 431 proc tkIconList_Btn1 {w x y} {
 432     upvar #0 $w data
 433
 434     focus $data(canvas)
 435     tkIconList_SelectAtXY $w $x $y
 436 }
 437
 438 # Gets called on button-1 motions
 439 #
 440 proc tkIconList_Motion1 {w x y} {
 441     global tkPriv
 442     set tkPriv(x) $x
 443     set tkPriv(y) $y
 444
 445     tkIconList_SelectAtXY $w $x $y
 446 }
 447
 448 proc tkIconList_Double1 {w x y} {
 449     upvar #0 $w data
 450
 451     if {[string compare $data(curItem) {}]} {
 452         tkIconList_Invoke $w
 453     }
 454 }
 455
 456 proc tkIconList_ReturnKey {w} {
 457     tkIconList_Invoke $w
 458 }
 459
 460 proc tkIconList_Leave1 {w x y} {
 461     global tkPriv
 462
 463     set tkPriv(x) $x
 464     set tkPriv(y) $y
 465     tkIconList_AutoScan $w
 466 }
 467
 468 proc tkIconList_FocusIn {w} {
 469     upvar #0 $w data
 470
 471     if {![info exists data(list)]} {
 472         return
 473     }
 474
 475     if {[string compare $data(curItem) {}]} {
 476         tkIconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 1
 477     }
 478 }
 479
 480 # tkIconList_UpDown --
 481 #
 482 # Moves the active element up or down by one element
 483 #
 484 # Arguments:
 485 # w -           The IconList widget.
 486 # amount -      +1 to move down one item, -1 to move back one item.
 487 #
 488 proc tkIconList_UpDown {w amount} {
 489     upvar #0 $w data
 490
 491     if {![info exists data(list)]} {
 492         return
 493     }
 494
 495     if {[string equal $data(curItem) {}]} {
 496         set rTag [lindex [lindex $data(list) 0] 2]
 497     } else {
 498         set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
 499         set rTag [lindex [lindex $data(list) [expr {$data(curItem)+$amount}]] 2]
 500         if {[string equal $rTag ""]} {
 501             set rTag $oldRTag
 502         }
 503     }
 504
 505     if {[string compare $rTag ""]} {
 506         tkIconList_Select $w $rTag
 507         tkIconList_See $w $rTag
 508     }
 509 }
 510
 511 # tkIconList_LeftRight --
 512 #
 513 # Moves the active element left or right by one column
 514 #
 515 # Arguments:
 516 # w -           The IconList widget.
 517 # amount -      +1 to move right one column, -1 to move left one column.
 518 #
 519 proc tkIconList_LeftRight {w amount} {
 520     upvar #0 $w data
 521
 522     if {![info exists data(list)]} {
 523         return
 524     }
 525     if {[string equal $data(curItem) {}]} {
 526         set rTag [lindex [lindex $data(list) 0] 2]
 527     } else {
 528         set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
 529         set newItem [expr {$data(curItem)+($amount*$data(itemsPerColumn))}]
 530         set rTag [lindex [lindex $data(list) $newItem] 2]
 531         if {[string equal $rTag ""]} {
 532             set rTag $oldRTag
 533         }
 534     }
 535
 536     if {[string compare $rTag ""]} {
 537         tkIconList_Select $w $rTag
 538         tkIconList_See $w $rTag
 539     }
 540 }
 541
 542 #----------------------------------------------------------------------
 543 #               Accelerator key bindings
 544 #----------------------------------------------------------------------
 545
 546 # tkIconList_KeyPress --
 547 #
 548 #       Gets called when user enters an arbitrary key in the listbox.
 549 #
 550 proc tkIconList_KeyPress {w key} {
 551     global tkPriv
 552
 553     append tkPriv(ILAccel,$w) $key
 554     tkIconList_Goto $w $tkPriv(ILAccel,$w)
 555     catch {
 556         after cancel $tkPriv(ILAccel,$w,afterId)
 557     }
 558     set tkPriv(ILAccel,$w,afterId) [after 500 [list tkIconList_Reset $w]]
 559 }
 560
 561 proc tkIconList_Goto {w text} {
 562     upvar #0 $w data
 563     upvar #0 $w:textList textList
 564     global tkPriv
 565
 566     if {![info exists data(list)]} {
 567         return
 568     }
 569
 570     if {[string equal {} $text]} {
 571         return
 572     }
 573
 574     if {$data(curItem) == "" || $data(curItem) == 0} {
 575         set start  0
 576     } else {
 577         set start  $data(curItem)
 578     }
 579
 580     set text [string tolower $text]
 581     set theIndex -1
 582     set less 0
 583     set len [string length $text]
 584     set len0 [expr {$len-1}]
 585     set i $start
 586
 587     # Search forward until we find a filename whose prefix is an exact match
 588     # with $text
 589     while {1} {
 590         set sub [string range $textList($i) 0 $len0]
 591         if {[string equal $text $sub]} {
 592             set theIndex $i
 593             break
 594         }
 595         incr i
 596         if {$i == $data(numItems)} {
 597             set i 0
 598         }
 599         if {$i == $start} {
 600             break
 601         }
 602     }
 603
 604     if {$theIndex > -1} {
 605         set rTag [lindex [lindex $data(list) $theIndex] 2]
 606         tkIconList_Select $w $rTag
 607         tkIconList_See $w $rTag
 608     }
 609 }
 610
 611 proc tkIconList_Reset {w} {
 612     global tkPriv
 613
 614     catch {unset tkPriv(ILAccel,$w)}
 615 }
 616
 617 #----------------------------------------------------------------------
 618 #
 619 #                     F I L E   D I A L O G
 620 #
 621 #----------------------------------------------------------------------
 622
 623 namespace eval ::tk::dialog {}
 624 namespace eval ::tk::dialog::file {}
 625
 626 # ::tk::dialog::file::tkFDialog --
 627 #
 628 #       Implements the TK file selection dialog. This dialog is used when
 629 #       the tk_strictMotif flag is set to false. This procedure shouldn't
 630 #       be called directly. Call tk_getOpenFile or tk_getSaveFile instead.
 631 #
 632 # Arguments:
 633 #       type            "open" or "save"
 634 #       args            Options parsed by the procedure.
 635 #
 636
 637 proc ::tk::dialog::file::tkFDialog {type args} {
 638     global tkPriv
 639     set dataName __tk_filedialog
 640     upvar ::tk::dialog::file::$dataName data
 641
 642     ::tk::dialog::file::Config $dataName $type $args
 643
 644     if {[string equal $data(-parent) .]} {
 645         set w .$dataName
 646     } else {
 647         set w $data(-parent).$dataName
 648     }
 649
 650     # (re)create the dialog box if necessary
 651     #
 652     if {![winfo exists $w]} {
 653         ::tk::dialog::file::Create $w TkFDialog
 654     } elseif {[string compare [winfo class $w] TkFDialog]} {
 655         destroy $w
 656         ::tk::dialog::file::Create $w TkFDialog
 657     } else {
 658         set data(dirMenuBtn) $w.f1.menu
 659         set data(dirMenu) $w.f1.menu.menu
 660         set data(upBtn) $w.f1.up
 661         set data(icons) $w.icons
 662         set data(ent) $w.f2.ent
 663         set data(typeMenuLab) $w.f3.lab
 664         set data(typeMenuBtn) $w.f3.menu
 665         set data(typeMenu) $data(typeMenuBtn).m
 666         set data(okBtn) $w.f2.ok
 667         set data(cancelBtn) $w.f3.cancel
 668     }
 669     wm transient $w $data(-parent)
 670
 671     # Add traces on the selectPath variable
 672     #
 673
 674     trace variable data(selectPath) w "::tk::dialog::file::SetPath $w"
 675     $data(dirMenuBtn) configure \
 676             -textvariable ::tk::dialog::file::${dataName}(selectPath)
 677
 678     # Initialize the file types menu
 679     #
 680     if {[llength $data(-filetypes)]} {
 681         $data(typeMenu) delete 0 end
 682         foreach type $data(-filetypes) {
 683             set title  [lindex $type 0]
 684             set filter [lindex $type 1]
 685             $data(typeMenu) add command -label $title \
 686                 -command [list ::tk::dialog::file::SetFilter $w $type]
 687         }
 688         ::tk::dialog::file::SetFilter $w [lindex $data(-filetypes) 0]
 689         $data(typeMenuBtn) config -state normal
 690         $data(typeMenuLab) config -state normal
 691     } else {
 692         set data(filter) "*"
 693         $data(typeMenuBtn) config -state disabled -takefocus 0
 694         $data(typeMenuLab) config -state disabled
 695     }
 696     ::tk::dialog::file::UpdateWhenIdle $w
 697
 698     # Withdraw the window, then update all the geometry information
 699     # so we know how big it wants to be, then center the window in the
 700     # display and de-iconify it.
 701
 702     ::tk::PlaceWindow $w widget $data(-parent)
 703     wm title $w $data(-title)
 704
 705     # Set a grab and claim the focus too.
 706
 707     ::tk::SetFocusGrab $w $data(ent)
 708     $data(ent) delete 0 end
 709     $data(ent) insert 0 $data(selectFile)
 710     $data(ent) selection range 0 end
 711     $data(ent) icursor end
 712
 713     # Wait for the user to respond, then restore the focus and
 714     # return the index of the selected button.  Restore the focus
 715     # before deleting the window, since otherwise the window manager
 716     # may take the focus away so we can't redirect it.  Finally,
 717     # restore any grab that was in effect.
 718
 719     tkwait variable tkPriv(selectFilePath)
 720
 721     ::tk::RestoreFocusGrab $w $data(ent) withdraw
 722
 723     # Cleanup traces on selectPath variable
 724     #
 725
 726     foreach trace [trace vinfo data(selectPath)] {
 727         trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]
 728     }
 729     $data(dirMenuBtn) configure -textvariable {}
 730
 731     return $tkPriv(selectFilePath)
 732 }
 733
 734 # ::tk::dialog::file::Config --
 735 #
 736 #       Configures the TK filedialog according to the argument list
 737 #
 738 proc ::tk::dialog::file::Config {dataName type argList} {
 739     upvar ::tk::dialog::file::$dataName data
 740
 741     set data(type) $type
 742
 743     # 0: Delete all variable that were set on data(selectPath) the
 744     # last time the file dialog is used. The traces may cause troubles
 745     # if the dialog is now used with a different -parent option.
 746
 747     foreach trace [trace vinfo data(selectPath)] {
 748         trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]
 749     }
 750
 751     # 1: the configuration specs
 752     #
 753     set specs {
 754         {-defaultextension "" "" ""}
 755         {-filetypes "" "" ""}
 756         {-initialdir "" "" ""}
 757         {-initialfile "" "" ""}
 758         {-parent "" "" "."}
 759         {-title "" "" ""}
 760     }
 761
 762     # 2: default values depending on the type of the dialog
 763     #
 764     if {![info exists data(selectPath)]} {
 765         # first time the dialog has been popped up
 766         set data(selectPath) [pwd]
 767         set data(selectFile) ""
 768     }
 769
 770     # 3: parse the arguments
 771     #
 772     tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
 773
 774     if {$data(-title) == ""} {
 775         if {[string equal $type "open"]} {
 776             set data(-title) "Open"
 777         } else {
 778             set data(-title) "Save As"
 779         }
 780     }
 781
 782     # 4: set the default directory and selection according to the -initial
 783     #    settings
 784     #
 785     if {$data(-initialdir) != ""} {
 786         # Ensure that initialdir is an absolute path name.
 787         if {[file isdirectory $data(-initialdir)]} {
 788             set old [pwd]
 789             cd $data(-initialdir)
 790             set data(selectPath) [pwd]
 791             cd $old
 792         } else {
 793             set data(selectPath) [pwd]
 794         }
 795     }
 796     set data(selectFile) $data(-initialfile)
 797
 798     # 5. Parse the -filetypes option
 799     #
 800     set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]
 801
 802     if {![winfo exists $data(-parent)]} {
 803         error "bad window path name \"$data(-parent)\""
 804     }
 805 }
 806
 807 proc ::tk::dialog::file::Create {w class} {
 808     set dataName [lindex [split $w .] end]
 809     upvar ::tk::dialog::file::$dataName data
 810     global tk_library tkPriv
 811
 812     toplevel $w -class $class
 813
 814     # f1: the frame with the directory option menu
 815     #
 816     set f1 [frame $w.f1]
 817     label $f1.lab -text "Directory:" -under 0
 818     set data(dirMenuBtn) $f1.menu
 819     set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) ::tk::dialog::file::$dataName] ""]
 820     set data(upBtn) [button $f1.up]
 821     if {![info exists tkPriv(updirImage)]} {
 822         set tkPriv(updirImage) [image create bitmap -data {
 823 #define updir_width 28
 824 #define updir_height 16
 825 static char updir_bits[] = {
 826    0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
 827    0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
 828    0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
 829    0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
 830    0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
 831    0xf0, 0xff, 0xff, 0x01};}]
 832     }
 833     $data(upBtn) config -image $tkPriv(updirImage)
 834
 835     $f1.menu config -takefocus 1 -highlightthickness 2
 836
 837     pack $data(upBtn) -side right -padx 4 -fill both
 838     pack $f1.lab -side left -padx 4 -fill both
 839     pack $f1.menu -expand yes -fill both -padx 4
 840
 841     # data(icons): the IconList that list the files and directories.
 842     #
 843     if { [string equal $class TkFDialog] } {
 844         set fNameCaption "File name:"
 845         set fNameUnder 5
 846         set iconListCommand [list ::tk::dialog::file::OkCmd $w]
 847     } else {
 848         set fNameCaption "Selection:"
 849         set fNameUnder 0
 850         set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w]
 851     }
 852     set data(icons) [tkIconList $w.icons \
 853         -browsecmd [list ::tk::dialog::file::ListBrowse $w] \
 854         -command   $iconListCommand]
 855
 856     # f2: the frame with the OK button and the "file name" field
 857     #
 858     set f2 [frame $w.f2 -bd 0]
 859     label $f2.lab -text $fNameCaption -anchor e -width 14 \
 860             -under $fNameUnder -pady 0
 861     set data(ent) [entry $f2.ent]
 862
 863     # The font to use for the icons. The default Canvas font on Unix
 864     # is just deviant.
 865     global $w.icons
 866     set $w.icons(font) [$data(ent) cget -font]
 867
 868     # f3: the frame with the cancel button and the file types field
 869     #
 870     set f3 [frame $w.f3 -bd 0]
 871
 872     # Make the file types bits only if this is a File Dialog
 873     if { [string equal $class TkFDialog] } {
 874         # The "File of types:" label needs to be grayed-out when
 875         # -filetypes are not specified. The label widget does not support
 876         # grayed-out text on monochrome displays. Therefore, we have to
 877         # use a button widget to emulate a label widget (by setting its
 878         # bindtags)
 879
 880         set data(typeMenuLab) [button $f3.lab -text "Files of type:" \
 881                 -anchor e -width 14 -under 9 \
 882                 -bd [$f2.lab cget -bd] \
 883                 -highlightthickness [$f2.lab cget -highlightthickness] \
 884                 -relief [$f2.lab cget -relief] \
 885                 -padx [$f2.lab cget -padx] \
 886                 -pady [$f2.lab cget -pady]]
 887         bindtags $data(typeMenuLab) [list $data(typeMenuLab) Label \
 888                 [winfo toplevel $data(typeMenuLab)] all]
 889
 890         set data(typeMenuBtn) [menubutton $f3.menu -indicatoron 1 \
 891                 -menu $f3.menu.m]
 892         set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]
 893         $data(typeMenuBtn) config -takefocus 1 -highlightthickness 2 \
 894                 -relief raised -bd 2 -anchor w
 895     }
 896
 897     # the okBtn is created after the typeMenu so that the keyboard traversal
 898     # is in the right order
 899     set data(okBtn)     [button $f2.ok     -text OK     -under 0 -width 6 \
 900         -default active -pady 3]
 901     set data(cancelBtn) [button $f3.cancel -text Cancel -under 0 -width 6\
 902         -default normal -pady 3]
 903
 904     # pack the widgets in f2 and f3
 905     #
 906     pack $data(okBtn) -side right -padx 4 -anchor e
 907     pack $f2.lab -side left -padx 4
 908     pack $f2.ent -expand yes -fill x -padx 2 -pady 0
 909
 910     pack $data(cancelBtn) -side right -padx 4 -anchor w
 911     if { [string equal $class TkFDialog] } {
 912         pack $data(typeMenuLab) -side left -padx 4
 913         pack $data(typeMenuBtn) -expand yes -fill x -side right
 914     }
 915
 916     # Pack all the frames together. We are done with widget construction.
 917     #
 918     pack $f1 -side top -fill x -pady 4
 919     pack $f3 -side bottom -fill x
 920     pack $f2 -side bottom -fill x
 921     pack $data(icons) -expand yes -fill both -padx 4 -pady 1
 922
 923     # Set up the event handlers that are common to Directory and File Dialogs
 924     #
 925
 926     wm protocol $w WM_DELETE_WINDOW [list ::tk::dialog::file::CancelCmd $w]
 927     $data(upBtn)     config -command [list ::tk::dialog::file::UpDirCmd $w]
 928     $data(cancelBtn) config -command [list ::tk::dialog::file::CancelCmd $w]
 929     bind $w <KeyPress-Escape> [list tkButtonInvoke $data(cancelBtn)]
 930     bind $w <Alt-c> [list tkButtonInvoke $data(cancelBtn)]
 931     bind $w <Alt-d> [list focus $data(dirMenuBtn)]
 932
 933     # Set up event handlers specific to File or Directory Dialogs
 934     #
 935
 936     if { [string equal $class TkFDialog] } {
 937         bind $data(ent) <Return> [list ::tk::dialog::file::ActivateEnt $w]
 938         $data(okBtn)     config -command [list ::tk::dialog::file::OkCmd $w]
 939         bind $w <Alt-t> [format {
 940             if {[string equal [%s cget -state] "normal"]} {
 941                 focus %s
 942             }
 943         } $data(typeMenuBtn) $data(typeMenuBtn)]
 944         bind $w <Alt-n> [list focus $data(ent)]
 945         bind $w <Alt-o> [list ::tk::dialog::file::InvokeBtn $w Open]
 946         bind $w <Alt-s> [list ::tk::dialog::file::InvokeBtn $w Save]
 947     } else {
 948         set okCmd [list ::tk::dialog::file::chooseDir::OkCmd $w]
 949         bind $data(ent) <Return> $okCmd
 950         $data(okBtn) config -command $okCmd
 951         bind $w <Alt-s> [list focus $data(ent)]
 952         bind $w <Alt-o> [list tkButtonInvoke $data(okBtn)]
 953     }
 954
 955     # Build the focus group for all the entries
 956     #
 957     tkFocusGroup_Create $w
 958     tkFocusGroup_BindIn $w  $data(ent) [list ::tk::dialog::file::EntFocusIn $w]
 959     tkFocusGroup_BindOut $w $data(ent) [list ::tk::dialog::file::EntFocusOut $w]
 960 }
 961
 962 # ::tk::dialog::file::UpdateWhenIdle --
 963 #
 964 #       Creates an idle event handler which updates the dialog in idle
 965 #       time. This is important because loading the directory may take a long
 966 #       time and we don't want to load the same directory for multiple times
 967 #       due to multiple concurrent events.
 968 #
 969 proc ::tk::dialog::file::UpdateWhenIdle {w} {
 970     upvar ::tk::dialog::file::[winfo name $w] data
 971
 972     if {[info exists data(updateId)]} {
 973         return
 974     } else {
 975         set data(updateId) [after idle [list ::tk::dialog::file::Update $w]]
 976     }
 977 }
 978
 979 # ::tk::dialog::file::Update --
 980 #
 981 #       Loads the files and directories into the IconList widget. Also
 982 #       sets up the directory option menu for quick access to parent
 983 #       directories.
 984 #
 985 proc ::tk::dialog::file::Update {w} {
 986
 987     # This proc may be called within an idle handler. Make sure that the
 988     # window has not been destroyed before this proc is called
 989     if {![winfo exists $w]} {
 990         return
 991     }
 992     set class [winfo class $w]
 993     if { [string compare $class TkFDialog] && \
 994             [string compare $class TkChooseDir] } {
 995         return
 996     }
 997
 998     set dataName [winfo name $w]
 999     upvar ::tk::dialog::file::$dataName data
1000     global tk_library tkPriv
1001     catch {unset data(updateId)}
1002
1003     if {![info exists tkPriv(folderImage)]} {
1004         set tkPriv(folderImage) [image create photo -data {
1005 R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB
1006 QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]
1007         set tkPriv(fileImage)   [image create photo -data {
1008 R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO
1009 rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
1010     }
1011     set folder $tkPriv(folderImage)
1012     set file   $tkPriv(fileImage)
1013
1014     set appPWD [pwd]
1015     if {[catch {
1016         cd $data(selectPath)
1017     }]} {
1018         # We cannot change directory to $data(selectPath). $data(selectPath)
1019         # should have been checked before ::tk::dialog::file::Update is called, so
1020         # we normally won't come to here. Anyways, give an error and abort
1021         # action.
1022         tk_messageBox -type ok -parent $w -message \
1023             "Cannot change to the directory \"$data(selectPath)\".\nPermission denied."\
1024             -icon warning
1025         cd $appPWD
1026         return
1027     }
1028
1029     # Turn on the busy cursor. BUG?? We haven't disabled X events, though,
1030     # so the user may still click and cause havoc ...
1031     #
1032     set entCursor [$data(ent) cget -cursor]
1033     set dlgCursor [$w         cget -cursor]
1034     $data(ent) config -cursor watch
1035     $w         config -cursor watch
1036     update idletasks
1037
1038     tkIconList_DeleteAll $data(icons)
1039
1040     # Make the dir list
1041     #
1042     foreach f [lsort -dictionary [glob -nocomplain .* *]] {
1043         if {[string equal $f .]} {
1044             continue
1045         }
1046         if {[string equal $f ..]} {
1047             continue
1048         }
1049         if {[file isdir ./$f]} {
1050             if {![info exists hasDoneDir($f)]} {
1051                 tkIconList_Add $data(icons) $folder $f
1052                 set hasDoneDir($f) 1
1053             }
1054         }
1055     }
1056     if { [string equal $class TkFDialog] } {
1057         # Make the file list if this is a File Dialog
1058         #
1059         if {[string equal $data(filter) *]} {
1060             set files [lsort -dictionary \
1061                     [glob -nocomplain .* *]]
1062         } else {
1063             set files [lsort -dictionary \
1064                     [eval glob -nocomplain $data(filter)]]
1065         }
1066
1067         foreach f $files {
1068             if {![file isdir ./$f]} {
1069                 if {![info exists hasDoneFile($f)]} {
1070                     tkIconList_Add $data(icons) $file $f
1071                     set hasDoneFile($f) 1
1072                 }
1073             }
1074         }
1075     }
1076
1077     tkIconList_Arrange $data(icons)
1078
1079     # Update the Directory: option menu
1080     #
1081     set list ""
1082     set dir ""
1083     foreach subdir [file split $data(selectPath)] {
1084         set dir [file join $dir $subdir]
1085         lappend list $dir
1086     }
1087
1088     $data(dirMenu) delete 0 end
1089     set var [format %s(selectPath) ::tk::dialog::file::$dataName]
1090     foreach path $list {
1091         $data(dirMenu) add command -label $path -command [list set $var $path]
1092     }
1093
1094     # Restore the PWD to the application's PWD
1095     #
1096     cd $appPWD
1097
1098     if { [string equal $class TkFDialog] } {
1099         # Restore the Open/Save Button if this is a File Dialog
1100         #
1101         if {[string equal $data(type) open]} {
1102             $data(okBtn) config -text "Open"
1103         } else {
1104             $data(okBtn) config -text "Save"
1105         }
1106     }
1107
1108     # turn off the busy cursor.
1109     #
1110     $data(ent) config -cursor $entCursor
1111     $w         config -cursor $dlgCursor
1112 }
1113
1114 # ::tk::dialog::file::SetPathSilently --
1115 #
1116 #       Sets data(selectPath) without invoking the trace procedure
1117 #
1118 proc ::tk::dialog::file::SetPathSilently {w path} {
1119     upvar ::tk::dialog::file::[winfo name $w] data
1120
1121     trace vdelete  data(selectPath) w [list ::tk::dialog::file::SetPath $w]
1122     set data(selectPath) $path
1123     trace variable data(selectPath) w [list ::tk::dialog::file::SetPath $w]
1124 }
1125
1126
1127 # This proc gets called whenever data(selectPath) is set
1128 #
1129 proc ::tk::dialog::file::SetPath {w name1 name2 op} {
1130     if {[winfo exists $w]} {
1131         upvar ::tk::dialog::file::[winfo name $w] data
1132         ::tk::dialog::file::UpdateWhenIdle $w
1133         # On directory dialogs, we keep the entry in sync with the currentdir.
1134         if { [string equal [winfo class $w] TkChooseDir] } {
1135             $data(ent) delete 0 end
1136             $data(ent) insert end $data(selectPath)
1137         }
1138     }
1139 }
1140
1141 # This proc gets called whenever data(filter) is set
1142 #
1143 proc ::tk::dialog::file::SetFilter {w type} {
1144     upvar ::tk::dialog::file::[winfo name $w] data
1145     upvar \#0 $data(icons) icons
1146
1147     set data(filter) [lindex $type 1]
1148     $data(typeMenuBtn) config -text [lindex $type 0] -indicatoron 1
1149
1150     $icons(sbar) set 0.0 0.0
1151
1152     ::tk::dialog::file::UpdateWhenIdle $w
1153 }
1154
1155 # tk::dialog::file::ResolveFile --
1156 #
1157 #       Interpret the user's text input in a file selection dialog.
1158 #       Performs:
1159 #
1160 #       (1) ~ substitution
1161 #       (2) resolve all instances of . and ..
1162 #       (3) check for non-existent files/directories
1163 #       (4) check for chdir permissions
1164 #
1165 # Arguments:
1166 #       context:  the current directory you are in
1167 #       text:     the text entered by the user
1168 #       defaultext: the default extension to add to files with no extension
1169 #
1170 # Return vaue:
1171 #       [list $flag $directory $file]
1172 #
1173 #        flag = OK      : valid input
1174 #             = PATTERN : valid directory/pattern
1175 #             = PATH    : the directory does not exist
1176 #             = FILE    : the directory exists by the file doesn't
1177 #                         exist
1178 #             = CHDIR   : Cannot change to the directory
1179 #             = ERROR   : Invalid entry
1180 #
1181 #        directory      : valid only if flag = OK or PATTERN or FILE
1182 #        file           : valid only if flag = OK or PATTERN
1183 #
1184 #       directory may not be the same as context, because text may contain
1185 #       a subdirectory name
1186 #
1187 proc ::tk::dialog::file::ResolveFile {context text defaultext} {
1188
1189     set appPWD [pwd]
1190
1191     set path [::tk::dialog::file::JoinFile $context $text]
1192
1193     # If the file has no extension, append the default.  Be careful not
1194     # to do this for directories, otherwise typing a dirname in the box
1195     # will give back "dirname.extension" instead of trying to change dir.
1196     if {![file isdirectory $path] && [string equal [file ext $path] ""]} {
1197         set path "$path$defaultext"
1198     }
1199
1200
1201     if {[catch {file exists $path}]} {
1202         # This "if" block can be safely removed if the following code
1203         # stop generating errors.
1204         #
1205         #       file exists ~nonsuchuser
1206         #
1207         return [list ERROR $path ""]
1208     }
1209
1210     if {[file exists $path]} {
1211         if {[file isdirectory $path]} {
1212             if {[catch {cd $path}]} {
1213                 return [list CHDIR $path ""]
1214             }
1215             set directory [pwd]
1216             set file ""
1217             set flag OK
1218             cd $appPWD
1219         } else {
1220             if {[catch {cd [file dirname $path]}]} {
1221                 return [list CHDIR [file dirname $path] ""]
1222             }
1223             set directory [pwd]
1224             set file [file tail $path]
1225             set flag OK
1226             cd $appPWD
1227         }
1228     } else {
1229         set dirname [file dirname $path]
1230         if {[file exists $dirname]} {
1231             if {[catch {cd $dirname}]} {
1232                 return [list CHDIR $dirname ""]
1233             }
1234             set directory [pwd]
1235             set file [file tail $path]
1236             if {[regexp {[*]|[?]} $file]} {
1237                 set flag PATTERN
1238             } else {
1239                 set flag FILE
1240             }
1241             cd $appPWD
1242         } else {
1243             set directory $dirname
1244             set file [file tail $path]
1245             set flag PATH
1246         }
1247     }
1248
1249     return [list $flag $directory $file]
1250 }
1251
1252
1253 # Gets called when the entry box gets keyboard focus. We clear the selection
1254 # from the icon list . This way the user can be certain that the input in the
1255 # entry box is the selection.
1256 #
1257 proc ::tk::dialog::file::EntFocusIn {w} {
1258     upvar ::tk::dialog::file::[winfo name $w] data
1259
1260     if {[string compare [$data(ent) get] ""]} {
1261         $data(ent) selection range 0 end
1262         $data(ent) icursor end
1263     } else {
1264         $data(ent) selection clear
1265     }
1266
1267     tkIconList_Unselect $data(icons)
1268
1269     if { [string equal [winfo class $w] TkFDialog] } {
1270         # If this is a File Dialog, make sure the buttons are labeled right.
1271         if {[string equal $data(type) open]} {
1272             $data(okBtn) config -text "Open"
1273         } else {
1274             $data(okBtn) config -text "Save"
1275         }
1276     }
1277 }
1278
1279 proc ::tk::dialog::file::EntFocusOut {w} {
1280     upvar ::tk::dialog::file::[winfo name $w] data
1281
1282     $data(ent) selection clear
1283 }
1284
1285
1286 # Gets called when user presses Return in the "File name" entry.
1287 #
1288 proc ::tk::dialog::file::ActivateEnt {w} {
1289     upvar ::tk::dialog::file::[winfo name $w] data
1290
1291     set text [string trim [$data(ent) get]]
1292     set list [::tk::dialog::file::ResolveFile $data(selectPath) $text \
1293                   $data(-defaultextension)]
1294     set flag [lindex $list 0]
1295     set path [lindex $list 1]
1296     set file [lindex $list 2]
1297
1298     switch -- $flag {
1299         OK {
1300             if {[string equal $file ""]} {
1301                 # user has entered an existing (sub)directory
1302                 set data(selectPath) $path
1303                 $data(ent) delete 0 end
1304             } else {
1305                 ::tk::dialog::file::SetPathSilently $w $path
1306                 set data(selectFile) $file
1307                 ::tk::dialog::file::Done $w
1308             }
1309         }
1310         PATTERN {
1311             set data(selectPath) $path
1312             set data(filter) $file
1313         }
1314         FILE {
1315             if {[string equal $data(type) open]} {
1316                 tk_messageBox -icon warning -type ok -parent $w \
1317                     -message "File \"[file join $path $file]\" does not exist."
1318                 $data(ent) selection range 0 end
1319                 $data(ent) icursor end
1320             } else {
1321                 ::tk::dialog::file::SetPathSilently $w $path
1322                 set data(selectFile) $file
1323                 ::tk::dialog::file::Done $w
1324             }
1325         }
1326         PATH {
1327             tk_messageBox -icon warning -type ok -parent $w \
1328                 -message "Directory \"$path\" does not exist."
1329             $data(ent) selection range 0 end
1330             $data(ent) icursor end
1331         }
1332         CHDIR {
1333             tk_messageBox -type ok -parent $w -message \
1334                "Cannot change to the directory \"$path\".\nPermission denied."\
1335                 -icon warning
1336             $data(ent) selection range 0 end
1337             $data(ent) icursor end
1338         }
1339         ERROR {
1340             tk_messageBox -type ok -parent $w -message \
1341                "Invalid file name \"$path\"."\
1342                 -icon warning
1343             $data(ent) selection range 0 end
1344             $data(ent) icursor end
1345         }
1346     }
1347 }
1348
1349 # Gets called when user presses the Alt-s or Alt-o keys.
1350 #
1351 proc ::tk::dialog::file::InvokeBtn {w key} {
1352     upvar ::tk::dialog::file::[winfo name $w] data
1353
1354     if {[string equal [$data(okBtn) cget -text] $key]} {
1355         tkButtonInvoke $data(okBtn)
1356     }
1357 }
1358
1359 # Gets called when user presses the "parent directory" button
1360 #
1361 proc ::tk::dialog::file::UpDirCmd {w} {
1362     upvar ::tk::dialog::file::[winfo name $w] data
1363
1364     if {[string compare $data(selectPath) "/"]} {
1365         set data(selectPath) [file dirname $data(selectPath)]
1366     }
1367 }
1368
1369 # Join a file name to a path name. The "file join" command will break
1370 # if the filename begins with ~
1371 #
1372 proc ::tk::dialog::file::JoinFile {path file} {
1373     if {[string match {~*} $file] && [file exists $path/$file]} {
1374         return [file join $path ./$file]
1375     } else {
1376         return [file join $path $file]
1377     }
1378 }
1379
1380
1381
1382 # Gets called when user presses the "OK" button
1383 #
1384 proc ::tk::dialog::file::OkCmd {w} {
1385     upvar ::tk::dialog::file::[winfo name $w] data
1386
1387     set text [tkIconList_Get $data(icons)]
1388     if {[string compare $text ""]} {
1389         set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
1390         if {[file isdirectory $file]} {
1391             ::tk::dialog::file::ListInvoke $w $text
1392             return
1393         }
1394     }
1395
1396     ::tk::dialog::file::ActivateEnt $w
1397 }
1398
1399 # Gets called when user presses the "Cancel" button
1400 #
1401 proc ::tk::dialog::file::CancelCmd {w} {
1402     upvar ::tk::dialog::file::[winfo name $w] data
1403     global tkPriv
1404
1405     set tkPriv(selectFilePath) ""
1406 }
1407
1408 # Gets called when user browses the IconList widget (dragging mouse, arrow
1409 # keys, etc)
1410 #
1411 proc ::tk::dialog::file::ListBrowse {w text} {
1412     upvar ::tk::dialog::file::[winfo name $w] data
1413
1414     if {[string equal $text ""]} {
1415         return
1416     }
1417
1418     set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
1419     if {![file isdirectory $file]} {
1420         $data(ent) delete 0 end
1421         $data(ent) insert 0 $text
1422
1423         if { [string equal [winfo class $w] TkFDialog] } {
1424             if {[string equal $data(type) open]} {
1425                 $data(okBtn) config -text "Open"
1426             } else {
1427                 $data(okBtn) config -text "Save"
1428             }
1429         }
1430     } else {
1431         if { [string equal [winfo class $w] TkFDialog] } {
1432             $data(okBtn) config -text "Open"
1433         }
1434     }
1435 }
1436
1437 # Gets called when user invokes the IconList widget (double-click,
1438 # Return key, etc)
1439 #
1440 proc ::tk::dialog::file::ListInvoke {w text} {
1441     upvar ::tk::dialog::file::[winfo name $w] data
1442
1443     if {[string equal $text ""]} {
1444         return
1445     }
1446
1447     set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
1448     set class [winfo class $w]
1449     if {[string equal $class TkChooseDir] || [file isdirectory $file]} {
1450         set appPWD [pwd]
1451         if {[catch {cd $file}]} {
1452             tk_messageBox -type ok -parent $w -message \
1453                "Cannot change to the directory \"$file\".\nPermission denied."\
1454                 -icon warning
1455         } else {
1456             cd $appPWD
1457             set data(selectPath) $file
1458         }
1459     } else {
1460         set data(selectFile) $file
1461         ::tk::dialog::file::Done $w
1462     }
1463 }
1464
1465 # ::tk::dialog::file::Done --
1466 #
1467 #       Gets called when user has input a valid filename.  Pops up a
1468 #       dialog box to confirm selection when necessary. Sets the
1469 #       tkPriv(selectFilePath) variable, which will break the "tkwait"
1470 #       loop in tkFDialog and return the selected filename to the
1471 #       script that calls tk_getOpenFile or tk_getSaveFile
1472 #
1473 proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
1474     upvar ::tk::dialog::file::[winfo name $w] data
1475     global tkPriv
1476
1477     if {[string equal $selectFilePath ""]} {
1478         set selectFilePath [::tk::dialog::file::JoinFile $data(selectPath) \
1479                 $data(selectFile)]
1480         set tkPriv(selectFile)     $data(selectFile)
1481         set tkPriv(selectPath)     $data(selectPath)
1482
1483         if {[file exists $selectFilePath] && [string equal $data(type) save]} {
1484             set reply [tk_messageBox -icon warning -type yesno\
1485                     -parent $w -message "File\
1486                     \"$selectFilePath\" already exists.\nDo\
1487                     you want to overwrite it?"]
1488             if {[string equal $reply "no"]} {
1489                 return
1490             }
1491         }
1492     }
1493     set tkPriv(selectFilePath) $selectFilePath
1494 }
1495