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.
7
# RCS: @(#) $Id: xmfbox.tcl,v 1.6 1998/11/12 06:22:05 welch Exp $
9
# Copyright (c) 1996 Sun Microsystems, Inc.
11
# See the file "license.terms" for information on usage and redistribution
12
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
18
# Implements a file dialog similar to the standard Motif file
23
# A list of two members. The first member is the absolute
24
# pathname of the selected file or "" if user hits cancel. The
25
# second member is the name of the selected file type, or ""
26
# which stands for "default file type"
28
proc tkMotifFDialog {args} {
33
if {![string compare [lindex [info level 0] 0] tk_getOpenFile]} {
39
tkMotifFDialog_Config $w $type $args
41
if {![string compare $data(-parent) .]} {
44
set w $data(-parent).$w
47
# (re)create the dialog box if necessary
49
if {![winfo exists $w]} {
50
tkMotifFDialog_Create $w
51
} elseif {[string compare [winfo class $w] TkMotifFDialog]} {
53
tkMotifFDialog_Create $w
55
set data(fEnt) $w.top.f1.ent
56
set data(dList) $w.top.f2.a.l
57
set data(fList) $w.top.f2.b.l
58
set data(sEnt) $w.top.f3.ent
59
set data(okBtn) $w.bot.ok
60
set data(filterBtn) $w.bot.filter
61
set data(cancelBtn) $w.bot.cancel
63
wm transient $w $data(-parent)
65
tkMotifFDialog_Update $w
67
# 5. Withdraw the window, then update all the geometry information
68
# so we know how big it wants to be, then center the window in the
69
# display and de-iconify it.
73
set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
74
- [winfo vrootx [winfo parent $w]]}]
75
set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
76
- [winfo vrooty [winfo parent $w]]}]
79
wm title $w $data(-title)
81
# 6. Set a grab and claim the focus too.
84
set oldGrab [grab current $w]
86
set grabStatus [grab status $oldGrab]
90
$data(sEnt) select from 0
91
$data(sEnt) select to end
93
# 7. Wait for the user to respond, then restore the focus and
94
# return the index of the selected button. Restore the focus
95
# before deleting the window, since otherwise the window manager
96
# may take the focus away so we can't redirect it. Finally,
97
# restore any grab that was in effect.
99
tkwait variable tkPriv(selectFilePath)
100
catch {focus $oldFocus}
103
if {$oldGrab != ""} {
104
if {$grabStatus == "global"} {
105
grab -global $oldGrab
110
return $tkPriv(selectFilePath)
113
proc tkMotifFDialog_Config {w type argList} {
118
# 1: the configuration specs
121
{-defaultextension "" "" ""}
122
{-filetypes "" "" ""}
123
{-initialdir "" "" ""}
124
{-initialfile "" "" ""}
129
# 2: default values depending on the type of the dialog
131
if {![info exists data(selectPath)]} {
132
# first time the dialog has been popped up
133
set data(selectPath) [pwd]
134
set data(selectFile) ""
137
# 3: parse the arguments
139
tclParseConfigSpec $w $specs "" $argList
141
if {![string compare $data(-title) ""]} {
142
if {![string compare $type "open"]} {
143
set data(-title) "Open"
145
set data(-title) "Save As"
149
# 4: set the default directory and selection according to the -initial
152
if {[string compare $data(-initialdir) ""]} {
153
if {[file isdirectory $data(-initialdir)]} {
154
set data(selectPath) [glob $data(-initialdir)]
156
set data(selectPath) [pwd]
159
# Convert the initialdir to an absolute path name.
163
set data(selectPath) [pwd]
166
set data(selectFile) $data(-initialfile)
168
# 5. Parse the -filetypes option. It is not used by the motif
169
# file dialog, but we check for validity of the value to make sure
170
# the application code also runs fine with the TK file dialog.
172
set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]
174
if {![info exists data(filter)]} {
177
if {![winfo exists $data(-parent)]} {
178
error "bad window path name \"$data(-parent)\""
182
proc tkMotifFDialog_Create {w} {
183
set dataName [lindex [split $w .] end]
184
upvar #0 $dataName data
186
# 1: Create the dialog ...
188
toplevel $w -class TkMotifFDialog
189
set top [frame $w.top -relief raised -bd 1]
190
set bot [frame $w.bot -relief raised -bd 1]
192
pack $w.bot -side bottom -fill x
193
pack $w.top -side top -expand yes -fill both
195
set f1 [frame $top.f1]
196
set f2 [frame $top.f2]
197
set f3 [frame $top.f3]
199
pack $f1 -side top -fill x
200
pack $f3 -side bottom -fill x
201
pack $f2 -expand yes -fill both
203
set f2a [frame $f2.a]
204
set f2b [frame $f2.b]
206
grid $f2a -row 0 -column 0 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
208
grid $f2b -row 0 -column 1 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
210
grid rowconfig $f2 0 -minsize 0 -weight 1
211
grid columnconfig $f2 0 -minsize 0 -weight 1
212
grid columnconfig $f2 1 -minsize 150 -weight 2
216
label $f1.lab -text "Filter:" -under 3 -anchor w
218
pack $f1.lab -side top -fill x -padx 6 -pady 4
219
pack $f1.ent -side top -fill x -padx 4 -pady 0
220
set data(fEnt) $f1.ent
222
# The file and directory lists
224
set data(dList) [tkMotifFDialog_MakeSList $w $f2a Directory: 0 DList]
225
set data(fList) [tkMotifFDialog_MakeSList $w $f2b Files: 2 FList]
229
label $f3.lab -text "Selection:" -under 0 -anchor w
231
pack $f3.lab -side top -fill x -padx 6 -pady 0
232
pack $f3.ent -side top -fill x -padx 4 -pady 4
233
set data(sEnt) $f3.ent
237
set data(okBtn) [button $bot.ok -text OK -width 6 -under 0 \
238
-command "tkMotifFDialog_OkCmd $w"]
239
set data(filterBtn) [button $bot.filter -text Filter -width 6 -under 0 \
240
-command "tkMotifFDialog_FilterCmd $w"]
241
set data(cancelBtn) [button $bot.cancel -text Cancel -width 6 -under 0 \
242
-command "tkMotifFDialog_CancelCmd $w"]
244
pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \
247
# Create the bindings:
249
bind $w <Alt-t> "focus $data(fEnt)"
250
bind $w <Alt-d> "focus $data(dList)"
251
bind $w <Alt-l> "focus $data(fList)"
252
bind $w <Alt-s> "focus $data(sEnt)"
254
bind $w <Alt-o> "tkButtonInvoke $bot.ok "
255
bind $w <Alt-f> "tkButtonInvoke $bot.filter"
256
bind $w <Alt-c> "tkButtonInvoke $bot.cancel"
258
bind $data(fEnt) <Return> "tkMotifFDialog_ActivateFEnt $w"
259
bind $data(sEnt) <Return> "tkMotifFDialog_ActivateSEnt $w"
261
wm protocol $w WM_DELETE_WINDOW "tkMotifFDialog_CancelCmd $w"
264
proc tkMotifFDialog_MakeSList {w f label under cmd} {
265
label $f.lab -text $label -under $under -anchor w
266
listbox $f.l -width 12 -height 5 -selectmode browse -exportselection 0\
267
-xscrollcommand "$f.h set" \
268
-yscrollcommand "$f.v set"
269
scrollbar $f.v -orient vertical -takefocus 0 \
270
-command "$f.l yview"
271
scrollbar $f.h -orient horizontal -takefocus 0 \
272
-command "$f.l xview"
273
grid $f.lab -row 0 -column 0 -sticky news -rowspan 1 -columnspan 2 \
275
grid $f.l -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
276
grid $f.v -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky news
277
grid $f.h -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky news
279
grid rowconfig $f 0 -weight 0 -minsize 0
280
grid rowconfig $f 1 -weight 1 -minsize 0
281
grid columnconfig $f 0 -weight 1 -minsize 0
283
# bindings for the listboxes
286
bind $list <Up> "tkMotifFDialog_Browse$cmd $w"
287
bind $list <Down> "tkMotifFDialog_Browse$cmd $w"
288
bind $list <space> "tkMotifFDialog_Browse$cmd $w"
289
bind $list <1> "tkMotifFDialog_Browse$cmd $w"
290
bind $list <B1-Motion> "tkMotifFDialog_Browse$cmd $w"
291
bind $list <Double-1> "tkMotifFDialog_Activate$cmd $w"
292
bind $list <Return> "tkMotifFDialog_Browse$cmd $w; tkMotifFDialog_Activate$cmd $w"
294
bindtags $list "Listbox $list [winfo toplevel $list] all"
295
tkListBoxKeyAccel_Set $list
300
proc tkMotifFDialog_BrowseDList {w} {
301
upvar #0 [winfo name $w] data
304
if {![string compare [$data(dList) curselection] ""]} {
307
set subdir [$data(dList) get [$data(dList) curselection]]
308
if {![string compare $subdir ""]} {
312
$data(fList) selection clear 0 end
314
set list [tkMotifFDialog_InterpFilter $w]
315
set data(filter) [lindex $list 1]
319
set newSpec [file join $data(selectPath) $data(filter)]
322
set newSpec [file join [file dirname $data(selectPath)] \
326
set newSpec [file join $data(selectPath) $subdir $data(filter)]
330
$data(fEnt) delete 0 end
331
$data(fEnt) insert 0 $newSpec
334
proc tkMotifFDialog_ActivateDList {w} {
335
upvar #0 [winfo name $w] data
337
if {![string compare [$data(dList) curselection] ""]} {
340
set subdir [$data(dList) get [$data(dList) curselection]]
341
if {![string compare $subdir ""]} {
345
$data(fList) selection clear 0 end
349
set newDir $data(selectPath)
352
set newDir [file dirname $data(selectPath)]
355
set newDir [file join $data(selectPath) $subdir]
359
set data(selectPath) $newDir
360
tkMotifFDialog_Update $w
362
if {[string compare $subdir ..]} {
363
$data(dList) selection set 0
364
$data(dList) activate 0
366
$data(dList) selection set 1
367
$data(dList) activate 1
371
proc tkMotifFDialog_BrowseFList {w} {
372
upvar #0 [winfo name $w] data
375
if {![string compare [$data(fList) curselection] ""]} {
378
set data(selectFile) [$data(fList) get [$data(fList) curselection]]
379
if {![string compare $data(selectFile) ""]} {
383
$data(dList) selection clear 0 end
385
$data(fEnt) delete 0 end
386
$data(fEnt) insert 0 [file join $data(selectPath) $data(filter)]
387
$data(fEnt) xview end
389
$data(sEnt) delete 0 end
390
$data(sEnt) insert 0 [file join $data(selectPath) $data(selectFile)]
391
$data(sEnt) xview end
394
proc tkMotifFDialog_ActivateFList {w} {
395
upvar #0 [winfo name $w] data
397
if {![string compare [$data(fList) curselection] ""]} {
400
set data(selectFile) [$data(fList) get [$data(fList) curselection]]
401
if {![string compare $data(selectFile) ""]} {
404
tkMotifFDialog_ActivateSEnt $w
408
proc tkMotifFDialog_ActivateFEnt {w} {
409
upvar #0 [winfo name $w] data
411
set list [tkMotifFDialog_InterpFilter $w]
412
set data(selectPath) [lindex $list 0]
413
set data(filter) [lindex $list 1]
415
tkMotifFDialog_Update $w
418
proc tkMotifFDialog_InterpFilter {w} {
419
upvar #0 [winfo name $w] data
421
set text [string trim [$data(fEnt) get]]
422
# Perform tilde substitution
424
if {![string compare [string index $text 0] ~]} {
425
set list [file split $text]
426
set tilde [lindex $list 0]
428
set tilde [glob $tilde]
430
set text [eval file join [concat $tilde [lrange $list 1 end]]]
433
set resolved [file join [file dirname $text] [file tail $text]]
435
if {[file isdirectory $resolved]} {
437
set fil $data(filter)
439
set dir [file dirname $resolved]
440
set fil [file tail $resolved]
443
return [list $dir $fil]
447
proc tkMotifFDialog_ActivateSEnt {w} {
449
upvar #0 [winfo name $w] data
451
set selectFilePath [string trim [$data(sEnt) get]]
452
set selectFile [file tail $selectFilePath]
453
set selectPath [file dirname $selectFilePath]
456
if {![string compare $selectFilePath ""]} {
457
tkMotifFDialog_FilterCmd $w
461
if {[file isdirectory $selectFilePath]} {
462
set data(selectPath) [glob $selectFilePath]
463
set data(selectFile) ""
464
tkMotifFDialog_Update $w
468
if {[string compare [file pathtype $selectFilePath] "absolute"]} {
469
tk_messageBox -icon warning -type ok \
470
-message "\"$selectFilePath\" must be an absolute pathname"
474
if {![file exists $selectPath]} {
475
tk_messageBox -icon warning -type ok \
476
-message "Directory \"$selectPath\" does not exist."
480
if {![file exists $selectFilePath]} {
481
if {![string compare $data(type) open]} {
482
tk_messageBox -icon warning -type ok \
483
-message "File \"$selectFilePath\" does not exist."
487
if {![string compare $data(type) save]} {
488
set message [format %s%s \
489
"File \"$selectFilePath\" already exists.\n\n" \
490
"Replace existing file?"]
491
set answer [tk_messageBox -icon warning -type yesno \
493
if {![string compare $answer "no"]} {
499
set tkPriv(selectFilePath) $selectFilePath
500
set tkPriv(selectFile) $selectFile
501
set tkPriv(selectPath) $selectPath
505
proc tkMotifFDialog_OkCmd {w} {
506
upvar #0 [winfo name $w] data
508
tkMotifFDialog_ActivateSEnt $w
511
proc tkMotifFDialog_FilterCmd {w} {
512
upvar #0 [winfo name $w] data
514
tkMotifFDialog_ActivateFEnt $w
517
proc tkMotifFDialog_CancelCmd {w} {
520
set tkPriv(selectFilePath) ""
521
set tkPriv(selectFile) ""
522
set tkPriv(selectPath) ""
525
# tkMotifFDialog_Update
527
# Load the files and synchronize the "filter" and "selection" fields
531
# If this is true, then update the selection field according to the
534
proc tkMotifFDialog_Update {w} {
535
upvar #0 [winfo name $w] data
537
$data(fEnt) delete 0 end
538
$data(fEnt) insert 0 [file join $data(selectPath) $data(filter)]
539
$data(sEnt) delete 0 end
540
$data(sEnt) insert 0 [file join $data(selectPath) $data(selectFile)]
542
tkMotifFDialog_LoadFiles $w
545
proc tkMotifFDialog_LoadFiles {w} {
546
upvar #0 [winfo name $w] data
548
$data(dList) delete 0 end
549
$data(fList) delete 0 end
557
$data(dList) insert end ".."
563
foreach f [lsort -command tclSortNoCase [glob -nocomplain .* *]] {
564
if {[file isdirectory $f]} {
565
$data(dList) insert end $f
570
if {![string compare $data(filter) *]} {
571
set files [lsort -command tclSortNoCase [glob -nocomplain .* *]]
573
set files [lsort -command tclSortNoCase \
574
[glob -nocomplain $data(filter)]]
579
if {![file isdir $f]} {
580
$data(fList) insert end $f
581
if {[string match .* $f]} {
587
# The user probably doesn't want to see the . files. We adjust the view
588
# so that the listbox displays all the non-dot files
589
$data(fList) yview $top
594
proc tkListBoxKeyAccel_Set {w} {
595
bind Listbox <Any-KeyPress> ""
596
bind $w <Destroy> "tkListBoxKeyAccel_Unset $w"
597
bind $w <Any-KeyPress> "tkListBoxKeyAccel_Key $w %A"
600
proc tkListBoxKeyAccel_Unset {w} {
603
catch {after cancel $tkPriv(lbAccel,$w,afterId)}
604
catch {unset tkPriv(lbAccel,$w)}
605
catch {unset tkPriv(lbAccel,$w,afterId)}
608
proc tkListBoxKeyAccel_Key {w key} {
611
append tkPriv(lbAccel,$w) $key
612
tkListBoxKeyAccel_Goto $w $tkPriv(lbAccel,$w)
614
after cancel $tkPriv(lbAccel,$w,afterId)
616
set tkPriv(lbAccel,$w,afterId) [after 500 tkListBoxKeyAccel_Reset $w]
619
proc tkListBoxKeyAccel_Goto {w string} {
622
set string [string tolower $string]
623
set end [$w index end]
626
for {set i 0} {$i < $end} {incr i} {
627
set item [string tolower [$w get $i]]
628
if {[string compare $string $item] >= 0} {
631
if {[string compare $string $item] <= 0} {
637
if {$theIndex >= 0} {
638
$w selection clear 0 end
639
$w selection set $theIndex $theIndex
640
$w activate $theIndex
645
proc tkListBoxKeyAccel_Reset {w} {
648
catch {unset tkPriv(lbAccel,$w)}
added
removed
library/xmfbox.tcl
