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