home *** CD-ROM | disk | FTP | other *** search
/ PCNET 2006 September - Disc 1 / PCNET_CD_2006_09.iso / linux / puppy-barebones-2.01r2.iso / pup_201.sfs / usr / lib / tk8.5 / tkfbox.tcl < prev    next >
Encoding:
Text File  |  2006-06-17  |  49.1 KB  |  1,845 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. #    selecting 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: tkfbox.tcl,v 1.57 2006/04/10 21:33:45 dkf Exp $
  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. # ::tk::dialog::file:: dialog box.
  28. #
  29. #----------------------------------------------------------------------
  30.  
  31. # ::tk::IconList --
  32. #
  33. #    Creates an IconList widget.
  34. #
  35. proc ::tk::IconList {w args} {
  36.     IconList_Config $w $args
  37.     IconList_Create $w
  38. }
  39.  
  40. proc ::tk::IconList_Index {w i} {
  41.     upvar #0 ::tk::$w data ::tk::$w:itemList itemList
  42.     if {![info exists data(list)]} {
  43.     set data(list) {}
  44.     }
  45.     switch -regexp -- $i {
  46.     "^-?[0-9]+$" {
  47.         if {$i < 0} {
  48.         set i 0
  49.         }
  50.         if {$i >= [llength $data(list)]} {
  51.         set i [expr {[llength $data(list)] - 1}]
  52.         }
  53.         return $i
  54.     }
  55.     "^active$" {
  56.         return $data(index,active)
  57.     }
  58.     "^anchor$" {
  59.         return $data(index,anchor)
  60.     }
  61.     "^end$" {
  62.         return [llength $data(list)]
  63.     }
  64.     "@-?[0-9]+,-?[0-9]+" {
  65.         foreach {x y} [scan $i "@%d,%d"] {
  66.         break
  67.         }
  68.         set item [$data(canvas) find closest \
  69.             [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]
  70.         return [lindex [$data(canvas) itemcget $item -tags] 1]
  71.     }
  72.     }
  73. }
  74.  
  75. proc ::tk::IconList_Selection {w op args} {
  76.     upvar ::tk::$w data
  77.     switch -exact -- $op {
  78.     "anchor" {
  79.         if {[llength $args] == 1} {
  80.         set data(index,anchor) [tk::IconList_Index $w [lindex $args 0]]
  81.         } else {
  82.         return $data(index,anchor)
  83.         }
  84.     }
  85.     "clear" {
  86.         if {[llength $args] == 2} {
  87.         foreach {first last} $args {
  88.             break
  89.         }
  90.         } elseif {[llength $args] == 1} {
  91.         set first [set last [lindex $args 0]]
  92.         } else {
  93.         error "wrong # args: should be [lindex [info level 0] 0] path\
  94.             clear first ?last?"
  95.         }
  96.         set first [IconList_Index $w $first]
  97.         set last [IconList_Index $w $last]
  98.         if {$first > $last} {
  99.         set tmp $first
  100.         set first $last
  101.         set last $tmp
  102.         }
  103.         set ind 0
  104.         foreach item $data(selection) {
  105.         if { $item >= $first } {
  106.             set first $ind
  107.             break
  108.         }
  109.         incr ind
  110.         }
  111.         set ind [expr {[llength $data(selection)] - 1}]
  112.         for {} {$ind >= 0} {incr ind -1} {
  113.         set item [lindex $data(selection) $ind]
  114.         if { $item <= $last } {
  115.             set last $ind
  116.             break
  117.         }
  118.         }
  119.  
  120.         if { $first > $last } {
  121.         return
  122.         }
  123.         set data(selection) [lreplace $data(selection) $first $last]
  124.         event generate $w <<ListboxSelect>>
  125.         IconList_DrawSelection $w
  126.     }
  127.     "includes" {
  128.         set index [lsearch -exact $data(selection) [lindex $args 0]]
  129.         return [expr {$index != -1}]
  130.     }
  131.     "set" {
  132.         if { [llength $args] == 2 } {
  133.         foreach {first last} $args {
  134.             break
  135.         }
  136.         } elseif { [llength $args] == 1 } {
  137.         set last [set first [lindex $args 0]]
  138.         } else {
  139.         error "wrong # args: should be [lindex [info level 0] 0] path\
  140.             set first ?last?"
  141.         }
  142.  
  143.         set first [IconList_Index $w $first]
  144.         set last [IconList_Index $w $last]
  145.         if { $first > $last } {
  146.         set tmp $first
  147.         set first $last
  148.         set last $tmp
  149.         }
  150.         for {set i $first} {$i <= $last} {incr i} {
  151.         lappend data(selection) $i
  152.         }
  153.         set data(selection) [lsort -integer -unique $data(selection)]
  154.         event generate $w <<ListboxSelect>>
  155.         IconList_DrawSelection $w
  156.     }
  157.     }
  158. }
  159.  
  160. proc ::tk::IconList_CurSelection {w} {
  161.     upvar ::tk::$w data
  162.     return $data(selection)
  163. }
  164.  
  165. proc ::tk::IconList_DrawSelection {w} {
  166.     upvar ::tk::$w data
  167.     upvar ::tk::$w:itemList itemList
  168.  
  169.     $data(canvas) delete selection
  170.     foreach item $data(selection) {
  171.     set rTag [lindex [lindex $data(list) $item] 2]
  172.     foreach {iTag tTag text serial} $itemList($rTag) {
  173.         break
  174.     }
  175.  
  176.     set bbox [$data(canvas) bbox $tTag]
  177.     $data(canvas) create rect $bbox -fill \#a0a0ff -outline \#a0a0ff \
  178.         -tags selection
  179.     }
  180.     $data(canvas) lower selection
  181.     return
  182. }
  183.  
  184. proc ::tk::IconList_Get {w item} {
  185.     upvar ::tk::$w data
  186.     upvar ::tk::$w:itemList itemList
  187.     set rTag [lindex [lindex $data(list) $item] 2]
  188.     foreach {iTag tTag text serial} $itemList($rTag) {
  189.     break
  190.     }
  191.     return $text
  192. }
  193.  
  194. # ::tk::IconList_Config --
  195. #
  196. #    Configure the widget variables of IconList, according to the command
  197. #    line arguments.
  198. #
  199. proc ::tk::IconList_Config {w argList} {
  200.  
  201.     # 1: the configuration specs
  202.     #
  203.     set specs {
  204.     {-command "" "" ""}
  205.     {-multiple "" "" "0"}
  206.     }
  207.  
  208.     # 2: parse the arguments
  209.     #
  210.     tclParseConfigSpec ::tk::$w $specs "" $argList
  211. }
  212.  
  213. # ::tk::IconList_Create --
  214. #
  215. #    Creates an IconList widget by assembling a canvas widget and a
  216. #    scrollbar widget. Sets all the bindings necessary for the IconList's
  217. #    operations.
  218. #
  219. proc ::tk::IconList_Create {w} {
  220.     upvar ::tk::$w data
  221.  
  222.     frame $w
  223.     set data(sbar)   [scrollbar $w.sbar -orient horizontal \
  224.         -highlightthickness 0 -takefocus 0]
  225.     set data(canvas) [canvas $w.canvas -bd 2 -relief sunken \
  226.         -width 400 -height 120 -takefocus 1]
  227.     pack $data(sbar) -side bottom -fill x -padx 2
  228.     pack $data(canvas) -expand yes -fill both
  229.  
  230.     $data(sbar) configure -command [list $data(canvas) xview]
  231.     $data(canvas) configure -xscrollcommand [list $data(sbar) set]
  232.  
  233.     # Initializes the max icon/text width and height and other variables
  234.     #
  235.     set data(maxIW) 1
  236.     set data(maxIH) 1
  237.     set data(maxTW) 1
  238.     set data(maxTH) 1
  239.     set data(numItems) 0
  240.     set data(noScroll) 1
  241.     set data(selection) {}
  242.     set data(index,anchor) ""
  243.     set fg [option get $data(canvas) foreground Foreground]
  244.     if {$fg eq ""} {
  245.     set data(fill) black
  246.     } else {
  247.     set data(fill) $fg
  248.     }
  249.  
  250.     # Creates the event bindings.
  251.     #
  252.     bind $data(canvas) <Configure>    [list tk::IconList_Arrange $w]
  253.  
  254.     bind $data(canvas) <1>        [list tk::IconList_Btn1 $w %x %y]
  255.     bind $data(canvas) <B1-Motion>    [list tk::IconList_Motion1 $w %x %y]
  256.     bind $data(canvas) <B1-Leave>    [list tk::IconList_Leave1 $w %x %y]
  257.     bind $data(canvas) <Control-1>    [list tk::IconList_CtrlBtn1 $w %x %y]
  258.     bind $data(canvas) <Shift-1>    [list tk::IconList_ShiftBtn1 $w %x %y]
  259.     bind $data(canvas) <B1-Enter>    [list tk::CancelRepeat]
  260.     bind $data(canvas) <ButtonRelease-1> [list tk::CancelRepeat]
  261.     bind $data(canvas) <Double-ButtonRelease-1> \
  262.         [list tk::IconList_Double1 $w %x %y]
  263.  
  264.     bind $data(canvas) <Control-B1-Motion> {;}
  265.     bind $data(canvas) <Shift-B1-Motion> \
  266.         [list tk::IconList_ShiftMotion1 $w %x %y]
  267.  
  268.     bind $data(canvas) <Up>        [list tk::IconList_UpDown $w -1]
  269.     bind $data(canvas) <Down>        [list tk::IconList_UpDown $w  1]
  270.     bind $data(canvas) <Left>        [list tk::IconList_LeftRight $w -1]
  271.     bind $data(canvas) <Right>        [list tk::IconList_LeftRight $w  1]
  272.     bind $data(canvas) <Return>        [list tk::IconList_ReturnKey $w]
  273.     bind $data(canvas) <KeyPress>    [list tk::IconList_KeyPress $w %A]
  274.     bind $data(canvas) <Control-KeyPress> ";"
  275.     bind $data(canvas) <Alt-KeyPress>    ";"
  276.  
  277.     bind $data(canvas) <FocusIn>    [list tk::IconList_FocusIn $w]
  278.     bind $data(canvas) <FocusOut>    [list tk::IconList_FocusOut $w]
  279.  
  280.     return $w
  281. }
  282.  
  283. # ::tk::IconList_AutoScan --
  284. #
  285. # This procedure is invoked when the mouse leaves an entry window
  286. # with button 1 down.  It scrolls the window up, down, left, or
  287. # right, depending on where the mouse left the window, and reschedules
  288. # itself as an "after" command so that the window continues to scroll until
  289. # the mouse moves back into the window or the mouse button is released.
  290. #
  291. # Arguments:
  292. # w -        The IconList window.
  293. #
  294. proc ::tk::IconList_AutoScan {w} {
  295.     upvar ::tk::$w data
  296.     variable ::tk::Priv
  297.  
  298.     if {![winfo exists $w]} return
  299.     set x $Priv(x)
  300.     set y $Priv(y)
  301.  
  302.     if {$data(noScroll)} {
  303.     return
  304.     }
  305.     if {$x >= [winfo width $data(canvas)]} {
  306.     $data(canvas) xview scroll 1 units
  307.     } elseif {$x < 0} {
  308.     $data(canvas) xview scroll -1 units
  309.     } elseif {$y >= [winfo height $data(canvas)]} {
  310.     # do nothing
  311.     } elseif {$y < 0} {
  312.     # do nothing
  313.     } else {
  314.     return
  315.     }
  316.  
  317.     IconList_Motion1 $w $x $y
  318.     set Priv(afterId) [after 50 [list tk::IconList_AutoScan $w]]
  319. }
  320.  
  321. # Deletes all the items inside the canvas subwidget and reset the IconList's
  322. # state.
  323. #
  324. proc ::tk::IconList_DeleteAll {w} {
  325.     upvar ::tk::$w data
  326.     upvar ::tk::$w:itemList itemList
  327.  
  328.     $data(canvas) delete all
  329.     unset -nocomplain data(selected) data(rect) data(list) itemList
  330.     set data(maxIW) 1
  331.     set data(maxIH) 1
  332.     set data(maxTW) 1
  333.     set data(maxTH) 1
  334.     set data(numItems) 0
  335.     set data(noScroll) 1
  336.     set data(selection) {}
  337.     set data(index,anchor) ""
  338.     $data(sbar) set 0.0 1.0
  339.     $data(canvas) xview moveto 0
  340. }
  341.  
  342. # Adds an icon into the IconList with the designated image and text
  343. #
  344. proc ::tk::IconList_Add {w image items} {
  345.     upvar ::tk::$w data
  346.     upvar ::tk::$w:itemList itemList
  347.     upvar ::tk::$w:textList textList
  348.  
  349.     foreach text $items {
  350.     set iTag [$data(canvas) create image 0 0 -image $image -anchor nw \
  351.         -tags [list icon $data(numItems) item$data(numItems)]]
  352.     set tTag [$data(canvas) create text  0 0 -text  $text  -anchor nw \
  353.         -font $data(font) -fill $data(fill) \
  354.         -tags [list text $data(numItems) item$data(numItems)]]
  355.     set rTag [$data(canvas) create rect  0 0 0 0 -fill "" -outline "" \
  356.         -tags [list rect $data(numItems) item$data(numItems)]]
  357.  
  358.     foreach {x1 y1 x2 y2} [$data(canvas) bbox $iTag] {
  359.         break
  360.     }
  361.     set iW [expr {$x2 - $x1}]
  362.     set iH [expr {$y2 - $y1}]
  363.     if {$data(maxIW) < $iW} {
  364.         set data(maxIW) $iW
  365.     }
  366.     if {$data(maxIH) < $iH} {
  367.         set data(maxIH) $iH
  368.     }
  369.  
  370.     foreach {x1 y1 x2 y2} [$data(canvas) bbox $tTag] {
  371.         break
  372.     }
  373.     set tW [expr {$x2 - $x1}]
  374.     set tH [expr {$y2 - $y1}]
  375.     if {$data(maxTW) < $tW} {
  376.         set data(maxTW) $tW
  377.     }
  378.     if {$data(maxTH) < $tH} {
  379.         set data(maxTH) $tH
  380.     }
  381.  
  382.     lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW \
  383.         $tH $data(numItems)]
  384.     set itemList($rTag) [list $iTag $tTag $text $data(numItems)]
  385.     set textList($data(numItems)) [string tolower $text]
  386.     incr data(numItems)
  387.     }
  388. }
  389.  
  390. # Places the icons in a column-major arrangement.
  391. #
  392. proc ::tk::IconList_Arrange {w} {
  393.     upvar ::tk::$w data
  394.  
  395.     if {![info exists data(list)]} {
  396.     if {[info exists data(canvas)] && [winfo exists $data(canvas)]} {
  397.         set data(noScroll) 1
  398.         $data(sbar) configure -command ""
  399.     }
  400.     return
  401.     }
  402.  
  403.     set W [winfo width  $data(canvas)]
  404.     set H [winfo height $data(canvas)]
  405.     set pad [expr {[$data(canvas) cget -highlightthickness] + \
  406.         [$data(canvas) cget -bd]}]
  407.     if {$pad < 2} {
  408.     set pad 2
  409.     }
  410.  
  411.     incr W -[expr {$pad*2}]
  412.     incr H -[expr {$pad*2}]
  413.  
  414.     set dx [expr {$data(maxIW) + $data(maxTW) + 8}]
  415.     if {$data(maxTH) > $data(maxIH)} {
  416.     set dy $data(maxTH)
  417.     } else {
  418.     set dy $data(maxIH)
  419.     }
  420.     incr dy 2
  421.     set shift [expr {$data(maxIW) + 4}]
  422.  
  423.     set x [expr {$pad * 2}]
  424.     set y [expr {$pad * 1}] ; # Why * 1 ?
  425.     set usedColumn 0
  426.     foreach sublist $data(list) {
  427.     set usedColumn 1
  428.     foreach {iTag tTag rTag iW iH tW tH} $sublist {
  429.         break
  430.     }
  431.  
  432.     set i_dy [expr {($dy - $iH)/2}]
  433.     set t_dy [expr {($dy - $tH)/2}]
  434.  
  435.     $data(canvas) coords $iTag $x                    [expr {$y + $i_dy}]
  436.     $data(canvas) coords $tTag [expr {$x + $shift}]  [expr {$y + $t_dy}]
  437.     $data(canvas) coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]
  438.  
  439.     incr y $dy
  440.     if {($y + $dy) > $H} {
  441.         set y [expr {$pad * 1}] ; # *1 ?
  442.         incr x $dx
  443.         set usedColumn 0
  444.     }
  445.     }
  446.  
  447.     if {$usedColumn} {
  448.     set sW [expr {$x + $dx}]
  449.     } else {
  450.     set sW $x
  451.     }
  452.  
  453.     if {$sW < $W} {
  454.     $data(canvas) configure -scrollregion [list $pad $pad $sW $H]
  455.     $data(sbar) configure -command ""
  456.     $data(canvas) xview moveto 0
  457.     set data(noScroll) 1
  458.     } else {
  459.     $data(canvas) configure -scrollregion [list $pad $pad $sW $H]
  460.     $data(sbar) configure -command [list $data(canvas) xview]
  461.     set data(noScroll) 0
  462.     }
  463.  
  464.     set data(itemsPerColumn) [expr {($H-$pad)/$dy}]
  465.     if {$data(itemsPerColumn) < 1} {
  466.     set data(itemsPerColumn) 1
  467.     }
  468.  
  469.     IconList_DrawSelection $w
  470. }
  471.  
  472. # Gets called when the user invokes the IconList (usually by double-clicking
  473. # or pressing the Return key).
  474. #
  475. proc ::tk::IconList_Invoke {w} {
  476.     upvar ::tk::$w data
  477.  
  478.     if {$data(-command) ne "" && [llength $data(selection)]} {
  479.     uplevel #0 $data(-command)
  480.     }
  481. }
  482.  
  483. # ::tk::IconList_See --
  484. #
  485. #    If the item is not (completely) visible, scroll the canvas so that
  486. #    it becomes visible.
  487. proc ::tk::IconList_See {w rTag} {
  488.     upvar ::tk::$w data
  489.     upvar ::tk::$w:itemList itemList
  490.  
  491.     if {$data(noScroll)} {
  492.     return
  493.     }
  494.     set sRegion [$data(canvas) cget -scrollregion]
  495.     if {$sRegion eq ""} {
  496.     return
  497.     }
  498.  
  499.     if { $rTag < 0 || $rTag >= [llength $data(list)] } {
  500.     return
  501.     }
  502.  
  503.     set bbox [$data(canvas) bbox item$rTag]
  504.     set pad [expr {[$data(canvas) cget -highlightthickness] + \
  505.         [$data(canvas) cget -bd]}]
  506.  
  507.     set x1 [lindex $bbox 0]
  508.     set x2 [lindex $bbox 2]
  509.     incr x1 -[expr {$pad * 2}]
  510.     incr x2 -[expr {$pad * 1}] ; # *1 ?
  511.  
  512.     set cW [expr {[winfo width $data(canvas)] - $pad*2}]
  513.  
  514.     set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}]
  515.     set dispX [expr {int([lindex [$data(canvas) xview] 0]*$scrollW)}]
  516.     set oldDispX $dispX
  517.  
  518.     # check if out of the right edge
  519.     #
  520.     if {($x2 - $dispX) >= $cW} {
  521.     set dispX [expr {$x2 - $cW}]
  522.     }
  523.     # check if out of the left edge
  524.     #
  525.     if {($x1 - $dispX) < 0} {
  526.     set dispX $x1
  527.     }
  528.  
  529.     if {$oldDispX ne $dispX} {
  530.     set fraction [expr {double($dispX)/double($scrollW)}]
  531.     $data(canvas) xview moveto $fraction
  532.     }
  533. }
  534.  
  535. proc ::tk::IconList_Btn1 {w x y} {
  536.     upvar ::tk::$w data
  537.  
  538.     focus $data(canvas)
  539.     set i [IconList_Index $w @$x,$y]
  540.     if {$i eq ""} {
  541.     return
  542.     }
  543.     IconList_Selection $w clear 0 end
  544.     IconList_Selection $w set $i
  545.     IconList_Selection $w anchor $i
  546. }
  547.  
  548. proc ::tk::IconList_CtrlBtn1 {w x y} {
  549.     upvar ::tk::$w data
  550.  
  551.     if { $data(-multiple) } {
  552.     focus $data(canvas)
  553.     set i [IconList_Index $w @$x,$y]
  554.     if {$i eq ""} {
  555.         return
  556.     }
  557.     if { [IconList_Selection $w includes $i] } {
  558.         IconList_Selection $w clear $i
  559.     } else {
  560.         IconList_Selection $w set $i
  561.         IconList_Selection $w anchor $i
  562.     }
  563.     }
  564. }
  565.  
  566. proc ::tk::IconList_ShiftBtn1 {w x y} {
  567.     upvar ::tk::$w data
  568.  
  569.     if { $data(-multiple) } {
  570.     focus $data(canvas)
  571.     set i [IconList_Index $w @$x,$y]
  572.     if {$i eq ""} {
  573.         return
  574.     }
  575.     set a [IconList_Index $w anchor]
  576.     if {$a eq ""} {
  577.         set a $i
  578.     }
  579.     IconList_Selection $w clear 0 end
  580.     IconList_Selection $w set $a $i
  581.     }
  582. }
  583.  
  584. # Gets called on button-1 motions
  585. #
  586. proc ::tk::IconList_Motion1 {w x y} {
  587.     variable ::tk::Priv
  588.     set Priv(x) $x
  589.     set Priv(y) $y
  590.     set i [IconList_Index $w @$x,$y]
  591.     if {$i eq ""} {
  592.     return
  593.     }
  594.     IconList_Selection $w clear 0 end
  595.     IconList_Selection $w set $i
  596. }
  597.  
  598. proc ::tk::IconList_ShiftMotion1 {w x y} {
  599.     upvar ::tk::$w data
  600.     variable ::tk::Priv
  601.     set Priv(x) $x
  602.     set Priv(y) $y
  603.     set i [IconList_Index $w @$x,$y]
  604.     if {$i eq ""} {
  605.     return
  606.     }
  607.     IconList_Selection $w clear 0 end
  608.     IconList_Selection $w set anchor $i
  609. }
  610.  
  611. proc ::tk::IconList_Double1 {w x y} {
  612.     upvar ::tk::$w data
  613.  
  614.     if {[llength $data(selection)]} {
  615.     IconList_Invoke $w
  616.     }
  617. }
  618.  
  619. proc ::tk::IconList_ReturnKey {w} {
  620.     IconList_Invoke $w
  621. }
  622.  
  623. proc ::tk::IconList_Leave1 {w x y} {
  624.     variable ::tk::Priv
  625.  
  626.     set Priv(x) $x
  627.     set Priv(y) $y
  628.     IconList_AutoScan $w
  629. }
  630.  
  631. proc ::tk::IconList_FocusIn {w} {
  632.     upvar ::tk::$w data
  633.  
  634.     if {![info exists data(list)]} {
  635.     return
  636.     }
  637.  
  638.     if {[llength $data(selection)]} {
  639.     IconList_DrawSelection $w
  640.     }
  641. }
  642.  
  643. proc ::tk::IconList_FocusOut {w} {
  644.     IconList_Selection $w clear 0 end
  645. }
  646.  
  647. # ::tk::IconList_UpDown --
  648. #
  649. # Moves the active element up or down by one element
  650. #
  651. # Arguments:
  652. # w -        The IconList widget.
  653. # amount -    +1 to move down one item, -1 to move back one item.
  654. #
  655. proc ::tk::IconList_UpDown {w amount} {
  656.     upvar ::tk::$w data
  657.  
  658.     if {![info exists data(list)]} {
  659.     return
  660.     }
  661.  
  662.     set curr [tk::IconList_CurSelection $w]
  663.     if { [llength $curr] == 0 } {
  664.     set i 0
  665.     } else {
  666.     set i [tk::IconList_Index $w anchor]
  667.     if {$i eq ""} {
  668.         return
  669.     }
  670.     incr i $amount
  671.     }
  672.     IconList_Selection $w clear 0 end
  673.     IconList_Selection $w set $i
  674.     IconList_Selection $w anchor $i
  675.     IconList_See $w $i
  676. }
  677.  
  678. # ::tk::IconList_LeftRight --
  679. #
  680. # Moves the active element left or right by one column
  681. #
  682. # Arguments:
  683. # w -        The IconList widget.
  684. # amount -    +1 to move right one column, -1 to move left one column.
  685. #
  686. proc ::tk::IconList_LeftRight {w amount} {
  687.     upvar ::tk::$w data
  688.  
  689.     if {![info exists data(list)]} {
  690.     return
  691.     }
  692.  
  693.     set curr [IconList_CurSelection $w]
  694.     if { [llength $curr] == 0 } {
  695.     set i 0
  696.     } else {
  697.     set i [IconList_Index $w anchor]
  698.     if {$i eq ""} {
  699.         return
  700.     }
  701.     incr i [expr {$amount*$data(itemsPerColumn)}]
  702.     }
  703.     IconList_Selection $w clear 0 end
  704.     IconList_Selection $w set $i
  705.     IconList_Selection $w anchor $i
  706.     IconList_See $w $i
  707. }
  708.  
  709. #----------------------------------------------------------------------
  710. #        Accelerator key bindings
  711. #----------------------------------------------------------------------
  712.  
  713. # ::tk::IconList_KeyPress --
  714. #
  715. #    Gets called when user enters an arbitrary key in the listbox.
  716. #
  717. proc ::tk::IconList_KeyPress {w key} {
  718.     variable ::tk::Priv
  719.  
  720.     append Priv(ILAccel,$w) $key
  721.     IconList_Goto $w $Priv(ILAccel,$w)
  722.     catch {
  723.     after cancel $Priv(ILAccel,$w,afterId)
  724.     }
  725.     set Priv(ILAccel,$w,afterId) [after 500 [list tk::IconList_Reset $w]]
  726. }
  727.  
  728. proc ::tk::IconList_Goto {w text} {
  729.     upvar ::tk::$w data
  730.     upvar ::tk::$w:textList textList
  731.  
  732.     if {![info exists data(list)]} {
  733.     return
  734.     }
  735.  
  736.     if {$text eq ""} {
  737.     return
  738.     }
  739.  
  740.     if {[llength [IconList_CurSelection $w]]} {
  741.     set start [IconList_Index $w anchor]
  742.     } else {
  743.     set start 0
  744.     }
  745.  
  746.     set theIndex -1
  747.     set less 0
  748.     set len [string length $text]
  749.     set len0 [expr {$len-1}]
  750.     set i $start
  751.  
  752.     # Search forward until we find a filename whose prefix is a
  753.     # case-insensitive match with $text
  754.     while {1} {
  755.     if {[string equal -nocase -length $len0 $textList($i) $text]} {
  756.         set theIndex $i
  757.         break
  758.     }
  759.     incr i
  760.     if {$i == $data(numItems)} {
  761.         set i 0
  762.     }
  763.     if {$i == $start} {
  764.         break
  765.     }
  766.     }
  767.  
  768.     if {$theIndex > -1} {
  769.     IconList_Selection $w clear 0 end
  770.     IconList_Selection $w set $theIndex
  771.     IconList_Selection $w anchor $theIndex
  772.     IconList_See $w $theIndex
  773.     }
  774. }
  775.  
  776. proc ::tk::IconList_Reset {w} {
  777.     variable ::tk::Priv
  778.  
  779.     unset -nocomplain Priv(ILAccel,$w)
  780. }
  781.  
  782. #----------------------------------------------------------------------
  783. #
  784. #              F I L E   D I A L O G
  785. #
  786. #----------------------------------------------------------------------
  787.  
  788. namespace eval ::tk::dialog {}
  789. namespace eval ::tk::dialog::file {
  790.     namespace import -force ::tk::msgcat::*
  791.     set ::tk::dialog::file::showHiddenBtn 0
  792.     set ::tk::dialog::file::showHiddenVar 1
  793. }
  794.  
  795. # ::tk::dialog::file:: --
  796. #
  797. #    Implements the TK file selection dialog. This dialog is used when
  798. #    the tk_strictMotif flag is set to false. This procedure shouldn't
  799. #    be called directly. Call tk_getOpenFile or tk_getSaveFile instead.
  800. #
  801. # Arguments:
  802. #    type        "open" or "save"
  803. #    args        Options parsed by the procedure.
  804. #
  805.  
  806. proc ::tk::dialog::file:: {type args} {
  807.     variable ::tk::Priv
  808.     set dataName __tk_filedialog
  809.     upvar ::tk::dialog::file::$dataName data
  810.  
  811.     Config $dataName $type $args
  812.  
  813.     if {$data(-parent) eq "."} {
  814.     set w .$dataName
  815.     } else {
  816.     set w $data(-parent).$dataName
  817.     }
  818.  
  819.     # (re)create the dialog box if necessary
  820.     #
  821.     if {![winfo exists $w]} {
  822.     Create $w TkFDialog
  823.     } elseif {[winfo class $w] ne "TkFDialog"} {
  824.     destroy $w
  825.     Create $w TkFDialog
  826.     } else {
  827.     set data(dirMenuBtn) $w.f1.menu
  828.     set data(dirMenu) $w.f1.menu.menu
  829.     set data(upBtn) $w.f1.up
  830.     set data(icons) $w.icons
  831.     set data(ent) $w.f2.ent
  832.     set data(typeMenuLab) $w.f2.lab2
  833.     set data(typeMenuBtn) $w.f2.menu
  834.     set data(typeMenu) $data(typeMenuBtn).m
  835.     set data(okBtn) $w.f2.ok
  836.     set data(cancelBtn) $w.f2.cancel
  837.     set data(hiddenBtn) $w.f2.hidden
  838.     SetSelectMode $w $data(-multiple)
  839.     }
  840.     if {$::tk::dialog::file::showHiddenBtn} {
  841.     $data(hiddenBtn) configure -state normal
  842.     grid $data(hiddenBtn)
  843.     } else {
  844.     $data(hiddenBtn) configure -state disabled
  845.     grid remove $data(hiddenBtn)
  846.     }
  847.  
  848.     # Make sure subseqent uses of this dialog are independent [Bug 845189]
  849.     unset -nocomplain data(extUsed)
  850.  
  851.     # Dialog boxes should be transient with respect to their parent,
  852.     # so that they will always stay on top of their parent window.  However,
  853.     # some window managers will create the window as withdrawn if the parent
  854.     # window is withdrawn or iconified.  Combined with the grab we put on the
  855.     # window, this can hang the entire application.  Therefore we only make
  856.     # the dialog transient if the parent is viewable.
  857.  
  858.     if {[winfo viewable [winfo toplevel $data(-parent)]]} {
  859.     wm transient $w $data(-parent)
  860.     }
  861.  
  862.     # Add traces on the selectPath variable
  863.     #
  864.  
  865.     trace add variable data(selectPath) write \
  866.         [list ::tk::dialog::file::SetPath $w]
  867.     $data(dirMenuBtn) configure \
  868.         -textvariable ::tk::dialog::file::${dataName}(selectPath)
  869.  
  870.     # Initialize the file types menu
  871.     #
  872.     if {[llength $data(-filetypes)]} {
  873.     $data(typeMenu) delete 0 end
  874.     foreach type $data(-filetypes) {
  875.         set title  [lindex $type 0]
  876.         set filter [lindex $type 1]
  877.         $data(typeMenu) add command -label $title \
  878.             -command [list ::tk::dialog::file::SetFilter $w $type]
  879.     }
  880.     SetFilter $w [lindex $data(-filetypes) 0]
  881.     $data(typeMenuBtn) configure -state normal
  882.     $data(typeMenuLab) configure -state normal
  883.     } else {
  884.     set data(filter) "*"
  885.     $data(typeMenuBtn) configure -state disabled -takefocus 0
  886.     $data(typeMenuLab) configure -state disabled
  887.     }
  888.     UpdateWhenIdle $w
  889.  
  890.     # Withdraw the window, then update all the geometry information
  891.     # so we know how big it wants to be, then center the window in the
  892.     # display and de-iconify it.
  893.  
  894.     ::tk::PlaceWindow $w widget $data(-parent)
  895.     wm title $w $data(-title)
  896.  
  897.     # Set a grab and claim the focus too.
  898.  
  899.     ::tk::SetFocusGrab $w $data(ent)
  900.     $data(ent) delete 0 end
  901.     $data(ent) insert 0 $data(selectFile)
  902.     $data(ent) selection range 0 end
  903.     $data(ent) icursor end
  904.  
  905.     # Wait for the user to respond, then restore the focus and
  906.     # return the index of the selected button.  Restore the focus
  907.     # before deleting the window, since otherwise the window manager
  908.     # may take the focus away so we can't redirect it.  Finally,
  909.     # restore any grab that was in effect.
  910.  
  911.     vwait ::tk::Priv(selectFilePath)
  912.  
  913.     ::tk::RestoreFocusGrab $w $data(ent) withdraw
  914.  
  915.     # Cleanup traces on selectPath variable
  916.     #
  917.  
  918.     foreach trace [trace info variable data(selectPath)] {
  919.     trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
  920.     }
  921.     $data(dirMenuBtn) configure -textvariable {}
  922.  
  923.     return $Priv(selectFilePath)
  924. }
  925.  
  926. # ::tk::dialog::file::Config --
  927. #
  928. #    Configures the TK filedialog according to the argument list
  929. #
  930. proc ::tk::dialog::file::Config {dataName type argList} {
  931.     upvar ::tk::dialog::file::$dataName data
  932.  
  933.     set data(type) $type
  934.  
  935.     # 0: Delete all variable that were set on data(selectPath) the
  936.     # last time the file dialog is used. The traces may cause troubles
  937.     # if the dialog is now used with a different -parent option.
  938.  
  939.     foreach trace [trace info variable data(selectPath)] {
  940.     trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
  941.     }
  942.  
  943.     # 1: the configuration specs
  944.     #
  945.     set specs {
  946.     {-defaultextension "" "" ""}
  947.     {-filetypes "" "" ""}
  948.     {-initialdir "" "" ""}
  949.     {-initialfile "" "" ""}
  950.     {-parent "" "" "."}
  951.     {-title "" "" ""}
  952.     }
  953.  
  954.     # The "-multiple" option is only available for the "open" file dialog.
  955.     #
  956.     if {$type eq "open"} {
  957.     lappend specs {-multiple "" "" "0"}
  958.     }
  959.  
  960.     # 2: default values depending on the type of the dialog
  961.     #
  962.     if {![info exists data(selectPath)]} {
  963.     # first time the dialog has been popped up
  964.     set data(selectPath) [pwd]
  965.     set data(selectFile) ""
  966.     }
  967.  
  968.     # 3: parse the arguments
  969.     #
  970.     tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
  971.  
  972.     if {$data(-title) eq ""} {
  973.     if {$type eq "open"} {
  974.         set data(-title) [mc "Open"]
  975.     } else {
  976.         set data(-title) [mc "Save As"]
  977.     }
  978.     }
  979.  
  980.     # 4: set the default directory and selection according to the -initial
  981.     #    settings
  982.     #
  983.     if {$data(-initialdir) ne ""} {
  984.     # Ensure that initialdir is an absolute path name.
  985.     if {[file isdirectory $data(-initialdir)]} {
  986.         set old [pwd]
  987.         cd $data(-initialdir)
  988.         set data(selectPath) [pwd]
  989.         cd $old
  990.     } else {
  991.         set data(selectPath) [pwd]
  992.     }
  993.     }
  994.     set data(selectFile) $data(-initialfile)
  995.  
  996.     # 5. Parse the -filetypes option
  997.     #
  998.     set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)]
  999.  
  1000.     if {![winfo exists $data(-parent)]} {
  1001.     error "bad window path name \"$data(-parent)\""
  1002.     }
  1003.  
  1004.     # Set -multiple to a one or zero value (not other boolean types
  1005.     # like "yes") so we can use it in tests more easily.
  1006.     if {$type eq "save"} {
  1007.     set data(-multiple) 0
  1008.     } elseif {$data(-multiple)} {
  1009.     set data(-multiple) 1
  1010.     } else {
  1011.     set data(-multiple) 0
  1012.     }
  1013. }
  1014.  
  1015. proc ::tk::dialog::file::Create {w class} {
  1016.     set dataName [lindex [split $w .] end]
  1017.     upvar ::tk::dialog::file::$dataName data
  1018.     variable ::tk::Priv
  1019.     global tk_library
  1020.  
  1021.     toplevel $w -class $class
  1022.  
  1023.     # f1: the frame with the directory option menu
  1024.     #
  1025.     set f1 [frame $w.f1]
  1026.     bind [::tk::AmpWidget label $f1.lab -text [mc "&Directory:"]] \
  1027.         <<AltUnderlined>> [list focus $f1.menu]
  1028.  
  1029.     set data(dirMenuBtn) $f1.menu
  1030.     set data(dirMenu) [tk_optionMenu $f1.menu \
  1031.         [format %s(selectPath) ::tk::dialog::file::$dataName] ""]
  1032.     set data(upBtn) [button $f1.up]
  1033.     if {![info exists Priv(updirImage)]} {
  1034.     set Priv(updirImage) [image create bitmap -data {
  1035. #define updir_width 28
  1036. #define updir_height 16
  1037. static char updir_bits[] = {
  1038.    0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
  1039.    0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
  1040.    0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
  1041.    0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
  1042.    0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
  1043.    0xf0, 0xff, 0xff, 0x01};}]
  1044.     }
  1045.     $data(upBtn) configure -image $Priv(updirImage)
  1046.  
  1047.     $f1.menu configure -takefocus 1 -highlightthickness 2
  1048.  
  1049.     pack $data(upBtn) -side right -padx 4 -fill both
  1050.     pack $f1.lab -side left -padx 4 -fill both
  1051.     pack $f1.menu -expand yes -fill both -padx 4
  1052.  
  1053.     # data(icons): the IconList that list the files and directories.
  1054.     #
  1055.     if {$class eq "TkFDialog"} {
  1056.     if { $data(-multiple) } {
  1057.         set fNameCaption [mc "File &names:"]
  1058.     } else {
  1059.         set fNameCaption [mc "File &name:"]
  1060.     }
  1061.     set fTypeCaption [mc "Files of &type:"]
  1062.     set iconListCommand [list ::tk::dialog::file::OkCmd $w]
  1063.     } else {
  1064.     set fNameCaption [mc "&Selection:"]
  1065.     set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w]
  1066.     }
  1067.     set data(icons) [::tk::IconList $w.icons \
  1068.         -command $iconListCommand -multiple $data(-multiple)]
  1069.     bind $data(icons) <<ListboxSelect>> \
  1070.         [list ::tk::dialog::file::ListBrowse $w]
  1071.  
  1072.     # f2: the frame with the OK button, cancel button, "file name" field
  1073.     #     and file types field.
  1074.     #
  1075.     set f2 [frame $w.f2 -bd 0]
  1076.     bind [::tk::AmpWidget label $f2.lab -text $fNameCaption -anchor e -pady 0]\
  1077.         <<AltUnderlined>> [list focus $f2.ent]
  1078.     set data(ent) [entry $f2.ent]
  1079.  
  1080.     # The font to use for the icons. The default Canvas font on Unix
  1081.     # is just deviant.
  1082.     set ::tk::$w.icons(font) [$data(ent) cget -font]
  1083.  
  1084.     # Make the file types bits only if this is a File Dialog
  1085.     if {$class eq "TkFDialog"} {
  1086.     set data(typeMenuLab) [::tk::AmpWidget label $f2.lab2 \
  1087.         -text $fTypeCaption -anchor e -pady [$f2.lab cget -pady]]
  1088.     set data(typeMenuBtn) [menubutton $f2.menu -indicatoron 1 \
  1089.         -menu $f2.menu.m]
  1090.     set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]
  1091.     $data(typeMenuBtn) configure -takefocus 1 -highlightthickness 2 \
  1092.         -relief raised -bd 2 -anchor w
  1093.     bind $data(typeMenuLab) <<AltUnderlined>> [list \
  1094.         focus $data(typeMenuBtn)]
  1095.     }
  1096.  
  1097.     # The hidden button is displayed when ::tk::dialog::file::showHiddenBtn
  1098.     # is true.  Create it disabled so the binding doesn't trigger if it
  1099.     # isn't shown.
  1100.     if {$class eq "TkFDialog"} {
  1101.     set text [mc "Show &Hidden Files and Directories"]
  1102.     } else {
  1103.     set text [mc "Show &Hidden Directories"]
  1104.     }
  1105.     set data(hiddenBtn) [::tk::AmpWidget checkbutton $f2.hidden \
  1106.         -text $text -anchor w -padx 3 -state disabled \
  1107.         -variable ::tk::dialog::file::showHiddenVar \
  1108.         -command [list ::tk::dialog::file::UpdateWhenIdle $w]]
  1109.  
  1110.     # the okBtn is created after the typeMenu so that the keyboard traversal
  1111.     # is in the right order, and add binding so that we find out when the
  1112.     # dialog is destroyed by the user (added here instead of to the overall
  1113.     # window so no confusion about how much <Destroy> gets called; exactly
  1114.     # once will do). [Bug 987169]
  1115.  
  1116.     set data(okBtn)     [::tk::AmpWidget button $f2.ok \
  1117.         -text [mc "&OK"]     -default active -pady 3]
  1118.     bind $data(okBtn) <Destroy> [list ::tk::dialog::file::Destroyed $w]
  1119.     set data(cancelBtn) [::tk::AmpWidget button $f2.cancel \
  1120.         -text [mc "&Cancel"] -default normal -pady 3]
  1121.  
  1122.     # grid the widgets in f2
  1123.     #
  1124.     grid $f2.lab $f2.ent $data(okBtn) -padx 4 -sticky ew
  1125.     grid configure $f2.ent -padx 2
  1126.     if {$class eq "TkFDialog"} {
  1127.     grid $data(typeMenuLab) $data(typeMenuBtn) $data(cancelBtn) \
  1128.         -padx 4 -sticky ew
  1129.     grid configure $data(typeMenuBtn) -padx 0
  1130.     grid $data(hiddenBtn) -columnspan 2 -padx 4 -sticky ew
  1131.     } else {
  1132.     grid $data(hiddenBtn) - $data(cancelBtn) -padx 4 -sticky ew
  1133.     }
  1134.     grid columnconfigure $f2 1 -weight 1
  1135.  
  1136.     # Pack all the frames together. We are done with widget construction.
  1137.     #
  1138.     pack $f1 -side top -fill x -pady 4
  1139.     pack $f2 -side bottom -fill x
  1140.     pack $data(icons) -expand yes -fill both -padx 4 -pady 1
  1141.  
  1142.     # Set up the event handlers that are common to Directory and File Dialogs
  1143.     #
  1144.  
  1145.     wm protocol $w WM_DELETE_WINDOW [list ::tk::dialog::file::CancelCmd $w]
  1146.     $data(upBtn)     configure -command [list ::tk::dialog::file::UpDirCmd $w]
  1147.     $data(cancelBtn) configure -command [list ::tk::dialog::file::CancelCmd $w]
  1148.     bind $w <KeyPress-Escape> [list tk::ButtonInvoke $data(cancelBtn)]
  1149.     bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A]
  1150.  
  1151.     # Set up event handlers specific to File or Directory Dialogs
  1152.     #
  1153.     if {$class eq "TkFDialog"} {
  1154.     bind $data(ent) <Return> [list ::tk::dialog::file::ActivateEnt $w]
  1155.     $data(okBtn)     configure -command [list ::tk::dialog::file::OkCmd $w]
  1156.     bind $w <Alt-t> [format {
  1157.         if {[%s cget -state] eq "normal"} {
  1158.         focus %s
  1159.         }
  1160.     } $data(typeMenuBtn) $data(typeMenuBtn)]
  1161.     } else {
  1162.     set okCmd [list ::tk::dialog::file::chooseDir::OkCmd $w]
  1163.     bind $data(ent) <Return> $okCmd
  1164.     $data(okBtn) configure -command $okCmd
  1165.     bind $w <Alt-s> [list focus $data(ent)]
  1166.     bind $w <Alt-o> [list tk::ButtonInvoke $data(okBtn)]
  1167.     }
  1168.     bind $w <Alt-h> [list $data(hiddenBtn) invoke]
  1169.  
  1170.     # Build the focus group for all the entries
  1171.     #
  1172.     ::tk::FocusGroup_Create $w
  1173.     ::tk::FocusGroup_BindIn $w  $data(ent) [list \
  1174.         ::tk::dialog::file::EntFocusIn $w]
  1175.     ::tk::FocusGroup_BindOut $w $data(ent) [list \
  1176.         ::tk::dialog::file::EntFocusOut $w]
  1177. }
  1178.  
  1179. # ::tk::dialog::file::SetSelectMode --
  1180. #
  1181. #    Set the select mode of the dialog to single select or multi-select.
  1182. #
  1183. # Arguments:
  1184. #    w        The dialog path.
  1185. #    multi        1 if the dialog is multi-select; 0 otherwise.
  1186. #
  1187. # Results:
  1188. #    None.
  1189.  
  1190. proc ::tk::dialog::file::SetSelectMode {w multi} {
  1191.     set dataName __tk_filedialog
  1192.     upvar ::tk::dialog::file::$dataName data
  1193.     if { $multi } {
  1194.     set fNameCaption [mc "File &names:"]
  1195.     } else {
  1196.     set fNameCaption [mc "File &name:"]
  1197.     }
  1198.     set iconListCommand [list ::tk::dialog::file::OkCmd $w]
  1199.     ::tk::SetAmpText $w.f2.lab $fNameCaption
  1200.     ::tk::IconList_Config $data(icons) \
  1201.         [list -multiple $multi -command $iconListCommand]
  1202.     return
  1203. }
  1204.  
  1205. # ::tk::dialog::file::UpdateWhenIdle --
  1206. #
  1207. #    Creates an idle event handler which updates the dialog in idle
  1208. #    time. This is important because loading the directory may take a long
  1209. #    time and we don't want to load the same directory for multiple times
  1210. #    due to multiple concurrent events.
  1211. #
  1212. proc ::tk::dialog::file::UpdateWhenIdle {w} {
  1213.     upvar ::tk::dialog::file::[winfo name $w] data
  1214.  
  1215.     if {[info exists data(updateId)]} {
  1216.     return
  1217.     } else {
  1218.     set data(updateId) [after idle [list ::tk::dialog::file::Update $w]]
  1219.     }
  1220. }
  1221.  
  1222. # ::tk::dialog::file::Update --
  1223. #
  1224. #    Loads the files and directories into the IconList widget. Also
  1225. #    sets up the directory option menu for quick access to parent
  1226. #    directories.
  1227. #
  1228. proc ::tk::dialog::file::Update {w} {
  1229.  
  1230.     # This proc may be called within an idle handler. Make sure that the
  1231.     # window has not been destroyed before this proc is called
  1232.     if {![winfo exists $w]} {
  1233.     return
  1234.     }
  1235.     set class [winfo class $w]
  1236.     if {($class ne "TkFDialog") && ($class ne "TkChooseDir")} {
  1237.     return
  1238.     }
  1239.  
  1240.     set dataName [winfo name $w]
  1241.     upvar ::tk::dialog::file::$dataName data
  1242.     variable ::tk::Priv
  1243.     global tk_library
  1244.     unset -nocomplain data(updateId)
  1245.  
  1246.     if {![info exists Priv(folderImage)]} {
  1247.     set Priv(folderImage) [image create photo -data {
  1248. R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB
  1249. QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]
  1250.     set Priv(fileImage)   [image create photo -data {
  1251. R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO
  1252. rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
  1253.     }
  1254.     set folder $Priv(folderImage)
  1255.     set file   $Priv(fileImage)
  1256.  
  1257.     set appPWD [pwd]
  1258.     if {[catch {
  1259.     cd $data(selectPath)
  1260.     }]} {
  1261.     # We cannot change directory to $data(selectPath). $data(selectPath)
  1262.     # should have been checked before ::tk::dialog::file::Update is called, so
  1263.     # we normally won't come to here. Anyways, give an error and abort
  1264.     # action.
  1265.     tk_messageBox -type ok -parent $w -icon warning -message \
  1266.         [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $data(selectPath)]
  1267.     cd $appPWD
  1268.     return
  1269.     }
  1270.  
  1271.     # Turn on the busy cursor. BUG?? We haven't disabled X events, though,
  1272.     # so the user may still click and cause havoc ...
  1273.     #
  1274.     set entCursor [$data(ent) cget -cursor]
  1275.     set dlgCursor [$w         cget -cursor]
  1276.     $data(ent) configure -cursor watch
  1277.     $w         configure -cursor watch
  1278.     update idletasks
  1279.  
  1280.     ::tk::IconList_DeleteAll $data(icons)
  1281.  
  1282.     set showHidden $::tk::dialog::file::showHiddenVar
  1283.  
  1284.     # Make the dir list
  1285.     # Using -directory [pwd] is better in some VFS cases.
  1286.     set cmd [list glob -tails -directory [pwd] -type d -nocomplain *]
  1287.     if {$showHidden} { lappend cmd .* }
  1288.     set dirs [lsort -dictionary -unique [eval $cmd]]
  1289.     set dirList {}
  1290.     foreach d $dirs {
  1291.     if {$d eq "." || $d eq ".."} {
  1292.         continue
  1293.     }
  1294.     lappend dirList $d
  1295.     }
  1296.     ::tk::IconList_Add $data(icons) $folder $dirList
  1297.  
  1298.     if {$class eq "TkFDialog"} {
  1299.     # Make the file list if this is a File Dialog, selecting all
  1300.     # but 'd'irectory type files.
  1301.     #
  1302.     set cmd [list glob -tails -directory [pwd] \
  1303.         -type {f b c l p s} -nocomplain]
  1304.     if {$data(filter) eq "*"} {
  1305.         lappend cmd *
  1306.         if {$showHidden} {
  1307.         lappend cmd .*
  1308.         }
  1309.     } else {
  1310.         eval [list lappend cmd] $data(filter)
  1311.     }
  1312.     set fileList [lsort -dictionary -unique [eval $cmd]]
  1313.     ::tk::IconList_Add $data(icons) $file $fileList
  1314.     }
  1315.  
  1316.     ::tk::IconList_Arrange $data(icons)
  1317.  
  1318.     # Update the Directory: option menu
  1319.     #
  1320.     set list ""
  1321.     set dir ""
  1322.     foreach subdir [file split $data(selectPath)] {
  1323.     set dir [file join $dir $subdir]
  1324.     lappend list $dir
  1325.     }
  1326.  
  1327.     $data(dirMenu) delete 0 end
  1328.     set var [format %s(selectPath) ::tk::dialog::file::$dataName]
  1329.     foreach path $list {
  1330.     $data(dirMenu) add command -label $path -command [list set $var $path]
  1331.     }
  1332.  
  1333.     # Restore the PWD to the application's PWD
  1334.     #
  1335.     cd $appPWD
  1336.  
  1337.     if {$class eq "TkFDialog"} {
  1338.     # Restore the Open/Save Button if this is a File Dialog
  1339.     #
  1340.     if {$data(type) eq "open"} {
  1341.         ::tk::SetAmpText $data(okBtn) [mc "&Open"]
  1342.     } else {
  1343.         ::tk::SetAmpText $data(okBtn) [mc "&Save"]
  1344.     }
  1345.     }
  1346.  
  1347.     # turn off the busy cursor.
  1348.     #
  1349.     $data(ent) configure -cursor $entCursor
  1350.     $w         configure -cursor $dlgCursor
  1351. }
  1352.  
  1353. # ::tk::dialog::file::SetPathSilently --
  1354. #
  1355. #     Sets data(selectPath) without invoking the trace procedure
  1356. #
  1357. proc ::tk::dialog::file::SetPathSilently {w path} {
  1358.     upvar ::tk::dialog::file::[winfo name $w] data
  1359.  
  1360.     trace remove variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]
  1361.     set data(selectPath) $path
  1362.     trace add variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]
  1363. }
  1364.  
  1365.  
  1366. # This proc gets called whenever data(selectPath) is set
  1367. #
  1368. proc ::tk::dialog::file::SetPath {w name1 name2 op} {
  1369.     if {[winfo exists $w]} {
  1370.     upvar ::tk::dialog::file::[winfo name $w] data
  1371.     UpdateWhenIdle $w
  1372.     # On directory dialogs, we keep the entry in sync with the currentdir.
  1373.     if {[winfo class $w] eq "TkChooseDir"} {
  1374.         $data(ent) delete 0 end
  1375.         $data(ent) insert end $data(selectPath)
  1376.     }
  1377.     }
  1378. }
  1379.  
  1380. # This proc gets called whenever data(filter) is set
  1381. #
  1382. proc ::tk::dialog::file::SetFilter {w type} {
  1383.     upvar ::tk::dialog::file::[winfo name $w] data
  1384.     upvar ::tk::$data(icons) icons
  1385.  
  1386.     set data(filter) [lindex $type 1]
  1387.     $data(typeMenuBtn) configure -text [lindex $type 0] -indicatoron 1
  1388.  
  1389.     # If we aren't using a default extension, use the one suppled
  1390.     # by the filter.
  1391.     if {![info exists data(extUsed)]} {
  1392.     if {[string length $data(-defaultextension)]} {
  1393.         set data(extUsed) 1
  1394.     } else {
  1395.         set data(extUsed) 0
  1396.     }
  1397.     }
  1398.  
  1399.     if {!$data(extUsed)} {
  1400.     # Get the first extension in the list that matches {^\*\.\w+$}
  1401.     # and remove all * from the filter.
  1402.     set index [lsearch -regexp $data(filter) {^\*\.\w+$}]
  1403.     if {$index >= 0} {
  1404.         set data(-defaultextension) \
  1405.             [string trimleft [lindex $data(filter) $index] "*"]
  1406.     } else {
  1407.         # Couldn't find anything!  Reset to a safe default...
  1408.         set data(-defaultextension) ""
  1409.     }
  1410.     }
  1411.  
  1412.     $icons(sbar) set 0.0 0.0
  1413.  
  1414.     UpdateWhenIdle $w
  1415. }
  1416.  
  1417. # tk::dialog::file::ResolveFile --
  1418. #
  1419. #    Interpret the user's text input in a file selection dialog.
  1420. #    Performs:
  1421. #
  1422. #    (1) ~ substitution
  1423. #    (2) resolve all instances of . and ..
  1424. #    (3) check for non-existent files/directories
  1425. #    (4) check for chdir permissions
  1426. #    (5) conversion of environment variable references to their
  1427. #        contents (once only)
  1428. #
  1429. # Arguments:
  1430. #    context:  the current directory you are in
  1431. #    text:      the text entered by the user
  1432. #    defaultext: the default extension to add to files with no extension
  1433. #    expandEnv: whether to expand environment variables (yes by default)
  1434. #
  1435. # Return vaue:
  1436. #    [list $flag $directory $file]
  1437. #
  1438. #     flag = OK    : valid input
  1439. #          = PATTERN    : valid directory/pattern
  1440. #          = PATH    : the directory does not exist
  1441. #          = FILE    : the directory exists by the file doesn't
  1442. #              exist
  1443. #          = CHDIR    : Cannot change to the directory
  1444. #          = ERROR    : Invalid entry
  1445. #
  1446. #     directory      : valid only if flag = OK or PATTERN or FILE
  1447. #     file           : valid only if flag = OK or PATTERN
  1448. #
  1449. #    directory may not be the same as context, because text may contain
  1450. #    a subdirectory name
  1451. #
  1452. proc ::tk::dialog::file::ResolveFile {context text defaultext {expandEnv 1}} {
  1453.     set appPWD [pwd]
  1454.  
  1455.     set path [JoinFile $context $text]
  1456.  
  1457.     # If the file has no extension, append the default.  Be careful not
  1458.     # to do this for directories, otherwise typing a dirname in the box
  1459.     # will give back "dirname.extension" instead of trying to change dir.
  1460.     if {
  1461.     ![file isdirectory $path] && ([file ext $path] eq "") &&
  1462.     ![string match {$*} [file tail $path]]
  1463.     } then {
  1464.     set path "$path$defaultext"
  1465.     }
  1466.  
  1467.     if {[catch {file exists $path}]} {
  1468.     # This "if" block can be safely removed if the following code
  1469.     # stop generating errors.
  1470.     #
  1471.     #    file exists ~nonsuchuser
  1472.     #
  1473.     return [list ERROR $path ""]
  1474.     }
  1475.  
  1476.     if {[file exists $path]} {
  1477.     if {[file isdirectory $path]} {
  1478.         if {[catch {cd $path}]} {
  1479.         return [list CHDIR $path ""]
  1480.         }
  1481.         set directory [pwd]
  1482.         set file ""
  1483.         set flag OK
  1484.         cd $appPWD
  1485.     } else {
  1486.         if {[catch {cd [file dirname $path]}]} {
  1487.         return [list CHDIR [file dirname $path] ""]
  1488.         }
  1489.         set directory [pwd]
  1490.         set file [file tail $path]
  1491.         set flag OK
  1492.         cd $appPWD
  1493.     }
  1494.     } else {
  1495.     set dirname [file dirname $path]
  1496.     if {[file exists $dirname]} {
  1497.         if {[catch {cd $dirname}]} {
  1498.         return [list CHDIR $dirname ""]
  1499.         }
  1500.         set directory [pwd]
  1501.         cd $appPWD
  1502.         set file [file tail $path]
  1503.         # It's nothing else, so check to see if it is an env-reference
  1504.         if {$expandEnv && [string match {$*} $file]} {
  1505.         set var [string range $file 1 end]
  1506.         if {[info exist ::env($var)]} {
  1507.             return [ResolveFile $context $::env($var) $defaultext 0]
  1508.         }
  1509.         }
  1510.         if {[regexp {[*?]} $file]} {
  1511.         set flag PATTERN
  1512.         } else {
  1513.         set flag FILE
  1514.         }
  1515.     } else {
  1516.         set directory $dirname
  1517.         set file [file tail $path]
  1518.         set flag PATH
  1519.         # It's nothing else, so check to see if it is an env-reference
  1520.         if {$expandEnv && [string match {$*} $file]} {
  1521.         set var [string range $file 1 end]
  1522.         if {[info exist ::env($var)]} {
  1523.             return [ResolveFile $context $::env($var) $defaultext 0]
  1524.         }
  1525.         }
  1526.     }
  1527.     }
  1528.  
  1529.     return [list $flag $directory $file]
  1530. }
  1531.  
  1532.  
  1533. # Gets called when the entry box gets keyboard focus. We clear the selection
  1534. # from the icon list . This way the user can be certain that the input in the
  1535. # entry box is the selection.
  1536. #
  1537. proc ::tk::dialog::file::EntFocusIn {w} {
  1538.     upvar ::tk::dialog::file::[winfo name $w] data
  1539.  
  1540.     if {[$data(ent) get] ne ""} {
  1541.     $data(ent) selection range 0 end
  1542.     $data(ent) icursor end
  1543.     } else {
  1544.     $data(ent) selection clear
  1545.     }
  1546.  
  1547.     if {[winfo class $w] eq "TkFDialog"} {
  1548.     # If this is a File Dialog, make sure the buttons are labeled right.
  1549.     if {$data(type) eq "open"} {
  1550.         ::tk::SetAmpText $data(okBtn) [mc "&Open"]
  1551.     } else {
  1552.         ::tk::SetAmpText $data(okBtn) [mc "&Save"]
  1553.     }
  1554.     }
  1555. }
  1556.  
  1557. proc ::tk::dialog::file::EntFocusOut {w} {
  1558.     upvar ::tk::dialog::file::[winfo name $w] data
  1559.  
  1560.     $data(ent) selection clear
  1561. }
  1562.  
  1563.  
  1564. # Gets called when user presses Return in the "File name" entry.
  1565. #
  1566. proc ::tk::dialog::file::ActivateEnt {w} {
  1567.     upvar ::tk::dialog::file::[winfo name $w] data
  1568.  
  1569.     set text [$data(ent) get]
  1570.     if {$data(-multiple)} {
  1571.     # For the multiple case we have to be careful to get the file
  1572.     # names as a true list, watching out for a single file with a
  1573.     # space in the name.  Thus we query the IconList directly.
  1574.  
  1575.     set selIcos [::tk::IconList_CurSelection $data(icons)]
  1576.     set data(selectFile) ""
  1577.     if {[llength $selIcos] == 0 && $text ne ""} {
  1578.         # This assumes the user typed something in without selecting
  1579.         # files - so assume they only type in a single filename.
  1580.         VerifyFileName $w $text
  1581.     } else {
  1582.         foreach item $selIcos {
  1583.         VerifyFileName $w [::tk::IconList_Get $data(icons) $item]
  1584.         }
  1585.     }
  1586.     } else {
  1587.     VerifyFileName $w $text
  1588.     }
  1589. }
  1590.  
  1591. # Verification procedure
  1592. #
  1593. proc ::tk::dialog::file::VerifyFileName {w filename} {
  1594.     upvar ::tk::dialog::file::[winfo name $w] data
  1595.  
  1596.     set list [ResolveFile $data(selectPath) $filename $data(-defaultextension)]
  1597.     foreach {flag path file} $list {
  1598.     break
  1599.     }
  1600.  
  1601.     switch -- $flag {
  1602.     OK {
  1603.         if {$file eq ""} {
  1604.         # user has entered an existing (sub)directory
  1605.         set data(selectPath) $path
  1606.         $data(ent) delete 0 end
  1607.         } else {
  1608.         SetPathSilently $w $path
  1609.         if {$data(-multiple)} {
  1610.             lappend data(selectFile) $file
  1611.         } else {
  1612.             set data(selectFile) $file
  1613.         }
  1614.         Done $w
  1615.         }
  1616.     }
  1617.     PATTERN {
  1618.         set data(selectPath) $path
  1619.         set data(filter) $file
  1620.     }
  1621.     FILE {
  1622.         if {$data(type) eq "open"} {
  1623.         tk_messageBox -icon warning -type ok -parent $w \
  1624.             -message [mc "File \"%1\$s\"  does not exist." \
  1625.             [file join $path $file]]
  1626.         $data(ent) selection range 0 end
  1627.         $data(ent) icursor end
  1628.         } else {
  1629.         SetPathSilently $w $path
  1630.         if {$data(-multiple)} {
  1631.             lappend data(selectFile) $file
  1632.         } else {
  1633.             set data(selectFile) $file
  1634.         }
  1635.         Done $w
  1636.         }
  1637.     }
  1638.     PATH {
  1639.         tk_messageBox -icon warning -type ok -parent $w \
  1640.             -message [mc "Directory \"%1\$s\" does not exist." $path]
  1641.         $data(ent) selection range 0 end
  1642.         $data(ent) icursor end
  1643.     }
  1644.     CHDIR {
  1645.         tk_messageBox -type ok -parent $w -message -icon warning \
  1646.             [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $path]
  1647.         $data(ent) selection range 0 end
  1648.         $data(ent) icursor end
  1649.     }
  1650.     ERROR {
  1651.         tk_messageBox -type ok -parent $w -message -icon warning \
  1652.             [mc "Invalid file name \"%1\$s\"." $path]
  1653.         $data(ent) selection range 0 end
  1654.         $data(ent) icursor end
  1655.     }
  1656.     }
  1657. }
  1658.  
  1659. # Gets called when user presses the Alt-s or Alt-o keys.
  1660. #
  1661. proc ::tk::dialog::file::InvokeBtn {w key} {
  1662.     upvar ::tk::dialog::file::[winfo name $w] data
  1663.  
  1664.     if {[$data(okBtn) cget -text] eq $key} {
  1665.     ::tk::ButtonInvoke $data(okBtn)
  1666.     }
  1667. }
  1668.  
  1669. # Gets called when user presses the "parent directory" button
  1670. #
  1671. proc ::tk::dialog::file::UpDirCmd {w} {
  1672.     upvar ::tk::dialog::file::[winfo name $w] data
  1673.  
  1674.     if {$data(selectPath) ne "/"} {
  1675.     set data(selectPath) [file dirname $data(selectPath)]
  1676.     }
  1677. }
  1678.  
  1679. # Join a file name to a path name. The "file join" command will break
  1680. # if the filename begins with ~
  1681. #
  1682. proc ::tk::dialog::file::JoinFile {path file} {
  1683.     if {[string match {~*} $file] && [file exists $path/$file]} {
  1684.     return [file join $path ./$file]
  1685.     } else {
  1686.     return [file join $path $file]
  1687.     }
  1688. }
  1689.  
  1690. # Gets called when user presses the "OK" button
  1691. #
  1692. proc ::tk::dialog::file::OkCmd {w} {
  1693.     upvar ::tk::dialog::file::[winfo name $w] data
  1694.  
  1695.     set filenames {}
  1696.     foreach item [::tk::IconList_CurSelection $data(icons)] {
  1697.     lappend filenames [::tk::IconList_Get $data(icons) $item]
  1698.     }
  1699.  
  1700.     if {([llength $filenames] && !$data(-multiple)) || \
  1701.         ($data(-multiple) && ([llength $filenames] == 1))} {
  1702.     set filename [lindex $filenames 0]
  1703.     set file [JoinFile $data(selectPath) $filename]
  1704.     if {[file isdirectory $file]} {
  1705.         ListInvoke $w [list $filename]
  1706.         return
  1707.     }
  1708.     }
  1709.  
  1710.     ActivateEnt $w
  1711. }
  1712.  
  1713. # Gets called when user presses the "Cancel" button
  1714. #
  1715. proc ::tk::dialog::file::CancelCmd {w} {
  1716.     upvar ::tk::dialog::file::[winfo name $w] data
  1717.     variable ::tk::Priv
  1718.  
  1719.     bind $data(okBtn) <Destroy> {}
  1720.     set Priv(selectFilePath) ""
  1721. }
  1722.  
  1723. # Gets called when user destroys the dialog directly [Bug 987169]
  1724. #
  1725. proc ::tk::dialog::file::Destroyed {w} {
  1726.     upvar ::tk::dialog::file::[winfo name $w] data
  1727.     variable ::tk::Priv
  1728.  
  1729.     set Priv(selectFilePath) ""
  1730. }
  1731.  
  1732. # Gets called when user browses the IconList widget (dragging mouse, arrow
  1733. # keys, etc)
  1734. #
  1735. proc ::tk::dialog::file::ListBrowse {w} {
  1736.     upvar ::tk::dialog::file::[winfo name $w] data
  1737.  
  1738.     set text {}
  1739.     foreach item [::tk::IconList_CurSelection $data(icons)] {
  1740.     lappend text [::tk::IconList_Get $data(icons) $item]
  1741.     }
  1742.     if {[llength $text] == 0} {
  1743.     return
  1744.     }
  1745.     if { [llength $text] > 1 } {
  1746.     set newtext {}
  1747.     foreach file $text {
  1748.         set fullfile [JoinFile $data(selectPath) $file]
  1749.         if { ![file isdirectory $fullfile] } {
  1750.         lappend newtext $file
  1751.         }
  1752.     }
  1753.     set text $newtext
  1754.     set isDir 0
  1755.     } else {
  1756.     set text [lindex $text 0]
  1757.     set file [JoinFile $data(selectPath) $text]
  1758.     set isDir [file isdirectory $file]
  1759.     }
  1760.     if {!$isDir} {
  1761.     $data(ent) delete 0 end
  1762.     $data(ent) insert 0 $text
  1763.  
  1764.     if {[winfo class $w] eq "TkFDialog"} {
  1765.         if {$data(type) eq "open"} {
  1766.         ::tk::SetAmpText $data(okBtn) [mc "&Open"]
  1767.         } else {
  1768.         ::tk::SetAmpText $data(okBtn) [mc "&Save"]
  1769.         }
  1770.     }
  1771.     } elseif {[winfo class $w] eq "TkFDialog"} {
  1772.     ::tk::SetAmpText $data(okBtn) [mc "&Open"]
  1773.     }
  1774. }
  1775.  
  1776. # Gets called when user invokes the IconList widget (double-click,
  1777. # Return key, etc)
  1778. #
  1779. proc ::tk::dialog::file::ListInvoke {w filenames} {
  1780.     upvar ::tk::dialog::file::[winfo name $w] data
  1781.  
  1782.     if {[llength $filenames] == 0} {
  1783.     return
  1784.     }
  1785.  
  1786.     set file [JoinFile $data(selectPath) [lindex $filenames 0]]
  1787.  
  1788.     set class [winfo class $w]
  1789.     if {$class eq "TkChooseDir" || [file isdirectory $file]} {
  1790.     set appPWD [pwd]
  1791.     if {[catch {cd $file}]} {
  1792.         tk_messageBox -type ok -parent $w -message -icon warning \
  1793.             [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $file]
  1794.     } else {
  1795.         cd $appPWD
  1796.         set data(selectPath) $file
  1797.     }
  1798.     } else {
  1799.     if {$data(-multiple)} {
  1800.         set data(selectFile) $filenames
  1801.     } else {
  1802.         set data(selectFile) $file
  1803.     }
  1804.     Done $w
  1805.     }
  1806. }
  1807.  
  1808. # ::tk::dialog::file::Done --
  1809. #
  1810. #    Gets called when user has input a valid filename.  Pops up a
  1811. #    dialog box to confirm selection when necessary. Sets the
  1812. #    tk::Priv(selectFilePath) variable, which will break the "vwait"
  1813. #    loop in ::tk::dialog::file:: and return the selected filename to the
  1814. #    script that calls tk_getOpenFile or tk_getSaveFile
  1815. #
  1816. proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
  1817.     upvar ::tk::dialog::file::[winfo name $w] data
  1818.     variable ::tk::Priv
  1819.  
  1820.     if {$selectFilePath eq ""} {
  1821.     if {$data(-multiple)} {
  1822.         set selectFilePath {}
  1823.         foreach f $data(selectFile) {
  1824.         lappend selectFilePath [JoinFile $data(selectPath) $f]
  1825.         }
  1826.     } else {
  1827.         set selectFilePath [JoinFile $data(selectPath) $data(selectFile)]
  1828.     }
  1829.  
  1830.     set Priv(selectFile) $data(selectFile)
  1831.     set Priv(selectPath) $data(selectPath)
  1832.  
  1833.     if {($data(type) eq "save") && [file exists $selectFilePath]} {
  1834.         set reply [tk_messageBox -icon warning -type yesno -parent $w \
  1835.             -message [mc "File \"%1\$s\" already exists.\nDo you want\
  1836.             to overwrite it?" $selectFilePath]]
  1837.         if {$reply eq "no"} {
  1838.         return
  1839.         }
  1840.     }
  1841.     }
  1842.     bind $data(okBtn) <Destroy> {}
  1843.     set Priv(selectFilePath) $selectFilePath
  1844. }
  1845.