1###############################################################################
2###############################################################################
3#####                            Dialogos.tcl
4###############################################################################
5###############################################################################
6##### The contents of this file are adapted from an example in Brent Welch's
7##### book "Practical Programming in Tcl/Tk". I made the changes without
8##### knowing very well what I was doing, so please, don't blame him for all
9##### the weirdness.
10###############################################################################
11##### Copyright 1999-2008 Brent Welch - Andres Garcia.  fandom@telefonica.net
12##### The contents of this file are distributed under the terms of the LGPL
13###############################################################################
14
15namespace eval Dialogos {
16
17set ext $::getleftState(imgExt)
18
19set imaArr [image create photo \
20        -file [file join "$dirGetleft(icons)" arriba.$ext]]
21set imaNew [image create photo \
22        -file [file join "$dirGetleft(icons)" nuevo.$ext]]
23
24###############################################################################
25# SelectDirNative
26#     Does the work by using a Windows or Mac dialog
27#
28# Parameters:
29#     initialDir: The directory in which the dialog will open itself.
30#     parent: The window over which it will appear.
31#
32# Returns:
33#     The chosen path or an empty string if the user cancels.
34#
35# Side effects:
36#     If you select a non-existing directory, it will be created for you.
37###############################################################################
38proc SelectDirNative {initialDir parent} {
39    global labelTitles labelMessages indexButtons
40
41    set chosenDir [tk_chooseDirectory -title $labelTitles(directory)            \
42            -parent $parent -initialdir $initialDir]
43
44    if {$chosenDir==""} return
45
46    if {![file exist $chosenDir]} {
47        set what [Dialogos::Dialogo $parent.question -icon question -type yesno \
48                -message $labelMessages(unknown) -title $labelTitles(unknown)]
49        if {$what=="no"} {
50            set initialDir $chosenDir
51            while {![file exists $initialDir]} {
52                set initialDir [file dirname $initialDir]
53            }
54            return [SelectDirWindows $initialDir $parent]
55        }
56        file mkdir $chosenDir
57    }
58    return $chosenDir
59}
60
61###############################################################################
62# SelectDirectory
63#    Opens a dialog window which allows the user to choose one directory. If
64#    needed, the directory is created.
65#
66# Parameter:
67#    initialDir: directory where the dialog should open itself.
68#    parent: the parent window of the dialog, it defaults to the main
69#    window of the app.
70#
71# Returns
72#    The full path of the chosen directory.
73###############################################################################
74proc SelectDirectory {{initialDir {} } {parent {.} } } {
75    variable fileselect
76    global tcl_patchLevel getleftState
77    global dirGetleft getleftOptions labelMenus indexButtons
78    global env labelButtons labelTitles labelDialogs labelMessages
79
80    if {$getleftState(os)!="unix"} {
81        return [SelectDirNative $initialDir $parent]
82    }
83
84    catch {destroy .fileselect}
85    set win [toplevel .fileselect]
86
87    set coord(x) [winfo rootx $parent]
88    set coord(y) [winfo rooty $parent]
89
90    wm title $win $labelTitles(directory)
91    wm resizable $win 0 0
92    wm geometry $win +[expr {$coord(x)+100}]+[expr {$coord(y)+15}]
93
94    set extFrame [ttk::frame $win.t]
95
96    set topFrame           [ttk::frame $extFrame.top]
97    set labelCurrent       [ttk::label $topFrame.labelCurrent                  \
98            -text "$labelDialogs(current): "]
99    set fileselect(dirEnt) [ttk::label $topFrame.entry -relief sunken -width 35\
100            -anchor w]
101
102    set upDir  [ttk::button $topFrame.up  -image $::Dialogos::imaArr -command {
103        Dialogos::fileselectList [file dirname $Dialogos::fileselect(dir)]
104        Dialogos::fileselectOK
105    } -style Toolbutton]
106    set newDir [ttk::button $topFrame.new -image $::Dialogos::imaNew -command {
107        ::Dialogos::NewDir
108    } -style Toolbutton]
109
110    BalloonHelp::set_balloon $upDir  $labelMessages(up)
111    BalloonHelp::set_balloon $newDir $labelMessages(newDir)
112
113    set centFrame [ttk::frame $extFrame.central]
114    set fileselect(dirList) [listbox $centFrame.list                         \
115            -yscrollcommand [list $centFrame.scroll set]                     \
116            -bg $getleftOptions(bg) -fg $getleftOptions(fg) -height 10
117    ]
118
119    set lbFont [$fileselect(dirList) cget -font]
120    regsub {bold} $lbFont {} lbFont
121    $fileselect(dirList) configure -font $lbFont
122
123    set fileselect(scroll) [ttk::scrollbar $centFrame.scroll -command [
124            list $fileselect(dirList) yview
125    ]]
126
127    set botFrame [ttk::frame $extFrame.bottonFrame]
128    set labelDir [ttk::label $botFrame.labelDir -text "$labelDialogs(dir): "]
129    set fileselect(pathEnt) [ttk::entry $botFrame.dirEntry                   \
130           -width 27 -textvariable Dialogos::fileselect(path)]
131    menuEntry::menuEntry $fileselect(pathEnt)
132
133    # Set up bindings to invoke OK and Cancel
134    bind $fileselect(pathEnt) <Return> {
135        if {[Dialogos::fileselectOK]==1} {
136            set Dialogos::fileselect(done) 1
137        }
138    }
139    bind $fileselect(pathEnt) <Control-c> Dialogos::fileselectCancel
140    focus $fileselect(pathEnt)
141
142    set accept [ttk::button $botFrame.ok -width 10                             \
143            -textvariable labelButtons(select) -underline $indexButtons(select)\
144            -command {
145                if {[Dialogos::fileselectOK]==1} {
146                    set Dialogos::fileselect(done) 1
147                }
148            }
149    ]
150
151    set cancel [ttk::button $botFrame.cancel -width 10                         \
152            -textvariable labelButtons(cancel) -underline $indexButtons(cancel)\
153            -command {set Dialogos::fileselect(done) 0}
154    ]
155
156    wm protocol $win WM_DELETE_WINDOW "$cancel invoke"
157
158    if {$::tcl_version>=8.5} {
159        grid anchor $extFrame c
160    }
161
162    pack $extFrame -fill x -fill y -expand true -ipadx 4 -ipady 4
163
164    grid $topFrame -sticky ew
165    grid $labelCurrent  $fileselect(dirEnt) -sticky e
166    grid $upDir  -row 0 -column 2 -padx 5
167    grid $newDir -row 0 -column 3
168
169    grid $centFrame -sticky ew -pady 5
170    grid $fileselect(dirList) -sticky news -row 0 -column 0 -pady 2
171    grid $fileselect(scroll)  -sticky nsw  -row 0 -column 1 -pady 2
172    grid columnconfigure $centFrame 0 -weight 1
173
174    grid $botFrame -sticky ew
175    grid $labelDir            -sticky w  -row 0 -column 0
176    grid $fileselect(pathEnt) -sticky ew -row 0 -column 1 -padx 4
177    grid $accept              -sticky e  -row 0 -column 2
178    grid $cancel              -sticky e  -row 1 -column 2
179    grid columnconfigure $botFrame 1 -weight 1
180
181    # A single click to listbox so the user can use arrow keys
182    bind $fileselect(pathEnt) <Tab>            "focus $fileselect(dirList) ; list select set 0 ; break"
183    bind $fileselect(dirList) <Return>         "Dialogos::fileselectTmp  ; break"
184    bind $fileselect(dirList) <KP_Enter>       "Dialogos::fileselectTmp  ; break"
185    bind $fileselect(dirList) <space>          "Dialogos::fileselectTake ; break"
186    bind $fileselect(dirList) <Tab>            "focus $accept ; break"
187    bind $fileselect(dirList) <Button-1>        {focus %W}
188    bind $fileselect(dirList) <Double-Button-1> {Dialogos::fileselectTmp ; break }
189    bind $extFrame            <KeyPress-Prior> "$fileselect(dirList) yview scroll -1 pages;break"
190    bind $extFrame            <KeyPress-Next>  "$fileselect(dirList) yview scroll  1 pages;break"
191    bind $accept              <Tab>            "focus $cancel ; break"
192    bind $cancel              <Tab>            "focus $fileselect(pathEnt) ; break"
193    bind $win                 <Escape>         "$cancel invoke"
194
195    # Inicializar las variables
196
197    set fileselect(path) {}
198    if {($initialDir!="")&&([file exists $initialDir])} {
199        set dir $initialDir
200    } else {
201        set dir $env(HOME)
202    }
203
204    set fileselect(dir) {}
205    set fileselect(done) 0
206
207    # Wait for the listbox to be visible so
208    # we can provide feedback during the listing
209    tkwait visibility $fileselect(dirList)
210    fileselectList $dir
211
212    grab $win
213    tkwait variable Dialogos::fileselect(done)
214    grab release $win
215
216    destroy $win
217    update
218    if {$fileselect(done)==1} {
219        return $fileselect(path)
220    }
221    return
222}
223
224###############################################################################
225# NewDir
226#    Opens a dialog box to create a new directory.
227###############################################################################
228proc NewDir {} {
229    variable fileselect
230    global labelTitles labelButtons getleftOptions
231    variable done
232
233    set coord(x) [winfo rootx .fileselect]
234    set coord(y) [winfo rooty .fileselect]
235
236    set dialog  [toplevel .dialog]
237    wm title $dialog $labelTitles(newDir)
238    wm resizable $dialog 0 0
239    wm geometry  $dialog +[expr {$coord(x)+100}]+[expr {$coord(y)+15}]
240
241    set done 0
242
243    set marcoEx [ttk::frame $dialog.marcoEx]
244    set marco   [ttk::frame $marcoEx.marco -relief groove]
245    set marcoIn [ttk::frame $marco.marcoIn]
246    set dirEnt  [ttk::entry $marcoIn.dirent -width 25]
247
248    set botones  [ttk::frame  $dialog.botones]
249    set aceptar  [ttk::button $botones.aceptar  -textvariable labelButtons(ok)     \
250            -width 8 -command {set Dialogos::done 1}]
251    set cancelar [ttk::button $botones.cancelar -textvariable labelButtons(cancel) \
252            -width 8 -command {set Dialogos::done 0}]
253
254    pack $cancelar -side right -padx 9 -pady 5
255    pack $aceptar  -side right -pady 5
256    pack $botones  -side bottom -fill x
257
258    pack $dirEnt
259    pack $marcoIn -padx 10 -pady 10
260    pack $marco -side bottom
261    pack $marcoEx -ipadx 10 -ipady 5
262
263    bind $dialog <Escape> "$cancelar invoke"
264    bind $dialog <Return> "$aceptar  invoke"
265
266    focus $dirEnt
267    grab $dialog
268    tkwait variable Dialogos::done
269
270    if {$done==1} {
271        set dir [$dirEnt get]
272        if {$dir!=""} {
273            if {[catch {file mkdir [file join $fileselect(dir) $dir]} error]} {
274                Dialogos::Dialogo .error -title $labelTitles(error) -icon error \
275                        -message $error
276            } else {
277                Dialogos::fileselectList $fileselect(dir)
278            }
279        }
280    }
281    grab release $dialog
282    destroy $dialog
283    return
284}
285
286###############################################################################
287# fileselectList
288#    Puts into the dialog box the directories found in the current one.
289#
290# Parameter
291#    dir: Current directory.
292##############################################################################
293proc fileselectList {dir} {
294    variable fileselect
295    global   labelTitles labelMessages
296
297    # Update directory
298    $fileselect(dirEnt) configure -text [file nativename $dir]
299
300    # Give the user some feedback
301    set fileselect(dir) $dir
302    $fileselect(dirList) delete 0 end
303    $fileselect(dirList) insert 0 Searching...
304    update idletasks
305
306    $fileselect(dirList) delete 0
307
308    # Add father directory and scan the current one
309    if {!([regexp {^((.:)?(/))$} $fileselect(dir)])} {
310        $fileselect(dirList) insert end ..
311    } else {
312        $fileselect(dirList) insert end /
313    }
314    if {[catch {glob -nocomplain $fileselect(dir)/*/} ficheros]} {
315        Dialogos::Dialogo .fileselect.error -type ok -icon error        \
316                -message $labelMessages(noReadDir)                      \
317                -title $labelTitles(error)
318        fileselectList [file dirname $dir]
319        return
320    }
321
322   # Show results
323   foreach f [lsort -dictionary $ficheros] {
324       $fileselect(dirList) insert end [file tail $f]
325   }
326   return
327}
328
329###############################################################################
330# fileselectOk
331#    This procedure is invoked when a directory is selected, if needed it asks
332#    whether the user wants to create it.
333##############################################################################
334proc fileselectOK { } {
335    variable fileselect
336    global labelTitles labelMessages
337
338    if {$fileselect(path)==""} {
339        fileselectTake
340        if {$fileselect(path)==""} return
341        if {[fileselectOK]==1} {
342	      set fileselect(done) 1
343        }
344        return
345    }
346
347    # El directorio padre tiene tratamiento especial
348    if {[regexp {\.\./?} $fileselect(path)]} {
349        set fileselect(path) {}
350        fileselectList [file dirname $fileselect(dir)]
351        return
352    }
353
354    set path [file join $fileselect(dir) $fileselect(path)]
355
356    if {![file exists $path]} {
357        set decision [Dialogos::Dialogo .fileselect.question -icon question    \
358                -message $labelMessages(unknown) -title $labelTitles(unknown)  \
359                -type yesno]
360        switch $decision {
361            yes {
362                file mkdir $path
363                set fileselect(path) $path
364                set fileselect(done) 1
365                return
366            }
367            no return
368        }
369    }
370    if {![file writable $path]} {
371        Dialogos::Dialogo .fileselect.error -type ok -icon error            \
372                -message $labelMessages(noWrite) -title $labelTitles(error)
373        set fileselect(path) ""
374        return
375    }
376    if {[file isdirectory $path]} {
377        set fileselect(done) 1
378        set fileselect(path) $path
379    }
380    return
381}
382
383###############################################################################
384# fileselectCancel
385#    Procedure to cancel the selection
386##############################################################################
387proc fileselectCancel {} {
388    variable fileselect
389
390    set fileselect(done) 1
391    set fileselect(path) {}
392
393    return
394}
395
396###############################################################################
397# fileselectClick
398#    Select the clicked item in the directory list.
399#
400# Parameter
401#    y: point where the user clicked.
402##############################################################################
403proc fileselectClick { y } {
404    variable fileselect
405
406    set fileselect(path) [$fileselect(dirList) get [$fileselect(dirList) nearest $Y]]
407    focus $fileselect(pathEnt)
408
409    return
410}
411
412###############################################################################
413# fileselectTake
414#    Takes the selected item from the directory list and puts it in the
415#    path entry.
416##############################################################################
417proc fileselectTake {} {
418    variable fileselect
419
420    set seleccion [$fileselect(dirList) curselection]
421    if {$seleccion!=""} {
422        set fileselect(path) [$fileselect(dirList) get $seleccion]
423    }
424    focus $fileselect(pathEnt)
425
426    return
427}
428
429###############################################################################
430# fileselectTmp
431#    Invoked when the user doubleclicks on an item in the directory list,
432#    takes the directory and makes it the current one.
433##############################################################################
434proc fileselectTmp {} {
435    variable fileselect
436
437    fileselectTake
438    if {[string match \.\. $fileselect(path)] } {
439        fileselectList [file dirname $fileselect(dir)]
440    } else {
441        fileselectList [file join $fileselect(dir) $fileselect(path)]
442    }
443    set fileselect(path) ""
444
445    return
446}
447
448################################################################################
449# DialogCallback
450#     The tile dialog require a callback to process the pressed button, this is
451#     it
452#
453# Parameter
454#     button: The pressed button.
455#
456# Side effect
457#     Puts in Dialogos::pressedButton the right value
458################################################################################
459proc DialogCallback {button} {
460    variable pressedButton
461
462    set pressedButton $button
463
464    return
465}
466
467################################################################################
468# Dialogo
469#     Invokes the tile dialog button in Unix, and Tk's one in Mac and Win.
470#     It tries to be an "almost" drop-in replacement for tk_messageBox.
471#
472# Parameters
473#     args: The pameters to pass to the real dialog command.
474#
475# Returns:
476#     The pressed button.
477################################################################################
478proc Dialogo {args} {
479    variable pressedButton
480    global   getleftState
481
482    # Used to be Tile had a dialog command
483    if {($getleftState(os)!="unix")||([info commands ::ttk::dialog] eq "")} {
484        set parent [lrange $args 0 0]
485        regexp {(.+)(\.)} $parent nada parent
486        if {![winfo exists $parent]} {
487            set parent .
488        }
489        regsub [lrange $args 0 0] {.*?$} parent {}
490        return [eval tk_messageBox [lrange $args 1 end] -parent $parent]
491    }
492
493    set path [lindex $args 0]
494    regsub {\.\.} $path {.} path
495
496    eval ttk::dialog $path [lrange $args 1 end]                  \
497            -command Dialogos::DialogCallback
498    tkwait variable Dialogos::pressedButton
499
500    return $pressedButton
501}
502
503}
504