I686LINUX/util/I686LINUX/lib/tk8.4/tkfbox.tcl

   1 # tkfbox.tcl --
   2 #
   3 #       Implements the "TK" standard file selection dialog box. This
   4 #       dialog box is used on the Unix platforms whenever the tk_strictMotif
   5 #       flag is not set.
   6 #
   7 #       The "TK" standard file selection dialog box is similar to the
   8 #       file selection dialog box on Win95(TM). The user can navigate
   9 #       the directories by clicking on the folder icons or by
  10 #       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.3 2003/11/12 00:04:32 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
1083     set data(okBtn)     [::tk::AmpWidget button $f2.ok \
1084             -text "[mc "&OK"]"     -default active -pady 3]
1085     set data(cancelBtn) [::tk::AmpWidget button $f2.cancel \
1086             -text "[mc "&Cancel"]" -default normal -pady 3]
1087
1088     # grid the widgets in f2
1089     #
1090     grid $f2.lab $f2.ent $data(okBtn) -padx 4 -sticky ew
1091     grid configure $f2.ent -padx 2
1092     if { [string equal $class TkFDialog] } {
1093         grid $data(typeMenuLab) $data(typeMenuBtn) $data(cancelBtn) \
1094                 -padx 4 -sticky ew
1095         grid configure $data(typeMenuBtn) -padx 0
1096     } else {
1097         grid x x $data(cancelBtn) -padx 4 -sticky ew
1098     }
1099     grid columnconfigure $f2 1 -weight 1
1100
1101     # Pack all the frames together. We are done with widget construction.
1102     #
1103     pack $f1 -side top -fill x -pady 4
1104     pack $f2 -side bottom -fill x
1105     pack $data(icons) -expand yes -fill both -padx 4 -pady 1
1106
1107     # Set up the event handlers that are common to Directory and File Dialogs
1108     #
1109
1110     wm protocol $w WM_DELETE_WINDOW [list ::tk::dialog::file::CancelCmd $w]
1111     $data(upBtn)     config -command [list ::tk::dialog::file::UpDirCmd $w]
1112     $data(cancelBtn) config -command [list ::tk::dialog::file::CancelCmd $w]
1113     bind $w <KeyPress-Escape> [list tk::ButtonInvoke $data(cancelBtn)]
1114     bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A]
1115     # Set up event handlers specific to File or Directory Dialogs
1116     #
1117
1118     if { [string equal $class TkFDialog] } {
1119         bind $data(ent) <Return> [list ::tk::dialog::file::ActivateEnt $w]
1120         $data(okBtn)     config -command [list ::tk::dialog::file::OkCmd $w]
1121         bind $w <Alt-t> [format {
1122             if {[string equal [%s cget -state] "normal"]} {
1123                 focus %s
1124             }
1125         } $data(typeMenuBtn) $data(typeMenuBtn)]
1126     } else {
1127         set okCmd [list ::tk::dialog::file::chooseDir::OkCmd $w]
1128         bind $data(ent) <Return> $okCmd
1129         $data(okBtn) config -command $okCmd
1130         bind $w <Alt-s> [list focus $data(ent)]
1131         bind $w <Alt-o> [list tk::ButtonInvoke $data(okBtn)]
1132     }
1133
1134     # Build the focus group for all the entries
1135     #
1136     ::tk::FocusGroup_Create $w
1137     ::tk::FocusGroup_BindIn $w  $data(ent) [list ::tk::dialog::file::EntFocusIn $w]
1138     ::tk::FocusGroup_BindOut $w $data(ent) [list ::tk::dialog::file::EntFocusOut $w]
1139 }
1140
1141 # ::tk::dialog::file::SetSelectMode --
1142 #
1143 #       Set the select mode of the dialog to single select or multi-select.
1144 #
1145 # Arguments:
1146 #       w               The dialog path.
1147 #       multi           1 if the dialog is multi-select; 0 otherwise.
1148 #
1149 # Results:
1150 #       None.
1151
1152 proc ::tk::dialog::file::SetSelectMode {w multi} {
1153     set dataName __tk_filedialog
1154     upvar ::tk::dialog::file::$dataName data
1155     if { $multi } {
1156         set fNameCaption "[mc {File &names:}]"
1157     } else {
1158         set fNameCaption "[mc {File &name:}]"
1159     }
1160     set iconListCommand [list ::tk::dialog::file::OkCmd $w]
1161     ::tk::SetAmpText $w.f2.lab $fNameCaption
1162     ::tk::IconList_Config $data(icons) \
1163             [list -multiple $multi -command $iconListCommand]
1164     return
1165 }
1166
1167 # ::tk::dialog::file::UpdateWhenIdle --
1168 #
1169 #       Creates an idle event handler which updates the dialog in idle
1170 #       time. This is important because loading the directory may take a long
1171 #       time and we don't want to load the same directory for multiple times
1172 #       due to multiple concurrent events.
1173 #
1174 proc ::tk::dialog::file::UpdateWhenIdle {w} {
1175     upvar ::tk::dialog::file::[winfo name $w] data
1176
1177     if {[info exists data(updateId)]} {
1178         return
1179     } else {
1180         set data(updateId) [after idle [list ::tk::dialog::file::Update $w]]
1181     }
1182 }
1183
1184 # ::tk::dialog::file::Update --
1185 #
1186 #       Loads the files and directories into the IconList widget. Also
1187 #       sets up the directory option menu for quick access to parent
1188 #       directories.
1189 #
1190 proc ::tk::dialog::file::Update {w} {
1191
1192     # This proc may be called within an idle handler. Make sure that the
1193     # window has not been destroyed before this proc is called
1194     if {![winfo exists $w]} {
1195         return
1196     }
1197     set class [winfo class $w]
1198     if {($class ne "TkFDialog") && ($class ne "TkChooseDir")} {
1199         return
1200     }
1201
1202     set dataName [winfo name $w]
1203     upvar ::tk::dialog::file::$dataName data
1204     variable ::tk::Priv
1205     global tk_library
1206     catch {unset data(updateId)}
1207
1208     if {![info exists Priv(folderImage)]} {
1209         set Priv(folderImage) [image create photo -data {
1210 R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB
1211 QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]
1212         set Priv(fileImage)   [image create photo -data {
1213 R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO
1214 rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
1215     }
1216     set folder $Priv(folderImage)
1217     set file   $Priv(fileImage)
1218
1219     set appPWD [pwd]
1220     if {[catch {
1221         cd $data(selectPath)
1222     }]} {
1223         # We cannot change directory to $data(selectPath). $data(selectPath)
1224         # should have been checked before ::tk::dialog::file::Update is called, so
1225         # we normally won't come to here. Anyways, give an error and abort
1226         # action.
1227         tk_messageBox -type ok -parent $w -icon warning -message \
1228             [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $data(selectPath)]
1229         cd $appPWD
1230         return
1231     }
1232
1233     # Turn on the busy cursor. BUG?? We haven't disabled X events, though,
1234     # so the user may still click and cause havoc ...
1235     #
1236     set entCursor [$data(ent) cget -cursor]
1237     set dlgCursor [$w         cget -cursor]
1238     $data(ent) config -cursor watch
1239     $w         config -cursor watch
1240     update idletasks
1241
1242     ::tk::IconList_DeleteAll $data(icons)
1243
1244     # Make the dir list
1245     #
1246     set dirs [lsort -dictionary -unique \
1247                      [glob -tails -directory . -type d -nocomplain .* *]]
1248     set dirList {}
1249     foreach d $dirs {
1250         if {$d eq "." || $d eq ".."} {
1251             continue
1252         }
1253         lappend dirList $d
1254     }
1255     ::tk::IconList_Add $data(icons) $folder $dirList
1256
1257     if {$class eq "TkFDialog"} {
1258         # Make the file list if this is a File Dialog, selecting all
1259         # but 'd'irectory type files.
1260         #
1261         set cmd [list glob -tails -directory . -type {f b c l p s} -nocomplain]
1262         if {[string equal $data(filter) *]} {
1263             lappend cmd .* *
1264         } else {
1265             eval [list lappend cmd] $data(filter)
1266         }
1267         set fileList [lsort -dictionary -unique [eval $cmd]]
1268         ::tk::IconList_Add $data(icons) $file $fileList
1269     }
1270
1271     ::tk::IconList_Arrange $data(icons)
1272
1273     # Update the Directory: option menu
1274     #
1275     set list ""
1276     set dir ""
1277     foreach subdir [file split $data(selectPath)] {
1278         set dir [file join $dir $subdir]
1279         lappend list $dir
1280     }
1281
1282     $data(dirMenu) delete 0 end
1283     set var [format %s(selectPath) ::tk::dialog::file::$dataName]
1284     foreach path $list {
1285         $data(dirMenu) add command -label $path -command [list set $var $path]
1286     }
1287
1288     # Restore the PWD to the application's PWD
1289     #
1290     cd $appPWD
1291
1292     if { [string equal $class TkFDialog] } {
1293         # Restore the Open/Save Button if this is a File Dialog
1294         #
1295         if {[string equal $data(type) open]} {
1296             ::tk::SetAmpText $data(okBtn) [mc "&Open"]
1297         } else {
1298             ::tk::SetAmpText $data(okBtn) [mc "&Save"]
1299         }
1300     }
1301
1302     # turn off the busy cursor.
1303     #
1304     $data(ent) config -cursor $entCursor
1305     $w         config -cursor $dlgCursor
1306 }
1307
1308 # ::tk::dialog::file::SetPathSilently --
1309 #
1310 #       Sets data(selectPath) without invoking the trace procedure
1311 #
1312 proc ::tk::dialog::file::SetPathSilently {w path} {
1313     upvar ::tk::dialog::file::[winfo name $w] data
1314
1315     trace vdelete  data(selectPath) w [list ::tk::dialog::file::SetPath $w]
1316     set data(selectPath) $path
1317     trace variable data(selectPath) w [list ::tk::dialog::file::SetPath $w]
1318 }
1319
1320
1321 # This proc gets called whenever data(selectPath) is set
1322 #
1323 proc ::tk::dialog::file::SetPath {w name1 name2 op} {
1324     if {[winfo exists $w]} {
1325         upvar ::tk::dialog::file::[winfo name $w] data
1326         ::tk::dialog::file::UpdateWhenIdle $w
1327         # On directory dialogs, we keep the entry in sync with the currentdir.
1328         if { [string equal [winfo class $w] TkChooseDir] } {
1329             $data(ent) delete 0 end
1330             $data(ent) insert end $data(selectPath)
1331         }
1332     }
1333 }
1334
1335 # This proc gets called whenever data(filter) is set
1336 #
1337 proc ::tk::dialog::file::SetFilter {w type} {
1338     upvar ::tk::dialog::file::[winfo name $w] data
1339     upvar ::tk::$data(icons) icons
1340
1341     set data(filter) [lindex $type 1]
1342     $data(typeMenuBtn) config -text [lindex $type 0] -indicatoron 1
1343
1344     # If we aren't using a default extension, use the one suppled
1345     # by the filter.
1346     if {![info exists data(extUsed)]} {
1347         if {[string length $data(-defaultextension)]} {
1348             set data(extUsed) 1
1349         } else {
1350             set data(extUsed) 0
1351         }
1352     }
1353
1354     if {!$data(extUsed)} {
1355         # Get the first extension in the list that matches {^\*\.\w+$}
1356         # and remove all * from the filter.
1357         set index [lsearch -regexp $data(filter) {^\*\.\w+$}]
1358         if {$index >= 0} {
1359             set data(-defaultextension) \
1360                     [string trimleft [lindex $data(filter) $index] "*"]
1361         } else {
1362             # Couldn't find anything!  Reset to a safe default...
1363             set data(-defaultextension) ""
1364         }
1365     }
1366
1367     $icons(sbar) set 0.0 0.0
1368
1369     ::tk::dialog::file::UpdateWhenIdle $w
1370 }
1371
1372 # tk::dialog::file::ResolveFile --
1373 #
1374 #       Interpret the user's text input in a file selection dialog.
1375 #       Performs:
1376 #
1377 #       (1) ~ substitution
1378 #       (2) resolve all instances of . and ..
1379 #       (3) check for non-existent files/directories
1380 #       (4) check for chdir permissions
1381 #
1382 # Arguments:
1383 #       context:  the current directory you are in
1384 #       text:     the text entered by the user
1385 #       defaultext: the default extension to add to files with no extension
1386 #
1387 # Return vaue:
1388 #       [list $flag $directory $file]
1389 #
1390 #        flag = OK      : valid input
1391 #             = PATTERN : valid directory/pattern
1392 #             = PATH    : the directory does not exist
1393 #             = FILE    : the directory exists by the file doesn't
1394 #                         exist
1395 #             = CHDIR   : Cannot change to the directory
1396 #             = ERROR   : Invalid entry
1397 #
1398 #        directory      : valid only if flag = OK or PATTERN or FILE
1399 #        file           : valid only if flag = OK or PATTERN
1400 #
1401 #       directory may not be the same as context, because text may contain
1402 #       a subdirectory name
1403 #
1404 proc ::tk::dialog::file::ResolveFile {context text defaultext} {
1405
1406     set appPWD [pwd]
1407
1408     set path [::tk::dialog::file::JoinFile $context $text]
1409
1410     # If the file has no extension, append the default.  Be careful not
1411     # to do this for directories, otherwise typing a dirname in the box
1412     # will give back "dirname.extension" instead of trying to change dir.
1413     if {![file isdirectory $path] && [string equal [file ext $path] ""]} {
1414         set path "$path$defaultext"
1415     }
1416
1417
1418     if {[catch {file exists $path}]} {
1419         # This "if" block can be safely removed if the following code
1420         # stop generating errors.
1421         #
1422         #       file exists ~nonsuchuser
1423         #
1424         return [list ERROR $path ""]
1425     }
1426
1427     if {[file exists $path]} {
1428         if {[file isdirectory $path]} {
1429             if {[catch {cd $path}]} {
1430                 return [list CHDIR $path ""]
1431             }
1432             set directory [pwd]
1433             set file ""
1434             set flag OK
1435             cd $appPWD
1436         } else {
1437             if {[catch {cd [file dirname $path]}]} {
1438                 return [list CHDIR [file dirname $path] ""]
1439             }
1440             set directory [pwd]
1441             set file [file tail $path]
1442             set flag OK
1443             cd $appPWD
1444         }
1445     } else {
1446         set dirname [file dirname $path]
1447         if {[file exists $dirname]} {
1448             if {[catch {cd $dirname}]} {
1449                 return [list CHDIR $dirname ""]
1450             }
1451             set directory [pwd]
1452             set file [file tail $path]
1453             if {[regexp {[*]|[?]} $file]} {
1454                 set flag PATTERN
1455             } else {
1456                 set flag FILE
1457             }
1458             cd $appPWD
1459         } else {
1460             set directory $dirname
1461             set file [file tail $path]
1462             set flag PATH
1463         }
1464     }
1465
1466     return [list $flag $directory $file]
1467 }
1468
1469
1470 # Gets called when the entry box gets keyboard focus. We clear the selection
1471 # from the icon list . This way the user can be certain that the input in the
1472 # entry box is the selection.
1473 #
1474 proc ::tk::dialog::file::EntFocusIn {w} {
1475     upvar ::tk::dialog::file::[winfo name $w] data
1476
1477     if {[string compare [$data(ent) get] ""]} {
1478         $data(ent) selection range 0 end
1479         $data(ent) icursor end
1480     } else {
1481         $data(ent) selection clear
1482     }
1483
1484     if { [string equal [winfo class $w] TkFDialog] } {
1485         # If this is a File Dialog, make sure the buttons are labeled right.
1486         if {[string equal $data(type) open]} {
1487             ::tk::SetAmpText $data(okBtn) [mc "&Open"]
1488         } else {
1489             ::tk::SetAmpText $data(okBtn) [mc "&Save"]
1490         }
1491     }
1492 }
1493
1494 proc ::tk::dialog::file::EntFocusOut {w} {
1495     upvar ::tk::dialog::file::[winfo name $w] data
1496
1497     $data(ent) selection clear
1498 }
1499
1500
1501 # Gets called when user presses Return in the "File name" entry.
1502 #
1503 proc ::tk::dialog::file::ActivateEnt {w} {
1504     upvar ::tk::dialog::file::[winfo name $w] data
1505
1506     set text [$data(ent) get]
1507     if {$data(-multiple)} {
1508         # For the multiple case we have to be careful to get the file
1509         # names as a true list, watching out for a single file with a
1510         # space in the name.  Thus we query the IconList directly.
1511
1512         set selIcos [::tk::IconList_Curselection $data(icons)]
1513         set data(selectFile) ""
1514         if {[llength $selIcos] == 0 && $text ne ""} {
1515             # This assumes the user typed something in without selecting
1516             # files - so assume they only type in a single filename.
1517             ::tk::dialog::file::VerifyFileName $w $text
1518         } else {
1519             foreach item $selIcos {
1520                 ::tk::dialog::file::VerifyFileName $w \
1521                     [::tk::IconList_Get $data(icons) $item]
1522             }
1523         }
1524     } else {
1525         ::tk::dialog::file::VerifyFileName $w $text
1526     }
1527 }
1528
1529 # Verification procedure
1530 #
1531 proc ::tk::dialog::file::VerifyFileName {w filename} {
1532     upvar ::tk::dialog::file::[winfo name $w] data
1533
1534     set list [::tk::dialog::file::ResolveFile $data(selectPath) $filename \
1535             $data(-defaultextension)]
1536     foreach {flag path file} $list {
1537         break
1538     }
1539
1540     switch -- $flag {
1541         OK {
1542             if {[string equal $file ""]} {
1543                 # user has entered an existing (sub)directory
1544                 set data(selectPath) $path
1545                 $data(ent) delete 0 end
1546             } else {
1547                 ::tk::dialog::file::SetPathSilently $w $path
1548                 if {$data(-multiple)} {
1549                     lappend data(selectFile) $file
1550                 } else {
1551                     set data(selectFile) $file
1552                 }
1553                 ::tk::dialog::file::Done $w
1554             }
1555         }
1556         PATTERN {
1557             set data(selectPath) $path
1558             set data(filter) $file
1559         }
1560         FILE {
1561             if {[string equal $data(type) open]} {
1562                 tk_messageBox -icon warning -type ok -parent $w \
1563                     -message "[mc "File \"%1\$s\"  does not exist." [file join $path $file]]"
1564                 $data(ent) selection range 0 end
1565                 $data(ent) icursor end
1566             } else {
1567                 ::tk::dialog::file::SetPathSilently $w $path
1568                 if {$data(-multiple)} {
1569                     lappend data(selectFile) $file
1570                 } else {
1571                     set data(selectFile) $file
1572                 }
1573                 ::tk::dialog::file::Done $w
1574             }
1575         }
1576         PATH {
1577             tk_messageBox -icon warning -type ok -parent $w \
1578                 -message "[mc "Directory \"%1\$s\" does not exist." $path]"
1579             $data(ent) selection range 0 end
1580             $data(ent) icursor end
1581         }
1582         CHDIR {
1583             tk_messageBox -type ok -parent $w -message \
1584                "[mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $path]"\
1585                 -icon warning
1586             $data(ent) selection range 0 end
1587             $data(ent) icursor end
1588         }
1589         ERROR {
1590             tk_messageBox -type ok -parent $w -message \
1591                "[mc "Invalid file name \"%1\$s\"." $path]"\
1592                 -icon warning
1593             $data(ent) selection range 0 end
1594             $data(ent) icursor end
1595         }
1596     }
1597 }
1598
1599 # Gets called when user presses the Alt-s or Alt-o keys.
1600 #
1601 proc ::tk::dialog::file::InvokeBtn {w key} {
1602     upvar ::tk::dialog::file::[winfo name $w] data
1603
1604     if {[string equal [$data(okBtn) cget -text] $key]} {
1605         ::tk::ButtonInvoke $data(okBtn)
1606     }
1607 }
1608
1609 # Gets called when user presses the "parent directory" button
1610 #
1611 proc ::tk::dialog::file::UpDirCmd {w} {
1612     upvar ::tk::dialog::file::[winfo name $w] data
1613
1614     if {[string compare $data(selectPath) "/"]} {
1615         set data(selectPath) [file dirname $data(selectPath)]
1616     }
1617 }
1618
1619 # Join a file name to a path name. The "file join" command will break
1620 # if the filename begins with ~
1621 #
1622 proc ::tk::dialog::file::JoinFile {path file} {
1623     if {[string match {~*} $file] && [file exists $path/$file]} {
1624         return [file join $path ./$file]
1625     } else {
1626         return [file join $path $file]
1627     }
1628 }
1629
1630 # Gets called when user presses the "OK" button
1631 #
1632 proc ::tk::dialog::file::OkCmd {w} {
1633     upvar ::tk::dialog::file::[winfo name $w] data
1634
1635     set filenames {}
1636     foreach item [::tk::IconList_Curselection $data(icons)] {
1637         lappend filenames [::tk::IconList_Get $data(icons) $item]
1638     }
1639
1640     if {([llength $filenames] && !$data(-multiple)) || \
1641             ($data(-multiple) && ([llength $filenames] == 1))} {
1642         set filename [lindex $filenames 0]
1643         set file [::tk::dialog::file::JoinFile $data(selectPath) $filename]
1644         if {[file isdirectory $file]} {
1645             ::tk::dialog::file::ListInvoke $w [list $filename]
1646             return
1647         }
1648     }
1649
1650     ::tk::dialog::file::ActivateEnt $w
1651 }
1652
1653 # Gets called when user presses the "Cancel" button
1654 #
1655 proc ::tk::dialog::file::CancelCmd {w} {
1656     upvar ::tk::dialog::file::[winfo name $w] data
1657     variable ::tk::Priv
1658
1659     set Priv(selectFilePath) ""
1660 }
1661
1662 # Gets called when user browses the IconList widget (dragging mouse, arrow
1663 # keys, etc)
1664 #
1665 proc ::tk::dialog::file::ListBrowse {w} {
1666     upvar ::tk::dialog::file::[winfo name $w] data
1667
1668     set text {}
1669     foreach item [::tk::IconList_Curselection $data(icons)] {
1670         lappend text [::tk::IconList_Get $data(icons) $item]
1671     }
1672     if {[llength $text] == 0} {
1673         return
1674     }
1675     if { [llength $text] > 1 } {
1676         set newtext {}
1677         foreach file $text {
1678             set fullfile [::tk::dialog::file::JoinFile $data(selectPath) $file]
1679             if { ![file isdirectory $fullfile] } {
1680                 lappend newtext $file
1681             }
1682         }
1683         set text $newtext
1684         set isDir 0
1685     } else {
1686         set text [lindex $text 0]
1687         set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
1688         set isDir [file isdirectory $file]
1689     }
1690     if {!$isDir} {
1691         $data(ent) delete 0 end
1692         $data(ent) insert 0 $text
1693
1694         if { [string equal [winfo class $w] TkFDialog] } {
1695             if {[string equal $data(type) open]} {
1696                 ::tk::SetAmpText $data(okBtn) [mc "&Open"]
1697             } else {
1698                 ::tk::SetAmpText $data(okBtn) [mc "&Save"]
1699             }
1700         }
1701     } else {
1702         if { [string equal [winfo class $w] TkFDialog] } {
1703             ::tk::SetAmpText $data(okBtn) [mc "&Open"]
1704         }
1705     }
1706 }
1707
1708 # Gets called when user invokes the IconList widget (double-click,
1709 # Return key, etc)
1710 #
1711 proc ::tk::dialog::file::ListInvoke {w filenames} {
1712     upvar ::tk::dialog::file::[winfo name $w] data
1713
1714     if {[llength $filenames] == 0} {
1715         return
1716     }
1717
1718     set file [::tk::dialog::file::JoinFile $data(selectPath) \
1719             [lindex $filenames 0]]
1720
1721     set class [winfo class $w]
1722     if {[string equal $class TkChooseDir] || [file isdirectory $file]} {
1723         set appPWD [pwd]
1724         if {[catch {cd $file}]} {
1725             tk_messageBox -type ok -parent $w -message \
1726                "[mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $file]"\
1727                 -icon warning
1728         } else {
1729             cd $appPWD
1730             set data(selectPath) $file
1731         }
1732     } else {
1733         if {$data(-multiple)} {
1734             set data(selectFile) $filenames
1735         } else {
1736             set data(selectFile) $file
1737         }
1738         ::tk::dialog::file::Done $w
1739     }
1740 }
1741
1742 # ::tk::dialog::file::Done --
1743 #
1744 #       Gets called when user has input a valid filename.  Pops up a
1745 #       dialog box to confirm selection when necessary. Sets the
1746 #       tk::Priv(selectFilePath) variable, which will break the "vwait"
1747 #       loop in ::tk::dialog::file:: and return the selected filename to the
1748 #       script that calls tk_getOpenFile or tk_getSaveFile
1749 #
1750 proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
1751     upvar ::tk::dialog::file::[winfo name $w] data
1752     variable ::tk::Priv
1753
1754     if {[string equal $selectFilePath ""]} {
1755         if {$data(-multiple)} {
1756             set selectFilePath {}
1757             foreach f $data(selectFile) {
1758                 lappend selectFilePath [::tk::dialog::file::JoinFile \
1759                     $data(selectPath) $f]
1760             }
1761         } else {
1762             set selectFilePath [::tk::dialog::file::JoinFile \
1763                     $data(selectPath) $data(selectFile)]
1764         }
1765
1766         set Priv(selectFile)     $data(selectFile)
1767         set Priv(selectPath)     $data(selectPath)
1768
1769         if {[string equal $data(type) save]} {
1770             if {[file exists $selectFilePath]} {
1771             set reply [tk_messageBox -icon warning -type yesno\
1772                     -parent $w -message \
1773                         "[mc "File \"%1\$s\" already exists.\nDo you want to overwrite it?" $selectFilePath]"]
1774             if {[string equal $reply "no"]} {
1775                 return
1776                 }
1777             }
1778         }
1779     }
1780     set Priv(selectFilePath) $selectFilePath
1781 }