1# filebox.tcl -- 2# 3# This demonstration script prompts the user to select a file. 4# 5# RCS: @(#) $Id: filebox.tcl,v 1.3.4.1 2004/09/10 20:48:41 dkf Exp $ 6 7if {![info exists widgetDemo]} { 8 error "This script should be run from the \"widget\" demo." 9} 10 11set w .filebox 12catch {destroy $w} 13toplevel $w 14wm title $w "File Selection Dialogs" 15wm iconname $w "filebox" 16positionWindow $w 17 18label $w.msg -font $font -wraplength 4i -justify left -text "Enter a file name in the entry box or click on the \"Browse\" buttons to select a file name using the file selection dialog." 19pack $w.msg -side top 20 21frame $w.buttons 22pack $w.buttons -side bottom -fill x -pady 2m 23button $w.buttons.dismiss -text Dismiss -command "destroy $w" 24button $w.buttons.code -text "See Code" -command "showCode $w" 25pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 26 27foreach i {open save} { 28 set f [frame $w.$i] 29 label $f.lab -text "Select a file to $i: " -anchor e 30 entry $f.ent -width 20 31 button $f.but -text "Browse ..." -command "fileDialog $w $f.ent $i" 32 pack $f.lab -side left 33 pack $f.ent -side left -expand yes -fill x 34 pack $f.but -side left 35 pack $f -fill x -padx 1c -pady 3 36} 37 38if {![string compare $tcl_platform(platform) unix]} { 39 checkbutton $w.strict -text "Use Motif Style Dialog" \ 40 -variable tk_strictMotif -onvalue 1 -offvalue 0 41 pack $w.strict -anchor c 42 43 # This binding ensures that we don't run the rest of the demos 44 # with motif style interactions 45 bind $w.strict <Destroy> {set tk_strictMotif 0} 46} 47 48proc fileDialog {w ent operation} { 49 # Type names Extension(s) Mac File Type(s) 50 # 51 #--------------------------------------------------------- 52 set types { 53 {"Text files" {.txt .doc} } 54 {"Text files" {} TEXT} 55 {"Tcl Scripts" {.tcl} TEXT} 56 {"C Source Files" {.c .h} } 57 {"All Source Files" {.tcl .c .h} } 58 {"Image Files" {.gif} } 59 {"Image Files" {.jpeg .jpg} } 60 {"Image Files" "" {GIFF JPEG}} 61 {"All files" *} 62 } 63 if {$operation == "open"} { 64 set file [tk_getOpenFile -filetypes $types -parent $w] 65 } else { 66 set file [tk_getSaveFile -filetypes $types -parent $w \ 67 -initialfile Untitled -defaultextension .txt] 68 } 69 if {[string compare $file ""]} { 70 $ent delete 0 end 71 $ent insert 0 $file 72 $ent xview end 73 } 74} 75