source: proiecte/pmake3d/make3d_original/Make3dSingleImageStanford_version0.1/third_party/vrippack-0.31/lib/linux/tk8.4/choosedir.tcl @ 37

Last change on this file since 37 was 37, checked in by (none), 14 years ago

Added original make3d

File size: 8.8 KB
Line 
1# choosedir.tcl --
2#
3#       Choose directory dialog implementation for Unix/Mac.
4#
5# Copyright (c) 1998-2000 by Scriptics Corporation.
6# All rights reserved.
7#
8# RCS: @(#) $Id: choosedir.tcl,v 1.15 2002/07/22 21:25:39 mdejong Exp $
9
10# Make sure the tk::dialog namespace, in which all dialogs should live, exists
11namespace eval ::tk::dialog {}
12namespace eval ::tk::dialog::file {}
13
14# Make the chooseDir namespace inside the dialog namespace
15namespace eval ::tk::dialog::file::chooseDir {
16    namespace import ::tk::msgcat::*
17}
18
19# ::tk::dialog::file::chooseDir:: --
20#
21#       Implements the TK directory selection dialog.
22#
23# Arguments:
24#       args            Options parsed by the procedure.
25#
26proc ::tk::dialog::file::chooseDir:: {args} {
27    variable ::tk::Priv
28    set dataName __tk_choosedir
29    upvar ::tk::dialog::file::$dataName data
30    ::tk::dialog::file::chooseDir::Config $dataName $args
31
32    if {[string equal $data(-parent) .]} {
33        set w .$dataName
34    } else {
35        set w $data(-parent).$dataName
36    }
37
38    # (re)create the dialog box if necessary
39    #
40    if {![winfo exists $w]} {
41        ::tk::dialog::file::Create $w TkChooseDir
42    } elseif {[string compare [winfo class $w] TkChooseDir]} {
43        destroy $w
44        ::tk::dialog::file::Create $w TkChooseDir
45    } else {
46        set data(dirMenuBtn) $w.f1.menu
47        set data(dirMenu) $w.f1.menu.menu
48        set data(upBtn) $w.f1.up
49        set data(icons) $w.icons
50        set data(ent) $w.f2.ent
51        set data(okBtn) $w.f2.ok
52        set data(cancelBtn) $w.f3.cancel
53    }
54
55    # Dialog boxes should be transient with respect to their parent,
56    # so that they will always stay on top of their parent window.  However,
57    # some window managers will create the window as withdrawn if the parent
58    # window is withdrawn or iconified.  Combined with the grab we put on the
59    # window, this can hang the entire application.  Therefore we only make
60    # the dialog transient if the parent is viewable.
61
62    if {[winfo viewable [winfo toplevel $data(-parent)]] } {
63        wm transient $w $data(-parent)
64    }
65
66    trace variable data(selectPath) w [list ::tk::dialog::file::SetPath $w]
67    $data(dirMenuBtn) configure \
68            -textvariable ::tk::dialog::file::${dataName}(selectPath)
69
70    set data(filter) "*"
71    set data(previousEntryText) ""
72    ::tk::dialog::file::UpdateWhenIdle $w
73
74    # Withdraw the window, then update all the geometry information
75    # so we know how big it wants to be, then center the window in the
76    # display and de-iconify it.
77
78    ::tk::PlaceWindow $w widget $data(-parent)
79    wm title $w $data(-title)
80
81    # Set a grab and claim the focus too.
82
83    ::tk::SetFocusGrab $w $data(ent)
84    $data(ent) delete 0 end
85    $data(ent) insert 0 $data(selectPath)
86    $data(ent) selection range 0 end
87    $data(ent) icursor end
88
89    # Wait for the user to respond, then restore the focus and
90    # return the index of the selected button.  Restore the focus
91    # before deleting the window, since otherwise the window manager
92    # may take the focus away so we can't redirect it.  Finally,
93    # restore any grab that was in effect.
94
95    vwait ::tk::Priv(selectFilePath)
96
97    ::tk::RestoreFocusGrab $w $data(ent) withdraw
98
99    # Cleanup traces on selectPath variable
100    #
101
102    foreach trace [trace vinfo data(selectPath)] {
103        trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]
104    }
105    $data(dirMenuBtn) configure -textvariable {}
106
107    # Return value to user
108    #
109   
110    return $Priv(selectFilePath)
111}
112
113# ::tk::dialog::file::chooseDir::Config --
114#
115#       Configures the Tk choosedir dialog according to the argument list
116#
117proc ::tk::dialog::file::chooseDir::Config {dataName argList} {
118    upvar ::tk::dialog::file::$dataName data
119
120    # 0: Delete all variable that were set on data(selectPath) the
121    # last time the file dialog is used. The traces may cause troubles
122    # if the dialog is now used with a different -parent option.
123    #
124    foreach trace [trace vinfo data(selectPath)] {
125        trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]
126    }
127
128    # 1: the configuration specs
129    #
130    set specs {
131        {-mustexist "" "" 0}
132        {-initialdir "" "" ""}
133        {-parent "" "" "."}
134        {-title "" "" ""}
135    }
136
137    # 2: default values depending on the type of the dialog
138    #
139    if {![info exists data(selectPath)]} {
140        # first time the dialog has been popped up
141        set data(selectPath) [pwd]
142    }
143
144    # 3: parse the arguments
145    #
146    tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
147
148    if {$data(-title) == ""} {
149        set data(-title) "[mc "Choose Directory"]"
150    }
151   
152    # Stub out the -multiple value for the dialog; it doesn't make sense for
153    # choose directory dialogs, but we have to have something there because we
154    # share so much code with the file dialogs.
155    set data(-multiple) 0
156
157    # 4: set the default directory and selection according to the -initial
158    #    settings
159    #
160    if {$data(-initialdir) != ""} {
161        # Ensure that initialdir is an absolute path name.
162        if {[file isdirectory $data(-initialdir)]} {
163            set old [pwd]
164            cd $data(-initialdir)
165            set data(selectPath) [pwd]
166            cd $old
167        } else {
168            set data(selectPath) [pwd]
169        }
170    }
171
172    if {![winfo exists $data(-parent)]} {
173        error "bad window path name \"$data(-parent)\""
174    }
175}
176
177# Gets called when user presses Return in the "Selection" entry or presses OK.
178#
179proc ::tk::dialog::file::chooseDir::OkCmd {w} {
180    upvar ::tk::dialog::file::[winfo name $w] data
181
182    # This is the brains behind selecting non-existant directories.  Here's
183    # the flowchart:
184    # 1.  If the icon list has a selection, join it with the current dir,
185    #     and return that value.
186    # 1a.  If the icon list does not have a selection ...
187    # 2.  If the entry is empty, do nothing.
188    # 3.  If the entry contains an invalid directory, then...
189    # 3a.   If the value is the same as last time through here, end dialog.
190    # 3b.   If the value is different than last time, save it and return.
191    # 4.  If entry contains a valid directory, then...
192    # 4a.   If the value is the same as the current directory, end dialog.
193    # 4b.   If the value is different from the current directory, change to
194    #       that directory.
195
196    set selection [tk::IconList_Curselection $data(icons)]
197    if { [llength $selection] != 0 } {
198        set iconText [tk::IconList_Get $data(icons) [lindex $selection 0]]
199        set iconText [file join $data(selectPath) $iconText]
200        ::tk::dialog::file::chooseDir::Done $w $iconText
201    } else {
202        set text [$data(ent) get]
203        if { [string equal $text ""] } {
204            return
205        }
206        set text [eval file join [file split [string trim $text]]]
207        if { ![file exists $text] || ![file isdirectory $text] } {
208            # Entry contains an invalid directory.  If it's the same as the
209            # last time they came through here, reset the saved value and end
210            # the dialog.  Otherwise, save the value (so we can do this test
211            # next time).
212            if { [string equal $text $data(previousEntryText)] } {
213                set data(previousEntryText) ""
214                ::tk::dialog::file::chooseDir::Done $w $text
215            } else {
216                set data(previousEntryText) $text
217            }
218        } else {
219            # Entry contains a valid directory.  If it is the same as the
220            # current directory, end the dialog.  Otherwise, change to that
221            # directory.
222            if { [string equal $text $data(selectPath)] } {
223                ::tk::dialog::file::chooseDir::Done $w $text
224            } else {
225                set data(selectPath) $text
226            }
227        }
228    }
229    return
230}
231
232proc ::tk::dialog::file::chooseDir::DblClick {w} {
233    upvar ::tk::dialog::file::[winfo name $w] data
234    set selection [tk::IconList_Curselection $data(icons)]
235    if { [llength $selection] != 0 } {
236        set filenameFragment \
237                [tk::IconList_Get $data(icons) [lindex $selection 0]]
238        set file $data(selectPath)
239        if {[file isdirectory $file]} {
240            ::tk::dialog::file::ListInvoke $w [list $filenameFragment]
241            return
242        }
243    }
244}   
245
246# Gets called when user browses the IconList widget (dragging mouse, arrow
247# keys, etc)
248#
249proc ::tk::dialog::file::chooseDir::ListBrowse {w text} {
250    upvar ::tk::dialog::file::[winfo name $w] data
251
252    if {[string equal $text ""]} {
253        return
254    }
255
256    set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
257    $data(ent) delete 0 end
258    $data(ent) insert 0 $file
259}
260
261# ::tk::dialog::file::chooseDir::Done --
262#
263#       Gets called when user has input a valid filename.  Pops up a
264#       dialog box to confirm selection when necessary. Sets the
265#       Priv(selectFilePath) variable, which will break the "vwait"
266#       loop in tk_chooseDirectory and return the selected filename to the
267#       script that calls tk_getOpenFile or tk_getSaveFile
268#
269proc ::tk::dialog::file::chooseDir::Done {w {selectFilePath ""}} {
270    upvar ::tk::dialog::file::[winfo name $w] data
271    variable ::tk::Priv
272
273    if {[string equal $selectFilePath ""]} {
274        set selectFilePath $data(selectPath)
275    }
276    if { $data(-mustexist) } {
277        if { ![file exists $selectFilePath] || \
278                ![file isdir $selectFilePath] } {
279            return
280        }
281    }
282    set Priv(selectFilePath) $selectFilePath
283}
Note: See TracBrowser for help on using the repository browser.