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