xmfbox.tcl (26075B)
1 # xmfbox.tcl -- 2 # 3 # Implements the "Motif" style file selection dialog for the 4 # Unix platform. This implementation is used only if the 5 # "::tk_strictMotif" flag is set. 6 # 7 # Copyright (c) 1996 Sun Microsystems, Inc. 8 # Copyright (c) 1998-2000 Scriptics Corporation 9 # 10 # See the file "license.terms" for information on usage and redistribution 11 # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 12 13 namespace eval ::tk::dialog {} 14 namespace eval ::tk::dialog::file {} 15 16 17 # ::tk::MotifFDialog -- 18 # 19 # Implements a file dialog similar to the standard Motif file 20 # selection box. 21 # 22 # Arguments: 23 # type "open" or "save" 24 # args Options parsed by the procedure. 25 # 26 # Results: 27 # When -multiple is set to 0, this returns the absolute pathname 28 # of the selected file. (NOTE: This is not the same as a single 29 # element list.) 30 # 31 # When -multiple is set to > 0, this returns a Tcl list of absolute 32 # pathnames. The argument for -multiple is ignored, but for consistency 33 # with Windows it defines the maximum amount of memory to allocate for 34 # the returned filenames. 35 36 proc ::tk::MotifFDialog {type args} { 37 variable ::tk::Priv 38 set dataName __tk_filedialog 39 upvar ::tk::dialog::file::$dataName data 40 41 set w [MotifFDialog_Create $dataName $type $args] 42 43 # Set a grab and claim the focus too. 44 45 ::tk::SetFocusGrab $w $data(sEnt) 46 $data(sEnt) selection range 0 end 47 48 # Wait for the user to respond, then restore the focus and 49 # return the index of the selected button. Restore the focus 50 # before deleting the window, since otherwise the window manager 51 # may take the focus away so we can't redirect it. Finally, 52 # restore any grab that was in effect. 53 54 vwait ::tk::Priv(selectFilePath) 55 set result $Priv(selectFilePath) 56 ::tk::RestoreFocusGrab $w $data(sEnt) withdraw 57 58 return $result 59 } 60 61 # ::tk::MotifFDialog_Create -- 62 # 63 # Creates the Motif file dialog (if it doesn't exist yet) and 64 # initialize the internal data structure associated with the 65 # dialog. 66 # 67 # This procedure is used by ::tk::MotifFDialog to create the 68 # dialog. It's also used by the test suite to test the Motif 69 # file dialog implementation. User code shouldn't call this 70 # procedure directly. 71 # 72 # Arguments: 73 # dataName Name of the global "data" array for the file dialog. 74 # type "Save" or "Open" 75 # argList Options parsed by the procedure. 76 # 77 # Results: 78 # Pathname of the file dialog. 79 80 proc ::tk::MotifFDialog_Create {dataName type argList} { 81 upvar ::tk::dialog::file::$dataName data 82 83 MotifFDialog_Config $dataName $type $argList 84 85 if {$data(-parent) eq "."} { 86 set w .$dataName 87 } else { 88 set w $data(-parent).$dataName 89 } 90 91 # (re)create the dialog box if necessary 92 # 93 if {![winfo exists $w]} { 94 MotifFDialog_BuildUI $w 95 } elseif {[winfo class $w] ne "TkMotifFDialog"} { 96 destroy $w 97 MotifFDialog_BuildUI $w 98 } else { 99 set data(fEnt) $w.top.f1.ent 100 set data(dList) $w.top.f2.a.l 101 set data(fList) $w.top.f2.b.l 102 set data(sEnt) $w.top.f3.ent 103 set data(okBtn) $w.bot.ok 104 set data(filterBtn) $w.bot.filter 105 set data(cancelBtn) $w.bot.cancel 106 } 107 MotifFDialog_SetListMode $w 108 109 # Dialog boxes should be transient with respect to their parent, 110 # so that they will always stay on top of their parent window. However, 111 # some window managers will create the window as withdrawn if the parent 112 # window is withdrawn or iconified. Combined with the grab we put on the 113 # window, this can hang the entire application. Therefore we only make 114 # the dialog transient if the parent is viewable. 115 116 if {[winfo viewable [winfo toplevel $data(-parent)]] } { 117 wm transient $w $data(-parent) 118 } 119 120 MotifFDialog_FileTypes $w 121 MotifFDialog_Update $w 122 123 # Withdraw the window, then update all the geometry information 124 # so we know how big it wants to be, then center the window in the 125 # display (Motif style) and de-iconify it. 126 127 ::tk::PlaceWindow $w 128 wm title $w $data(-title) 129 130 return $w 131 } 132 133 # ::tk::MotifFDialog_FileTypes -- 134 # 135 # Checks the -filetypes option. If present this adds a list of radio- 136 # buttons to pick the file types from. 137 # 138 # Arguments: 139 # w Pathname of the tk_get*File dialogue. 140 # 141 # Results: 142 # none 143 144 proc ::tk::MotifFDialog_FileTypes {w} { 145 upvar ::tk::dialog::file::[winfo name $w] data 146 147 set f $w.top.f3.types 148 destroy $f 149 150 # No file types: use "*" as the filter and display no radio-buttons 151 if {$data(-filetypes) eq ""} { 152 set data(filter) * 153 return 154 } 155 156 # The filetypes radiobuttons 157 # set data(fileType) $data(-defaulttype) 158 # Default type to first entry 159 set initialTypeName [lindex $data(origfiletypes) 0 0] 160 if {$data(-typevariable) ne ""} { 161 upvar #0 $data(-typevariable) typeVariable 162 if {[info exists typeVariable]} { 163 set initialTypeName $typeVariable 164 } 165 } 166 set ix 0 167 set data(fileType) 0 168 foreach fltr $data(origfiletypes) { 169 set fname [lindex $fltr 0] 170 if {[string first $initialTypeName $fname] == 0} { 171 set data(fileType) $ix 172 break 173 } 174 incr ix 175 } 176 177 MotifFDialog_SetFilter $w [lindex $data(-filetypes) $data(fileType)] 178 179 #don't produce radiobuttons for only one filetype 180 if {[llength $data(-filetypes)] == 1} { 181 return 182 } 183 184 frame $f 185 set cnt 0 186 if {$data(-filetypes) ne {}} { 187 foreach type $data(-filetypes) { 188 set title [lindex $type 0] 189 set filter [lindex $type 1] 190 radiobutton $f.b$cnt \ 191 -text $title \ 192 -variable ::tk::dialog::file::[winfo name $w](fileType) \ 193 -value $cnt \ 194 -command [list tk::MotifFDialog_SetFilter $w $type] 195 pack $f.b$cnt -side left 196 incr cnt 197 } 198 } 199 $f.b$data(fileType) invoke 200 201 pack $f -side bottom -fill both 202 203 return 204 } 205 206 # This proc gets called whenever data(filter) is set 207 # 208 proc ::tk::MotifFDialog_SetFilter {w type} { 209 upvar ::tk::dialog::file::[winfo name $w] data 210 variable ::tk::Priv 211 212 set data(filter) [lindex $type 1] 213 set Priv(selectFileType) [lindex [lindex $type 0] 0] 214 215 MotifFDialog_Update $w 216 } 217 218 # ::tk::MotifFDialog_Config -- 219 # 220 # Iterates over the optional arguments to determine the option 221 # values for the Motif file dialog; gives default values to 222 # unspecified options. 223 # 224 # Arguments: 225 # dataName The name of the global variable in which 226 # data for the file dialog is stored. 227 # type "Save" or "Open" 228 # argList Options parsed by the procedure. 229 230 proc ::tk::MotifFDialog_Config {dataName type argList} { 231 upvar ::tk::dialog::file::$dataName data 232 233 set data(type) $type 234 235 # 1: the configuration specs 236 # 237 set specs { 238 {-defaultextension "" "" ""} 239 {-filetypes "" "" ""} 240 {-initialdir "" "" ""} 241 {-initialfile "" "" ""} 242 {-parent "" "" "."} 243 {-title "" "" ""} 244 {-typevariable "" "" ""} 245 } 246 if {$type eq "open"} { 247 lappend specs {-multiple "" "" "0"} 248 } 249 if {$type eq "save"} { 250 lappend specs {-confirmoverwrite "" "" "1"} 251 } 252 253 set data(-multiple) 0 254 set data(-confirmoverwrite) 1 255 # 2: default values depending on the type of the dialog 256 # 257 if {![info exists data(selectPath)]} { 258 # first time the dialog has been popped up 259 set data(selectPath) [pwd] 260 set data(selectFile) "" 261 } 262 263 # 3: parse the arguments 264 # 265 tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList 266 267 if {$data(-title) eq ""} { 268 if {$type eq "open"} { 269 if {$data(-multiple) != 0} { 270 set data(-title) "[mc {Open Multiple Files}]" 271 } else { 272 set data(-title) [mc "Open"] 273 } 274 } else { 275 set data(-title) [mc "Save As"] 276 } 277 } 278 279 # 4: set the default directory and selection according to the -initial 280 # settings 281 # 282 if {$data(-initialdir) ne ""} { 283 if {[file isdirectory $data(-initialdir)]} { 284 set data(selectPath) [lindex [glob $data(-initialdir)] 0] 285 } else { 286 set data(selectPath) [pwd] 287 } 288 289 # Convert the initialdir to an absolute path name. 290 291 set old [pwd] 292 cd $data(selectPath) 293 set data(selectPath) [pwd] 294 cd $old 295 } 296 set data(selectFile) $data(-initialfile) 297 298 # 5. Parse the -filetypes option. It is not used by the motif 299 # file dialog, but we check for validity of the value to make sure 300 # the application code also runs fine with the TK file dialog. 301 # 302 set data(origfiletypes) $data(-filetypes) 303 set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)] 304 305 if {![info exists data(filter)]} { 306 set data(filter) * 307 } 308 if {![winfo exists $data(-parent)]} { 309 return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ 310 "bad window path name \"$data(-parent)\"" 311 } 312 } 313 314 # ::tk::MotifFDialog_BuildUI -- 315 # 316 # Builds the UI components of the Motif file dialog. 317 # 318 # Arguments: 319 # w Pathname of the dialog to build. 320 # 321 # Results: 322 # None. 323 324 proc ::tk::MotifFDialog_BuildUI {w} { 325 set dataName [lindex [split $w .] end] 326 upvar ::tk::dialog::file::$dataName data 327 328 # Create the dialog toplevel and internal frames. 329 # 330 toplevel $w -class TkMotifFDialog 331 set top [frame $w.top -relief raised -bd 1] 332 set bot [frame $w.bot -relief raised -bd 1] 333 334 pack $w.bot -side bottom -fill x 335 pack $w.top -side top -expand yes -fill both 336 337 set f1 [frame $top.f1] 338 set f2 [frame $top.f2] 339 set f3 [frame $top.f3] 340 341 pack $f1 -side top -fill x 342 pack $f3 -side bottom -fill x 343 pack $f2 -expand yes -fill both 344 345 set f2a [frame $f2.a] 346 set f2b [frame $f2.b] 347 348 grid $f2a -row 0 -column 0 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \ 349 -sticky news 350 grid $f2b -row 0 -column 1 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \ 351 -sticky news 352 grid rowconfigure $f2 0 -minsize 0 -weight 1 353 grid columnconfigure $f2 0 -minsize 0 -weight 1 354 grid columnconfigure $f2 1 -minsize 150 -weight 2 355 356 # The Filter box 357 # 358 bind [::tk::AmpWidget label $f1.lab -text [mc "Fil&ter:"] -anchor w] \ 359 <<AltUnderlined>> [list focus $f1.ent] 360 entry $f1.ent 361 pack $f1.lab -side top -fill x -padx 6 -pady 4 362 pack $f1.ent -side top -fill x -padx 4 -pady 0 363 set data(fEnt) $f1.ent 364 365 # The file and directory lists 366 # 367 set data(dList) [MotifFDialog_MakeSList $w $f2a \ 368 [mc "&Directory:"] DList] 369 set data(fList) [MotifFDialog_MakeSList $w $f2b \ 370 [mc "Fi&les:"] FList] 371 372 # The Selection box 373 # 374 bind [::tk::AmpWidget label $f3.lab -text [mc "&Selection:"] -anchor w] \ 375 <<AltUnderlined>> [list focus $f3.ent] 376 entry $f3.ent 377 pack $f3.lab -side top -fill x -padx 6 -pady 0 378 pack $f3.ent -side top -fill x -padx 4 -pady 4 379 set data(sEnt) $f3.ent 380 381 # The buttons 382 # 383 set maxWidth [::tk::mcmaxamp &OK &Filter &Cancel] 384 set maxWidth [expr {$maxWidth<6?6:$maxWidth}] 385 set data(okBtn) [::tk::AmpWidget button $bot.ok -text [mc "&OK"] \ 386 -width $maxWidth \ 387 -command [list tk::MotifFDialog_OkCmd $w]] 388 set data(filterBtn) [::tk::AmpWidget button $bot.filter -text [mc "&Filter"] \ 389 -width $maxWidth \ 390 -command [list tk::MotifFDialog_FilterCmd $w]] 391 set data(cancelBtn) [::tk::AmpWidget button $bot.cancel -text [mc "&Cancel"] \ 392 -width $maxWidth \ 393 -command [list tk::MotifFDialog_CancelCmd $w]] 394 395 pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \ 396 -side left 397 398 # Create the bindings: 399 # 400 bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A] 401 402 bind $data(fEnt) <Return> [list tk::MotifFDialog_ActivateFEnt $w] 403 bind $data(sEnt) <Return> [list tk::MotifFDialog_ActivateSEnt $w] 404 bind $w <Escape> [list tk::MotifFDialog_CancelCmd $w] 405 bind $w.bot <Destroy> {set ::tk::Priv(selectFilePath) {}} 406 407 wm protocol $w WM_DELETE_WINDOW [list tk::MotifFDialog_CancelCmd $w] 408 } 409 410 proc ::tk::MotifFDialog_SetListMode {w} { 411 upvar ::tk::dialog::file::[winfo name $w] data 412 413 if {$data(-multiple) != 0} { 414 set selectmode extended 415 } else { 416 set selectmode browse 417 } 418 set f $w.top.f2.b 419 $f.l configure -selectmode $selectmode 420 } 421 422 # ::tk::MotifFDialog_MakeSList -- 423 # 424 # Create a scrolled-listbox and set the keyboard accelerator 425 # bindings so that the list selection follows what the user 426 # types. 427 # 428 # Arguments: 429 # w Pathname of the dialog box. 430 # f Frame widget inside which to create the scrolled 431 # listbox. This frame widget already exists. 432 # label The string to display on top of the listbox. 433 # under Sets the -under option of the label. 434 # cmdPrefix Specifies procedures to call when the listbox is 435 # browsed or activated. 436 437 proc ::tk::MotifFDialog_MakeSList {w f label cmdPrefix} { 438 bind [::tk::AmpWidget label $f.lab -text $label -anchor w] \ 439 <<AltUnderlined>> [list focus $f.l] 440 listbox $f.l -width 12 -height 5 -exportselection 0\ 441 -xscrollcommand [list $f.h set] -yscrollcommand [list $f.v set] 442 scrollbar $f.v -orient vertical -takefocus 0 -command [list $f.l yview] 443 scrollbar $f.h -orient horizontal -takefocus 0 -command [list $f.l xview] 444 grid $f.lab -row 0 -column 0 -sticky news -rowspan 1 -columnspan 2 \ 445 -padx 2 -pady 2 446 grid $f.l -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news 447 grid $f.v -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky news 448 grid $f.h -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky news 449 450 grid rowconfigure $f 0 -weight 0 -minsize 0 451 grid rowconfigure $f 1 -weight 1 -minsize 0 452 grid columnconfigure $f 0 -weight 1 -minsize 0 453 454 # bindings for the listboxes 455 # 456 set list $f.l 457 bind $list <<ListboxSelect>> [list tk::MotifFDialog_Browse$cmdPrefix $w] 458 bind $list <Double-ButtonRelease-1> \ 459 [list tk::MotifFDialog_Activate$cmdPrefix $w] 460 bind $list <Return> "tk::MotifFDialog_Browse$cmdPrefix [list $w]; \ 461 tk::MotifFDialog_Activate$cmdPrefix [list $w]" 462 463 bindtags $list [list Listbox $list [winfo toplevel $list] all] 464 ListBoxKeyAccel_Set $list 465 466 return $f.l 467 } 468 469 # ::tk::MotifFDialog_InterpFilter -- 470 # 471 # Interpret the string in the filter entry into two components: 472 # the directory and the pattern. If the string is a relative 473 # pathname, give a warning to the user and restore the pattern 474 # to original. 475 # 476 # Arguments: 477 # w pathname of the dialog box. 478 # 479 # Results: 480 # A list of two elements. The first element is the directory 481 # specified # by the filter. The second element is the filter 482 # pattern itself. 483 484 proc ::tk::MotifFDialog_InterpFilter {w} { 485 upvar ::tk::dialog::file::[winfo name $w] data 486 487 set text [string trim [$data(fEnt) get]] 488 489 # Perform tilde substitution 490 # 491 set badTilde 0 492 if {[string index $text 0] eq "~"} { 493 set list [file split $text] 494 set tilde [lindex $list 0] 495 if {[catch {set tilde [glob $tilde]}]} { 496 set badTilde 1 497 } else { 498 set text [eval file join [concat $tilde [lrange $list 1 end]]] 499 } 500 } 501 502 # If the string is a relative pathname, combine it 503 # with the current selectPath. 504 505 set relative 0 506 if {[file pathtype $text] eq "relative"} { 507 set relative 1 508 } elseif {$badTilde} { 509 set relative 1 510 } 511 512 if {$relative} { 513 tk_messageBox -icon warning -type ok \ 514 -message "\"$text\" must be an absolute pathname" 515 516 $data(fEnt) delete 0 end 517 $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \ 518 $data(filter)] 519 520 return [list $data(selectPath) $data(filter)] 521 } 522 523 set resolved [::tk::dialog::file::JoinFile [file dirname $text] [file tail $text]] 524 525 if {[file isdirectory $resolved]} { 526 set dir $resolved 527 set fil $data(filter) 528 } else { 529 set dir [file dirname $resolved] 530 set fil [file tail $resolved] 531 } 532 533 return [list $dir $fil] 534 } 535 536 # ::tk::MotifFDialog_Update 537 # 538 # Load the files and synchronize the "filter" and "selection" fields 539 # boxes. 540 # 541 # Arguments: 542 # w pathname of the dialog box. 543 # 544 # Results: 545 # None. 546 547 proc ::tk::MotifFDialog_Update {w} { 548 upvar ::tk::dialog::file::[winfo name $w] data 549 550 $data(fEnt) delete 0 end 551 $data(fEnt) insert 0 \ 552 [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)] 553 $data(sEnt) delete 0 end 554 $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \ 555 $data(selectFile)] 556 557 MotifFDialog_LoadFiles $w 558 } 559 560 # ::tk::MotifFDialog_LoadFiles -- 561 # 562 # Loads the files and directories into the two listboxes according 563 # to the filter setting. 564 # 565 # Arguments: 566 # w pathname of the dialog box. 567 # 568 # Results: 569 # None. 570 571 proc ::tk::MotifFDialog_LoadFiles {w} { 572 upvar ::tk::dialog::file::[winfo name $w] data 573 574 $data(dList) delete 0 end 575 $data(fList) delete 0 end 576 577 set appPWD [pwd] 578 if {[catch {cd $data(selectPath)}]} { 579 cd $appPWD 580 581 $data(dList) insert end ".." 582 return 583 } 584 585 # Make the dir and file lists 586 # 587 # For speed we only have one glob, which reduces the file system 588 # calls (good for slow NFS networks). 589 # 590 # We also do two smaller sorts (files + dirs) instead of one large sort, 591 # which gives a small speed increase. 592 # 593 set top 0 594 set dlist "" 595 set flist "" 596 foreach f [glob -nocomplain .* *] { 597 if {[file isdir ./$f]} { 598 lappend dlist $f 599 } else { 600 foreach pat $data(filter) { 601 if {[string match $pat $f]} { 602 if {[string match .* $f]} { 603 incr top 604 } 605 lappend flist $f 606 break 607 } 608 } 609 } 610 } 611 eval [list $data(dList) insert end] [lsort -dictionary $dlist] 612 eval [list $data(fList) insert end] [lsort -dictionary $flist] 613 614 # The user probably doesn't want to see the . files. We adjust the view 615 # so that the listbox displays all the non-dot files 616 $data(fList) yview $top 617 618 cd $appPWD 619 } 620 621 # ::tk::MotifFDialog_BrowseDList -- 622 # 623 # This procedure is called when the directory list is browsed 624 # (clicked-over) by the user. 625 # 626 # Arguments: 627 # w The pathname of the dialog box. 628 # 629 # Results: 630 # None. 631 632 proc ::tk::MotifFDialog_BrowseDList {w} { 633 upvar ::tk::dialog::file::[winfo name $w] data 634 635 focus $data(dList) 636 if {[$data(dList) curselection] eq ""} { 637 return 638 } 639 set subdir [$data(dList) get [$data(dList) curselection]] 640 if {$subdir eq ""} { 641 return 642 } 643 644 $data(fList) selection clear 0 end 645 646 set list [MotifFDialog_InterpFilter $w] 647 set data(filter) [lindex $list 1] 648 649 switch -- $subdir { 650 . { 651 set newSpec [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)] 652 } 653 .. { 654 set newSpec [::tk::dialog::file::JoinFile [file dirname $data(selectPath)] \ 655 $data(filter)] 656 } 657 default { 658 set newSpec [::tk::dialog::file::JoinFile [::tk::dialog::file::JoinFile \ 659 $data(selectPath) $subdir] $data(filter)] 660 } 661 } 662 663 $data(fEnt) delete 0 end 664 $data(fEnt) insert 0 $newSpec 665 } 666 667 # ::tk::MotifFDialog_ActivateDList -- 668 # 669 # This procedure is called when the directory list is activated 670 # (double-clicked) by the user. 671 # 672 # Arguments: 673 # w The pathname of the dialog box. 674 # 675 # Results: 676 # None. 677 678 proc ::tk::MotifFDialog_ActivateDList {w} { 679 upvar ::tk::dialog::file::[winfo name $w] data 680 681 if {[$data(dList) curselection] eq ""} { 682 return 683 } 684 set subdir [$data(dList) get [$data(dList) curselection]] 685 if {$subdir eq ""} { 686 return 687 } 688 689 $data(fList) selection clear 0 end 690 691 switch -- $subdir { 692 . { 693 set newDir $data(selectPath) 694 } 695 .. { 696 set newDir [file dirname $data(selectPath)] 697 } 698 default { 699 set newDir [::tk::dialog::file::JoinFile $data(selectPath) $subdir] 700 } 701 } 702 703 set data(selectPath) $newDir 704 MotifFDialog_Update $w 705 706 if {$subdir ne ".."} { 707 $data(dList) selection set 0 708 $data(dList) activate 0 709 } else { 710 $data(dList) selection set 1 711 $data(dList) activate 1 712 } 713 } 714 715 # ::tk::MotifFDialog_BrowseFList -- 716 # 717 # This procedure is called when the file list is browsed 718 # (clicked-over) by the user. 719 # 720 # Arguments: 721 # w The pathname of the dialog box. 722 # 723 # Results: 724 # None. 725 726 proc ::tk::MotifFDialog_BrowseFList {w} { 727 upvar ::tk::dialog::file::[winfo name $w] data 728 729 focus $data(fList) 730 set data(selectFile) "" 731 foreach item [$data(fList) curselection] { 732 lappend data(selectFile) [$data(fList) get $item] 733 } 734 if {[llength $data(selectFile)] == 0} { 735 return 736 } 737 738 $data(dList) selection clear 0 end 739 740 $data(fEnt) delete 0 end 741 $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \ 742 $data(filter)] 743 $data(fEnt) xview end 744 745 # if it's a multiple selection box, just put in the filenames 746 # otherwise put in the full path as usual 747 $data(sEnt) delete 0 end 748 if {$data(-multiple) != 0} { 749 $data(sEnt) insert 0 $data(selectFile) 750 } else { 751 $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \ 752 [lindex $data(selectFile) 0]] 753 } 754 $data(sEnt) xview end 755 } 756 757 # ::tk::MotifFDialog_ActivateFList -- 758 # 759 # This procedure is called when the file list is activated 760 # (double-clicked) by the user. 761 # 762 # Arguments: 763 # w The pathname of the dialog box. 764 # 765 # Results: 766 # None. 767 768 proc ::tk::MotifFDialog_ActivateFList {w} { 769 upvar ::tk::dialog::file::[winfo name $w] data 770 771 if {[$data(fList) curselection] eq ""} { 772 return 773 } 774 set data(selectFile) [$data(fList) get [$data(fList) curselection]] 775 if {$data(selectFile) eq ""} { 776 return 777 } else { 778 MotifFDialog_ActivateSEnt $w 779 } 780 } 781 782 # ::tk::MotifFDialog_ActivateFEnt -- 783 # 784 # This procedure is called when the user presses Return inside 785 # the "filter" entry. It updates the dialog according to the 786 # text inside the filter entry. 787 # 788 # Arguments: 789 # w The pathname of the dialog box. 790 # 791 # Results: 792 # None. 793 794 proc ::tk::MotifFDialog_ActivateFEnt {w} { 795 upvar ::tk::dialog::file::[winfo name $w] data 796 797 set list [MotifFDialog_InterpFilter $w] 798 set data(selectPath) [lindex $list 0] 799 set data(filter) [lindex $list 1] 800 801 MotifFDialog_Update $w 802 } 803 804 # ::tk::MotifFDialog_ActivateSEnt -- 805 # 806 # This procedure is called when the user presses Return inside 807 # the "selection" entry. It sets the ::tk::Priv(selectFilePath) 808 # variable so that the vwait loop in tk::MotifFDialog will be 809 # terminated. 810 # 811 # Arguments: 812 # w The pathname of the dialog box. 813 # 814 # Results: 815 # None. 816 817 proc ::tk::MotifFDialog_ActivateSEnt {w} { 818 variable ::tk::Priv 819 upvar ::tk::dialog::file::[winfo name $w] data 820 821 set selectFilePath [string trim [$data(sEnt) get]] 822 823 if {$selectFilePath eq ""} { 824 MotifFDialog_FilterCmd $w 825 return 826 } 827 828 if {$data(-multiple) == 0} { 829 set selectFilePath [list $selectFilePath] 830 } 831 832 if {[file isdirectory [lindex $selectFilePath 0]]} { 833 set data(selectPath) [lindex [glob $selectFilePath] 0] 834 set data(selectFile) "" 835 MotifFDialog_Update $w 836 return 837 } 838 839 set newFileList "" 840 foreach item $selectFilePath { 841 if {[file pathtype $item] ne "absolute"} { 842 set item [file join $data(selectPath) $item] 843 } elseif {![file exists [file dirname $item]]} { 844 tk_messageBox -icon warning -type ok \ 845 -message [mc {Directory "%1$s" does not exist.} \ 846 [file dirname $item]] 847 return 848 } 849 850 if {![file exists $item]} { 851 if {$data(type) eq "open"} { 852 tk_messageBox -icon warning -type ok \ 853 -message [mc {File "%1$s" does not exist.} $item] 854 return 855 } 856 } elseif {$data(type) eq "save" && $data(-confirmoverwrite)} { 857 set message [format %s%s \ 858 [mc "File \"%1\$s\" already exists.\n\n" $selectFilePath] \ 859 [mc {Replace existing file?}]] 860 set answer [tk_messageBox -icon warning -type yesno \ 861 -message $message] 862 if {$answer eq "no"} { 863 return 864 } 865 } 866 867 lappend newFileList $item 868 } 869 870 # Return selected filter 871 if {[info exists data(-typevariable)] && $data(-typevariable) ne "" 872 && [info exists data(-filetypes)] && $data(-filetypes) ne ""} { 873 upvar #0 $data(-typevariable) typeVariable 874 set typeVariable [lindex $data(origfiletypes) $data(fileType) 0] 875 } 876 877 if {$data(-multiple) != 0} { 878 set Priv(selectFilePath) $newFileList 879 } else { 880 set Priv(selectFilePath) [lindex $newFileList 0] 881 } 882 883 # Set selectFile and selectPath to first item in list 884 set Priv(selectFile) [file tail [lindex $newFileList 0]] 885 set Priv(selectPath) [file dirname [lindex $newFileList 0]] 886 } 887 888 889 proc ::tk::MotifFDialog_OkCmd {w} { 890 upvar ::tk::dialog::file::[winfo name $w] data 891 892 MotifFDialog_ActivateSEnt $w 893 } 894 895 proc ::tk::MotifFDialog_FilterCmd {w} { 896 upvar ::tk::dialog::file::[winfo name $w] data 897 898 MotifFDialog_ActivateFEnt $w 899 } 900 901 proc ::tk::MotifFDialog_CancelCmd {w} { 902 variable ::tk::Priv 903 904 set Priv(selectFilePath) "" 905 set Priv(selectFile) "" 906 set Priv(selectPath) "" 907 } 908 909 proc ::tk::ListBoxKeyAccel_Set {w} { 910 bind Listbox <Any-KeyPress> "" 911 bind $w <Destroy> [list tk::ListBoxKeyAccel_Unset $w] 912 bind $w <Any-KeyPress> [list tk::ListBoxKeyAccel_Key $w %A] 913 } 914 915 proc ::tk::ListBoxKeyAccel_Unset {w} { 916 variable ::tk::Priv 917 918 catch {after cancel $Priv(lbAccel,$w,afterId)} 919 unset -nocomplain Priv(lbAccel,$w) Priv(lbAccel,$w,afterId) 920 } 921 922 # ::tk::ListBoxKeyAccel_Key-- 923 # 924 # This procedure maintains a list of recently entered keystrokes 925 # over a listbox widget. It arranges an idle event to move the 926 # selection of the listbox to the entry that begins with the 927 # keystrokes. 928 # 929 # Arguments: 930 # w The pathname of the listbox. 931 # key The key which the user just pressed. 932 # 933 # Results: 934 # None. 935 936 proc ::tk::ListBoxKeyAccel_Key {w key} { 937 variable ::tk::Priv 938 939 if { $key eq "" } { 940 return 941 } 942 append Priv(lbAccel,$w) $key 943 ListBoxKeyAccel_Goto $w $Priv(lbAccel,$w) 944 catch { 945 after cancel $Priv(lbAccel,$w,afterId) 946 } 947 set Priv(lbAccel,$w,afterId) [after 500 \ 948 [list tk::ListBoxKeyAccel_Reset $w]] 949 } 950 951 proc ::tk::ListBoxKeyAccel_Goto {w string} { 952 variable ::tk::Priv 953 954 set string [string tolower $string] 955 set end [$w index end] 956 set theIndex -1 957 958 for {set i 0} {$i < $end} {incr i} { 959 set item [string tolower [$w get $i]] 960 if {[string compare $string $item] >= 0} { 961 set theIndex $i 962 } 963 if {[string compare $string $item] <= 0} { 964 set theIndex $i 965 break 966 } 967 } 968 969 if {$theIndex >= 0} { 970 $w selection clear 0 end 971 $w selection set $theIndex $theIndex 972 $w activate $theIndex 973 $w see $theIndex 974 event generate $w <<ListboxSelect>> 975 } 976 } 977 978 proc ::tk::ListBoxKeyAccel_Reset {w} { 979 variable ::tk::Priv 980 981 unset -nocomplain Priv(lbAccel,$w) 982 } 983 984 proc ::tk_getFileType {} { 985 variable ::tk::Priv 986 987 return $Priv(selectFileType) 988 } 989