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