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