- tk/library/choosedir.tcl Version 1.19
- tk/library/tkfbox.tcl Version 1.55
- tk/library/bgerror.tcl,v 1.31
- tk/library/clrpick.tcl,v 1.20.2.1
# he-dialog.tcl # Version 0.6 proc windowFit {top} { # This proc is used in other scripts, too. # This proc is used in other scripts, too. if {$::tcl_platform(os) eq {Windows CE}} { if {[info exists ::etcl::etcl]} { bind $top <ConfigureRequest> {::etcl::autofit %W} bind $top <Expose> {::etcl::autofit %W} ::etcl::autofit $top } else { wm geometry $top 240x[expr {320 - 51}]+0+0 } } else { wm geometry $top 240x[expr {320 - 51}]+[expr {[winfo pointerx .] - 120}]+[expr {[winfo pointery .] - 135}] } return } if {[info exists ::etcl::etcl]} { # # tk_getOpenFile, tk_getSaveFile # option add *__tk_filedialog.icons.canvas.background white # hot patch file tkfbox.tcl,v 1.55 set body [split [info body ::tk::dialog::file::] "\n"] set changeA [list "\t# HE: Change the requester size to fit on pda" "\twindowFit \$w" {}] set changeB [list "\t# HE: To make the dialog window transient creates a title bar?!" "\t# (at least in etcl-8.4.12-pl7 and etcl-8.4.12-pl8)" "#[lindex $body 52]" "#[lindex $body 53]" "#[lindex $body 54]"] set body1 [join [concat [lrange $body 0 51] $changeB [lrange $body 55 end-20] $changeA [lrange $body end-19 end]] "\n"] proc ::tk::dialog::file:: {type args} $body1 # and exchange the procs rename ::tk_getOpenFile ::_tk_getOpenFile ;# The way back proc ::tk_getOpenFile {args} { return [eval ::tk::dialog::file:: open $args] } } rename ::tk_getSaveFile ::_tk_getSaveFile ;# The way back proc ::tk_getSaveFile {args} { return [eval ::tk::dialog::file:: save $args] } # # tk_chooseDirectory # option add *__tk_choosedir.icons.canvas.background white # hot patch file choosedir.tcl,v 1.19 set body [split [info body ::tk::dialog::file::chooseDir::] "\n"] set changeA [list "\t# HE: Change the requester size to fit on pda" "\twindowFit \$w" {}] set changeB [list "\t# HE: To make the dialog window transient creates a title bar?!" "\t# (at least in etcl-8.4.12-pl7 and etcl-8.4.12-pl8)" "#[lindex $body 44]" "#[lindex $body 45]" "#[lindex $body 46]"] set body1 [join [concat [lrange $body 0 43] $changeB [lrange $body 47 end-23] $changeA [lrange $body end-22 end]] "\n"] proc ::tk::dialog::file::chooseDir:: {args} $body1 set body [split [info body ::tk::dialog::file::chooseDir::OkCmd] "\n"] set changeA [list "\tset text \[eval file join \[file split \[string trim \$text\]\]\]"] set body1 [join [concat [lrange $body 0 26] $changeA [lrange $body 28 end]] "\n"] proc ::tk::dialog::file::chooseDir::OkCmd {w} $body1 # and exchange the procs rename ::tk_chooseDirectory ::_tk_chooseDirectory proc ::tk_chooseDirectory {args} { return [eval ::tk::dialog::file::chooseDir:: $args] } # # bgerror # # hot patch file bgerror.tcl,v 1.31 set body [info body ::tk::dialog::error::bgerror] regsub -all -- {set messageFont\s\{Times -18\}} $body "set messageFont\tsystem" body1 regsub -all -- {-setgrid true} $body1 "" body1 regsub -all -- {-padx 10} $body1 {-padx 2} body1 regsub -all -- {-sticky ew} $body1 {-sticky nsew} body1 proc ::tk::dialog::error::bgerror err $body1 # ChangeA helps us to react of changing the locale. The use of 'option add *ErrorDialog.function.text ...' in the original script mixed up the locale if the locale changed at script livetime set body [split [info body ::tk::dialog::error::Details] "\n"] set changeA [list "set caption \[mc \"Save To Log\"\]"] set changeB [list "\twindowFit \$w"] set body1 [join [concat [lrange $body 0 1] $changeA [lrange $body 3 end] $changeB] "\n"] proc ::tk::dialog::error::Details {} $body1 # some german locale are to long for the small screen namespace eval ::tk::dialog::error:: { ::msgcat::mcset de "Skip Messages" "Weitere Nachrichten\n\u00fcberspringen" ::msgcat::mcset de "Save To Log" "In Protokoll\nspeichern" }if 0 {The next part is the old-fashioned Unix colorchooser. Needs version A of pkgIndex.tcl}
# # tk_chooseColor # # hot patch file clrpick.tcl,v 1.20.2.1 set body [split [info body ::tk::dialog::color::] "\n"] set changeA [list "\t# HE: Change the requester size to fit on pda" "\twindowFit \$w" {}] set changeB [list "\t# HE: To make the dialog window transient creates a title bar?!" "\t# (at least in etcl-8.4.12-pl7 and etcl-8.4.12-pl8)" "#[lindex $body 54]" "#[lindex $body 55]" "#[lindex $body 56]"] set changeC [list "\tset data(BARS_WIDTH) 112"] set body1 [join [concat [lrange $body 0 22] $changeC [lrange $body 24 53] $changeB [lrange $body 57 end-19] $changeA [lrange $body end-17 end]] "\n"] proc ::tk::dialog::color:: args $body1 set body [split [info body ::tk::dialog::color::BuildDialog] "\n"] set changeA [list "\tpack \$stripsFrame -side top -fill both -padx 4 ;#-pady 10"] set changeB [list "\tpack \$selFrame -side top -fill none -anchor nw"] set changeC [list "\t\tpack \$f.color ;#-expand yes -fill both" "\t\tpack \$f.sel ;#-expand yes -fill both"] set changeD [list "\tpack \$f1 -side left -expand yes -anchor nw ;# -fill both -padx 6 -pady 10" "\tpack \$lab \$ent -side top -fill x -padx 4 -pady 2"] set changeE [list "\tset data(finalCanvas) \[frame \$f1.demo -bd 0 -width 100 -height 35\]"] set body1 [join [concat [lrange $body 0 30] $changeC [lrange $body 33 49] $changeA [lrange $body 51 58] $changeE [lrange $body 60 60] $changeD [lrange $body 63 66] $changeB [lrange $body 68 end]] "\n"] proc ::tk::dialog::color::BuildDialog w $body1 # and exchange the procs rename ::tk_chooseColor ::_tk_chooseColor proc ::tk_chooseColor {args} { return [eval tk::dialog::color:: $args] }if 0 {The next part is a replacement for the part above Unix colorchooser} based on colorChooser for pocketPC/etcl. Needs version B of pkgIndex.tcl}
# # tk_chooseColor # # alternative color dialog rename ::tk_chooseColor ::_tk_chooseColor proc ::tk_chooseColor {args} { return [eval ::he::dialog::colordialog $args] } } package provide he-dialog 0.54. We need a file pkgIndex.tcl with the following contens. Version A - old-fashioned Unix colorchooser:
package ifneeded he-dialog 0.6 " [list source [file join $dir tkfbox.tcl] ;] [list source [file join $dir choosedir.tcl] ;] [list source [file join $dir bgerror.tcl] ;] [list source [file join $dir clrpick.tcl] ;] [list source [file join $dir he-dialog.tcl] ] "And Version B - with colorChooser for pocketPC/etcl:
package ifneeded he-dialog 0.6 " [list namespace eval ::he::dialog {} ;] [list set ::he::dialog::dir $dir ;] [list source [file join $dir tkfbox.tcl] ;] [list source [file join $dir choosedir.tcl] ;] [list source [file join $dir msgbox.tcl] ;] [list source [file join $dir bgerror.tcl] ;] [list source [file join $dir colorBox.tcl] ;] [list source [file join $dir he-dialog.tcl] ] "5. Move the directory dialogDir to a directory in the auto_path of etcl. This is
file join [file dirname etcl.exe] .. libThat's it! Hope I haven't copied any error into the code :-)Load the package with
package require he-dialogand now you can use the old new dialogboxes tk_getOpenFile, tk_getSaveFile and tk_chooseDir.You can load the package inside the console:
console eval {package require he-dialog}
RS: Very good work! Following your instructions, making and installing it went all flawlessly. Now I'm back to the old-fashioned Unix fileselectors, but still more empowered than Microsoft would have us... Thank you! Just one note: instead of "online patch", I'd rather call this technique hot patch. For the lazy or anxious, I've made a ZIP file of the package at [1] - should run without unzipping... 2006-02-14 HE - Followed your suggestion and changed the comments to hot patch. - RS Another note: the canvas in which one selects directories or files is pretty gray. Not wanting to hot-patch this patch, I just add the line
option add *canvas.background whitebefore package require he-dialog in my etclrc.tcl startup file - see screenshot at top of this page how it comes out then.2006-02-14 HE - Argh! Found an error.
proc ::tk::dialog::file::chooseDir:: {type args} $body1should be
proc ::tk::dialog::file::chooseDir:: {args} $body1Fixed it!Also insert the suggestion from RS to use option.2006-02-16 HE - Added a hot patch to make the bgerror dialog more readable (at least if we use the detail button). - RS: thanks - that was another grumble I had with eTcl :)EH Great! This is really what eTcl was missing, and I could never find time for this. No objection for making them the default in next eTcl release? Shall I dare to mention a good tk_chooseColor dialog is also still missing ... ;-)2006-02-20 HE - Added a hot patch to provide the old-fashioned Unix color dialog. I'm working at an alternative color chooser, but it needs some time. Another problem I try to fix is the behavior of the tk_messageBox. It doesn't really works with big messages on this small displays.I'm missing the correct display of the locale text (etcl/pocketPC pl8) Running etcl on win32 uses mclocale de. Running etcl on pocketPC uses mclocale c. The regional options on both machines are configured to german. The locale file is installed inside of etcl/pocketPC. I can force the correct locale with
msgcat::mclocale deBut I think, the system configuration should be used (The native dialog boxes uses the correct locale?!)EH Init in msgcat.tcl look for HKEY_CURRENT_USER\Control Panel\International to determine locale, but this is an invalid registry key on PocketPC. Valid keys are HKEY_CURRENT_USER\Control\Panel\Desktop\MultiUILanguageId for user's UI language selection, or HKEY_LOCAL_MACHINE\Nls\Language for default system language. Both can also be obtained from GetUserDefaultUILanguage() and GetSystemDefaultUILanguage() functions. I had wce subcommands for those functions, and force setting env(LANG) env at startup, since it will be then used in msgcat::Init to set correct default language.HE Thank you for this informations. But I have a problem with my two pocketPCs. The registry keys
- HKEY_CURRENT_USER\Control Panel\International
- HKEY_CURRENT_USER\Control\Panel\Desktop\MultiUILanguageId
- HKEY_LOCAL_MACHINE\Nls\Language
- HKEY_LOCAL_MACHINE\MUI\SysLang (1031 = german, 1033 = english?)
- HKEY_LOCAL_MACHINE\nls\DefaultLCID (1031 = german, 1033 = english?)
- HKEY_LOCAL_MACHINE\nls\SystemLCID (1031 = german, 1033 = english?)
- HKEY_CURRENT_USER\MUI\CurLang (1031 = german, 1033 = english?)
PWE 2006-03-12: When using tk_chooseDirectory (with etcl), and pressing OK, I get:
extra characters after close-brace while compiling "set text [file join {*}[file split [string trim $text]]].......which seems to be caused by the:
set text [file join {*}[file split [string trim $text]]]in ::tk::dialog::file::chooseDir::OkCmd in choosedir.tcl (V1.19). After replacing this line with:
set text [eval file join [file split [string trim $text]]]from choosedir.tcl (V1.15.2.2), it seems to work OK.2006-03-12 HE: PWE, thank you for the hint. The hot patch for tk_chooseDirectory is changed. My mistake: I developed it on a w32 system, where it works correctly. Forget to test in on pocketPC:-( - RS: Rather, you developed on 8.5 which has {*}. But as eTcl is still at 8.4.12, let's stick with that for a while :-)
2006-03-13 HE: Added the colorChooser for pocketPC/etcl.
2006-03-17 HE: Added some suggestions from EH to windowFit.
2007-10-17 Newmagic : Hi, I sent you an email, HE, but I didn't got an answer, so I post here my question : I searched for an automatic installation and the only solution I found is to place the directory DialogDir/ directly in the directory of my program, and to call them using 'source <file>'. So, I would like to know if you autorize me to copy your files in the programs I make ? Thanks ! 2007-10-17 HE : Hello Newmagic, everything you need is written at HE:
I post no code. Only text. Try/feel free to use it as code but don't blame me, if it doesn't work or something goes wrong. If you (or someone else) think it is code and you (or someone else) think you need a license, take the license.terms which comes with tcl.I think this covers your purpose :-) By the way. Have you seen the pkgIndex.tcl part on this side? So you can load it with 'package require he-dialog' from multiple programs with only one installation.2007-10-18 Newmagic : Thanks for your reply. So that's ok ! Great ! I know about 'package require he-dialog' but I prefer to use this package as file integrated in project to simplify the installation for end-users. Everything seems to work with one 'source <file>' for each file. Thanks again ! EH Adding directory containing the he-dialog source and pkgIndex.tcl to the ::auto_path variable, and using [package require he-dialog] instead of sourcing, is just as simple, doesn't have any implication for the end-user, and will help keeping your code more clean. The he-dialog files can be embedded into your application's eTcl kit withotu any problem. I would recommend that. And definately need to take time to integrate those nice modifications made by Holger into eTcl distrib, it should have been done since very long time, I'm the one to blame!