3 # Implements the "CK" standard file selection dialog box.
5 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
6 # Copyright (c) 1999-2000 Christian Werner
8 # See the file "license.terms" for information on usage and redistribution
9 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11 proc ck_getOpenFile args {
12 eval ckFDialog open $args
15 proc ck_getSaveFile args {
16 eval ckFDialog save $args
21 # Implements the file selection dialog.
23 proc ckFDialog {type args} {
27 ckFDialog_Config $w $type $args
28 if {![string compare $data(-parent) .]} {
31 set w $data(-parent).$w
33 # (re)create the dialog box if necessary
34 if {![winfo exists $w]} {
36 } elseif {[string compare [winfo class $w] CkFDialog]} {
40 set data(dirMenuBtn) $w.f1.menu
41 set data(dirMenu) $w.f1.menu.menu
42 set data(upBtn) $w.f1.up
43 set data(list) $w.list
44 set data(ent) $w.f2.ent
45 set data(typeMenuLab) $w.f3.lab
46 set data(typeMenuBtn) $w.f3.menu
47 set data(typeMenu) $data(typeMenuBtn).m
48 set data(okBtn) $w.f2.ok
49 set data(cancelBtn) $w.f3.cancel
51 # Initialize the file types menu
52 if {$data(-filetypes) != {}} {
53 $data(typeMenu) delete 0 end
54 foreach type $data(-filetypes) {
55 set title [lindex $type 0]
56 set filter [lindex $type 1]
57 $data(typeMenu) add command -label $title \
58 -command [list ckFDialog_SetFilter $w $type]
60 ckFDialog_SetFilter $w [lindex $data(-filetypes) 0]
61 $data(typeMenuBtn) config -state normal -takefocus 1
62 $data(typeMenuLab) config -state normal
65 $data(typeMenuBtn) config -state disabled -takefocus 0
66 $data(typeMenuLab) config -state disabled
68 ckFDialog_UpdateWhenIdle $w
70 place $w -relx 0.5 -rely 0.5 -anchor center
73 $data(ent) delete 0 end
74 $data(ent) insert 0 $data(selectFile)
75 $data(ent) select from 0
76 $data(ent) select to end
77 $data(ent) icursor end
78 tkwait variable ckPriv(selectFilePath)
79 catch {focus $oldFocus}
81 return $ckPriv(selectFilePath)
86 # Configures the filedialog according to the argument list
88 proc ckFDialog_Config {w type argList} {
91 # 1. the configuration specs
93 {-defaultextension "" "" ""}
95 {-initialdir "" "" ""}
96 {-initialfile "" "" ""}
100 # 2. default values depending on the type of the dialog
101 if {![info exists data(selectPath)]} {
102 # first time the dialog has been popped up
103 set data(selectPath) [pwd]
104 set data(selectFile) ""
106 # 3. parse the arguments
107 tclParseConfigSpec $w $specs "" $argList
108 if {![string compare $data(-title) ""]} {
109 if {![string compare $type "open"]} {
110 set data(-title) "Open"
112 set data(-title) "Save As"
115 # 4. set the default directory and selection according to the -initial
117 if {[string compare $data(-initialdir) ""]} {
118 if {[file isdirectory $data(-initialdir)]} {
119 set data(selectPath) [glob $data(-initialdir)]
121 set data(selectPath) [pwd]
123 # Convert the initialdir to an absolute path name.
126 set data(selectPath) [pwd]
129 set data(selectFile) $data(-initialfile)
130 # 5. Parse the -filetypes option
131 set data(-filetypes) [ckFDGetFileTypes $data(-filetypes)]
132 if {![winfo exists $data(-parent)]} {
133 error "bad window path name \"$data(-parent)\""
137 proc ckFDialog_Create {w} {
138 set dataName [lindex [split $w .] end]
139 upvar #0 $dataName data
140 toplevel $w -class CkFDialog -border {
141 ulcorner hline urcorner vline lrcorner hline llcorner vline
143 # f1: the frame with the directory option menu
144 set f1 [frame $w.f1 -class Dir]
145 label $f1.lab -text "Directory:" -underline 0
146 set data(dirMenuBtn) $f1.menu
147 set data(dirMenu) [ck_optionMenu $f1.menu [format %s(selectPath) $dataName] ""]
148 set data(upBtn) [button $f1.up -text Up -width 4 -underline 0]
149 pack $data(upBtn) -side right -padx 1 -fill both
150 pack $f1.lab -side left -padx 4 -fill both
151 pack $f1.menu -expand yes -fill both -padx 1
152 frame $w.sep0 -border hline -height 1
153 set data(list) [listbox $w.list -selectmode browse -height 8]
154 bindtags $data(list) [list Listbox $data(list) $w all]
155 bind $data(list) <Button-1> [list ckFDialog_ListBrowse $w]
156 bind $data(list) <KeyPress> [list ckFDialog_ListBrowse $w]
157 bind $data(list) <space> [list ckFDialog_ListBrowse $w]
158 bind $data(list) <Return> [list ckFDialog_ListInvoke $w]
159 bind $data(list) <Linefeed> [list ckFDialog_ListInvoke $w]
160 frame $w.sep1 -border hline -height 1
161 # f2: the frame with the OK button and the "file name" field
162 set f2 [frame $w.f2 -class Filename]
163 label $f2.lab -text "File name:" -anchor e -width 14 -underline 5
164 set data(ent) [entry $f2.ent]
165 # f3: the frame with the cancel button and the file types field
166 set f3 [frame $w.f3 -class Filetype]
167 # The "File of types:" label needs to be grayed-out when
168 # -filetypes are not specified. The label widget does not support
169 # grayed-out text on monochrome displays. Therefore, we have to
170 # use a button widget to emulate a label widget (by setting its
172 set data(typeMenuLab) [button $f3.lab -text "Files of type:" \
173 -anchor e -width 14 -underline 9 -takefocus 0]
174 bindtags $data(typeMenuLab) [list $data(typeMenuLab) Label \
175 [winfo toplevel $data(typeMenuLab)] all]
176 set data(typeMenuBtn) [menubutton $f3.menu -menu $f3.menu.m]
177 $f3.menu config -takefocus 1 \
178 -disabledbackground [$f3.menu cget -background] \
179 -disabledforeground [$f3.menu cget -foreground]
180 bind $f3.menu <FocusIn> {
181 if {[%W cget -state] != "disabled"} {
182 %W configure -state active
185 bind $f3.menu <FocusOut> {
186 if {[%W cget -state] != "disabled"} {
187 %W configure -state normal
190 set data(typeMenu) [menu $data(typeMenuBtn).m -border {
192 ulcorner hline urcorner vline lrcorner hline llcorner vline}]
193 $data(typeMenuBtn) config -takefocus 1 -anchor w
194 # the okBtn is created after the typeMenu so that the keyboard traversal
195 # is in the right order
196 set data(okBtn) [button $f2.ok -text OK -underline 0 -width 6]
197 set data(cancelBtn) [button $f3.cancel -text Cancel -underline 0 -width 6]
198 # pack the widgets in f2 and f3
199 pack $data(okBtn) -side right -padx 1 -anchor e
200 pack $f2.lab -side left -padx 1
201 pack $f2.ent -expand 1 -fill x
202 pack $data(cancelBtn) -side right -padx 1 -anchor w
203 pack $data(typeMenuLab) -side left -padx 1
204 pack $data(typeMenuBtn) -expand 1 -fill x -side right
205 # Pack all the frames together. We are done with widget construction.
206 pack $f1 -side top -fill x
207 pack $w.sep0 -side top -fill x
208 pack $f3 -side bottom -fill x
209 pack $f2 -side bottom -fill x
210 pack $w.sep1 -side bottom -fill x
211 pack $data(list) -expand 1 -fill both -padx 1
212 # Set up the event handlers
213 bind $data(ent) <Return> "ckFDialog_ActivateEnt $w"
214 bind $data(ent) <Linefeed> "ckFDialog_ActivateEnt $w"
215 $data(upBtn) config -command "ckFDialog_UpDirCmd $w"
216 $data(okBtn) config -command "ckFDialog_OkCmd $w"
217 $data(cancelBtn) config -command "ckFDialog_CancelCmd $w"
218 trace variable data(selectPath) w "ckFDialog_SetPath $w"
219 bind $w <Control-d> "focus $data(dirMenuBtn) ; break"
220 bind $w <Control-t> [format {
221 if {"[%s cget -state]" == "normal"} {
224 } $data(typeMenuBtn) $data(typeMenuBtn)]
225 bind $w <Control-n> "focus $data(ent) ; break"
226 bind $w <Escape> "ckButtonInvoke $data(cancelBtn)"
227 bind $w <Control-c> "ckButtonInvoke $data(cancelBtn) ; break"
228 bind $w <Control-o> "ckFDialog_InvokeBtn $w Open ; break"
229 bind $w <Control-s> "ckFDialog_InvokeBtn $w Save ; break"
230 bind $w <Control-u> "ckFDialog_UpDirCmd $w ; break"
233 # ckFDialog_UpdateWhenIdle --
235 # Creates an idle event handler which updates the dialog in idle
236 # time. This is important because loading the directory may take a long
237 # time and we don't want to load the same directory for multiple times
238 # due to multiple concurrent events.
240 proc ckFDialog_UpdateWhenIdle {w} {
241 upvar #0 [winfo name $w] data
242 if {[info exists data(updateId)]} {
245 set data(updateId) [after idle ckFDialog_Update $w]
249 # ckFDialog_Update --
251 # Loads the files and directories into listbox. Also
252 # sets up the directory option menu for quick access to parent
255 proc ckFDialog_Update {w} {
257 # This proc may be called within an idle handler. Make sure that the
258 # window has not been destroyed before this proc is called
259 if {![winfo exists $w] || [string compare [winfo class $w] CkFDialog]} {
262 set dataName [winfo name $w]
263 upvar #0 $dataName data
265 catch {unset data(updateId)}
270 # We cannot change directory to $data(selectPath). $data(selectPath)
271 # should have been checked before ckFDialog_Update is called, so
272 # we normally won't come to here. Anyways, give an error and abort
274 ck_messageBox -type ok -parent $data(-parent) -message \
275 "Cannot change to the directory \"$data(selectPath)\".\nPermission denied."
280 $data(list) delete 0 end
282 if {$tcl_version >= 8.0} {
283 set sortmode -dictionary
287 foreach f [lsort $sortmode [glob -nocomplain .* *]] {
288 if {![string compare $f .]} {
291 if {![string compare $f ..]} {
294 if {[file isdir ./$f]} {
295 if {![info exists hasDoneDir($f)]} {
296 $data(list) insert end [format "(dir) %s" $f]
303 if {![string compare $data(filter) *]} {
304 set files [lsort $sortmode \
305 [glob -nocomplain .* *]]
307 set files [lsort $sortmode \
308 [eval glob -nocomplain $data(filter)]]
313 if {![file isdir ./$f]} {
314 if {![info exists hasDoneFile($f)]} {
315 $data(list) insert end [format " %s" $f]
316 set hasDoneFile($f) 1
320 $data(list) selection clear 0 end
321 $data(list) selection set 0
322 $data(list) activate 0
324 # Update the Directory: option menu
327 foreach subdir [file split $data(selectPath)] {
328 set dir [file join $dir $subdir]
331 $data(dirMenu) delete 0 end
332 set var [format %s(selectPath) $dataName]
334 $data(dirMenu) add command -label $path -command [list set $var $path]
336 # Restore the PWD to the application's PWD
340 # ckFDialog_SetPathSilently --
342 # Sets data(selectPath) without invoking the trace procedure
344 proc ckFDialog_SetPathSilently {w path} {
345 upvar #0 [winfo name $w] data
346 trace vdelete data(selectPath) w "ckFDialog_SetPath $w"
347 set data(selectPath) $path
348 trace variable data(selectPath) w "ckFDialog_SetPath $w"
351 # This proc gets called whenever data(selectPath) is set
353 proc ckFDialog_SetPath {w name1 name2 op} {
354 if {[winfo exists $w]} {
355 upvar #0 [winfo name $w] data
356 ckFDialog_UpdateWhenIdle $w
360 # This proc gets called whenever data(filter) is set
362 proc ckFDialog_SetFilter {w type} {
363 upvar #0 [winfo name $w] data
364 set data(filter) [lindex $type 1]
365 $data(typeMenuBtn) config -text [lindex $type 0] -indicatoron 0
366 ckFDialog_UpdateWhenIdle $w
369 # ckFDialogResolveFile --
371 # Interpret the user's text input in a file selection dialog.
375 # (2) resolve all instances of . and ..
376 # (3) check for non-existent files/directories
377 # (4) check for chdir permissions
380 # context: the current directory you are in
381 # text: the text entered by the user
382 # defaultext: the default extension to add to files with no extension
385 # [list $flag $directory $file]
387 # flag = OK : valid input
388 # = PATTERN : valid directory/pattern
389 # = PATH : the directory does not exist
390 # = FILE : the directory exists by the file doesn't
392 # = CHDIR : Cannot change to the directory
393 # = ERROR : Invalid entry
395 # directory : valid only if flag = OK or PATTERN or FILE
396 # file : valid only if flag = OK or PATTERN
398 # directory may not be the same as context, because text may contain
399 # a subdirectory name
401 proc ckFDialogResolveFile {context text defaultext} {
403 set path [ckFDialog_JoinFile $context $text]
404 if {[file ext $path] == ""} {
405 set path "$path$defaultext"
407 if {[catch {file exists $path}]} {
408 # This "if" block can be safely removed if the following code
409 # stop generating errors.
411 # file exists ~nonsuchuser
413 return [list ERROR $path ""]
415 if {[file exists $path]} {
416 if {[file isdirectory $path]} {
420 return [list CHDIR $path ""]
428 cd [file dirname $path]
430 return [list CHDIR [file dirname $path] ""]
433 set file [file tail $path]
438 set dirname [file dirname $path]
439 if {[file exists $dirname]} {
443 return [list CHDIR $dirname ""]
446 set file [file tail $path]
447 if {[regexp {[*]|[?]} $file]} {
454 set directory $dirname
455 set file [file tail $path]
459 return [list $flag $directory $file]
462 # Gets called when the entry box gets keyboard focus. We clear the selection
463 # from the icon list . This way the user can be certain that the input in the
464 # entry box is the selection.
466 proc ckFDialog_EntFocusIn {w} {
467 upvar #0 [winfo name $w] data
468 if {[string compare [$data(ent) get] ""]} {
469 $data(ent) selection from 0
470 $data(ent) selection to end
471 $data(ent) icursor end
473 $data(ent) selection clear
475 $data(list) selection clear 0 end
476 if {![string compare $data(type) open]} {
477 $data(okBtn) config -text "Open"
479 $data(okBtn) config -text "Save"
483 proc ckFDialog_EntFocusOut {w} {
484 upvar #0 [winfo name $w] data
485 $data(ent) selection clear
488 # Gets called when user presses Return in the "File name" entry.
490 proc ckFDialog_ActivateEnt {w} {
491 upvar #0 [winfo name $w] data
492 set text [string trim [$data(ent) get]]
493 set list [ckFDialogResolveFile $data(selectPath) $text \
494 $data(-defaultextension)]
495 set flag [lindex $list 0]
496 set path [lindex $list 1]
497 set file [lindex $list 2]
500 if {![string compare $file ""]} {
501 # user has entered an existing (sub)directory
502 set data(selectPath) $path
503 $data(ent) delete 0 end
505 ckFDialog_SetPathSilently $w $path
506 set data(selectFile) $file
511 set data(selectPath) $path
512 set data(filter) $file
515 if {![string compare $data(type) open]} {
516 ck_messageBox -type ok -parent $data(-parent) \
517 -message "File \"[file join $path $file]\" does not exist."
518 $data(ent) select from 0
519 $data(ent) select to end
520 $data(ent) icursor end
522 ckFDialog_SetPathSilently $w $path
523 set data(selectFile) $file
528 ck_messageBox -type ok -parent $data(-parent) \
529 -message "Directory \"$path\" does not exist."
530 $data(ent) select from 0
531 $data(ent) select to end
532 $data(ent) icursor end
535 ck_messageBox -type ok -parent $data(-parent) -message \
536 "Cannot change to the directory \"$path\".\nPermission denied."
537 $data(ent) select from 0
538 $data(ent) select to end
539 $data(ent) icursor end
542 ck_messageBox -type ok -parent $data(-parent) -message \
543 "Invalid file name \"$path\"."
544 $data(ent) select from 0
545 $data(ent) select to end
546 $data(ent) icursor end
551 # Gets called when user presses the Alt-s or Alt-o keys.
553 proc ckFDialog_InvokeBtn {w key} {
554 upvar #0 [winfo name $w] data
555 if {![string compare [$data(okBtn) cget -text] $key]} {
556 ckButtonInvoke $data(okBtn)
560 # Gets called when user presses the "parent directory" button
562 proc ckFDialog_UpDirCmd {w} {
563 upvar #0 [winfo name $w] data
564 if {[string compare $data(selectPath) "/"]} {
565 set data(selectPath) [file dirname $data(selectPath)]
569 # Join a file name to a path name. The "file join" command will break
570 # if the filename begins with ~
572 proc ckFDialog_JoinFile {path file} {
573 if {[string match {~*} $file] && [file exists $path/$file]} {
574 return [file join $path ./$file]
576 return [file join $path $file]
580 # Gets called when user presses the "OK" button
582 proc ckFDialog_OkCmd {w} {
583 upvar #0 [winfo name $w] data
585 set index [$data(list) curselection]
586 if {"$index" != ""} {
587 set text [string range [$data(list) get $index] 6 end]
589 if {[string compare $text ""]} {
590 set file [ckFDialog_JoinFile $data(selectPath) $text]
591 if {[file isdirectory $file]} {
592 ckFDialog_ListInvoke $w $text
596 ckFDialog_ActivateEnt $w
599 # Gets called when user presses the "Cancel" button
601 proc ckFDialog_CancelCmd {w} {
602 upvar #0 [winfo name $w] data
604 set ckPriv(selectFilePath) ""
607 # Gets called when user browses the listbox.
609 proc ckFDialog_ListBrowse w {
610 upvar #0 [winfo name $w] data
611 set index [$data(list) curselection]
613 if {[string length $index]} {
614 set text [string range [$data(list) get $index] 6 end]
616 if {[string length $text] == 0} {
619 set file [ckFDialog_JoinFile $data(selectPath) $text]
620 if {![file isdirectory $file]} {
621 $data(ent) delete 0 end
622 $data(ent) insert 0 $text
623 if {![string compare $data(type) open]} {
624 $data(okBtn) config -text "Open"
626 $data(okBtn) config -text "Save"
629 $data(okBtn) config -text "Open"
633 # Gets called when user invokes the lisbox.
635 proc ckFDialog_ListInvoke {w {text {}}} {
636 upvar #0 [winfo name $w] data
637 if {[string length $text] == 0} {
638 set index [$data(list) curselection]
639 if {[string length $index]} {
640 set text [string range [$data(list) get $index] 6 end]
643 if {[string length $text] == 0} {
646 set file [ckFDialog_JoinFile $data(selectPath) $text]
647 if {[file isdirectory $file]} {
649 if {[catch {cd $file}]} {
650 ck_messageBox -type ok -parent $data(-parent) -message \
651 "Cannot change to the directory \"$file\".\nPermission denied."
654 set data(selectPath) $file
657 set data(selectFile) $file
664 # Gets called when user has input a valid filename. Pops up a
665 # dialog box to confirm selection when necessary. Sets the
666 # ckPriv(selectFilePath) variable, which will break the "tkwait"
667 # loop in ckFDialog and return the selected filename to the
668 # script that calls ck_getOpenFile or ck_getSaveFile
670 proc ckFDialog_Done {w {selectFilePath ""}} {
671 upvar #0 [winfo name $w] data
673 if {![string compare $selectFilePath ""]} {
674 set selectFilePath [ckFDialog_JoinFile $data(selectPath) \
676 set ckPriv(selectFile) $data(selectFile)
677 set ckPriv(selectPath) $data(selectPath)
678 if {[file exists $selectFilePath] &&
679 ![string compare $data(type) save]} {
680 set reply [ck_messageBox -icon warning -type yesno\
681 -parent $data(-parent) -message "File\
682 \"$selectFilePath\" already exists.\nDo\
683 you want to overwrite it?"]
684 if {![string compare $reply "no"]} {
689 set ckPriv(selectFilePath) $selectFilePath