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