Version 23 of Alternative dialogs for pocketPC/etcl
Updated 2006-02-20 17:57:452006-02-14 HE - The native file selection dialog box of Windows/CE shows only files from /My Documents and files of the first level of directories inside /My Documents.
For me this is not very useful.
I remembered that there is a builtin file selection dialog box for Unix platforms. It resides in the file lib/tk/tkfbox.tcl.
Some tests shows that this dialogbox can be used on PocketPC with etcl. Only some changes are needed.
A simple package can help to use the following dialog boxes: tk_getOpenFile, tk_getSaveFile, tk_chooseDir Additional bgerror dialog fits better on the small screen.
I named it he-dialog. The prefix he- is only used to separate my packages/code from others. Using only dialog as name contains the risk to interfere with other packages.
It sources the original files and changes them at runtime (on-the-fly). Then it exchanges the native commands with the patched ones.
How to build the package:
1. Create a directory to collect all the parts of the package. For example dialogDir
2. Get the following files from the cvstree on http://tcl.sourceforge.net/ and copy them into this directory. By now the script needs exactly this version. With other versions it can/may fail:
- 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
3. Create a file he-dialog
# he-dialog.tcl
# Version 0.3
proc windowFit {top} {
# 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}
::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
# 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
proc ::tk::dialog::error::bgerror err $body1
set body [split [info body ::tk::dialog::error::Details] "\n"]
lappend body "\twindowFit \$w"
set body1 [join $body "\n"]
proc ::tk::dialog::error::Details {} $body1
#
# 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]
}
}
package provide he-dialog 0.34. We need a file pkgIndex.tcl with the following contens:
package ifneeded he-dialog 0.3 "
[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] ]
"5. Move the directory dialogDir to a directory in the auto_path of etcl. This is
file join [file dirname etcl.exe] .. lib
That's it! Hope I haven't copied any error into the code :-)
Load the package with
package require he-dialog
and 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 [L1 ] - 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 white
before 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.