brad.lanam.comp _at_ gmail.com
Currently unemployed.
Tcl/Tk, C, perl, php, shell, MySQL/MariaDB, HTML, CSS, porting, legacy systems, system administration.
website:
http://gentoo.com/ (registered 1992-03-26) No, this is not gentoo linux, they're at http://gentoo.org/ (registered 1999-10-04).
projects:
Created Pages:
Major Contribution:
Bugs filed:
Window screen height/width returns height/width of primary display: [L1 ]
Putting a window into fullscreen mode moves the window to the primary display: [L2 ]
Workaround:
set vx [winfo vrootx .] ; # so we can tell if monitors are 1-2 or 2-1
set vy [winfo vrooty .]
wm state $w zoomed
set nsh [winfo reqheight $w]
set nsw [winfo reqwidth $w]
wm overrideredirect $w yes
if { $vx < 0 } {
set nx $vx
} else {
set sw [winfo screenwidth .]
set nx [expr {$sw+1}]
}
set ny 0
wm geometry $w ${nsw}x${nsh}+$nx+0(fixed) tk_getOpenFile crashes when passed a bad type variable (windows, new file interface) [L3 ]
Workaround for bug in 8.6.3 tk_getOpenFile:
# work around 8.6.3 bug
if { $fn == {} || [regexp {^after#} $fn] } {
return
}Notes:
Using update rather than update idletasks prevents windows from putting the tk window into a not responding state.
tcltest's -relateddir doesn't sort the directories. This does not work if the tests are dependent on each other. Unfortunately, mine are. It is also a very poor choice for cross platform testing. This is fixed in a recent change (2016-7).
Windows starts up the tcl scripts with wish, which uses the wish icon. Starting with tclsh uses the icon set using 'wm iconbitmap'. So to get the wanted icon to display, restart the program with tclsh.
package require Tk
set tclsh [info nameofexecutable]
if { [regexp {wish\d*.exe} $tclsh] } {
regsub {wish\d*.exe} $tclsh tclsh.exe tclsh
exec $tclsh [info script] &
exit
}
wm iconbitmap . -default [file join $myimages bdj_icon.ico] wm iconphoto only works with .gif files on windows, and only seems to allow a single image (despite the documentation).
ActiveState Tcl/Tk doesn't seem to get a dock icon. Everything seems to work with MacPorts Tcl/Tk.
Mac OSX application name in menubar:
a) Symlink the application name to the wish executable.
a1) It seems that CFBundleExecutable has to be the same name as the application name (this seems a bit odd -- the python examples don't have this issue).
a2) I needed to run wish during the installation to get the real wish executable path. It seems that stdout gets completely lost. I had to open a file and save the output there, then I could retrieve the information from the output file in the postinstall script.
a3) info nameofexecutable will return the symlink in (a).
b) Create Resources/Scripts/AppMain.tcl. This script is executed when (a) is run. Always. So I use:
set script [file normalize [file join \
[file dirname [file dirname [file dirname [info script]]]] \
MacOS MyApp.tcl]]
if { $argc > 0 } {
set script [lindex $::argv 0]
set ::argv [lrange $::argv 1 end]
}
source $scriptso that the appropriate script is run. This does have the advantage that the application name in the menubar stays intact.
In general (from what I've read) it seems that the python users using the symlink trick have fewer problems getting their application name in the menubar. CFBundleExecutable doesn't have to match the application name, there's no startup script. Why is tk more complicated?
Why shrinking a window doesn't shrink the widget you want it to: https://groups.google.com/forum/#!topic/comp.lang.perl.tk/ZYD71t2tYDk
It would be nice if there was a way to configure this. Why doesn't shrinking the window honor the '-expand true' flags?
(Expanding the window honors the weight/expand flags. Shrinking the window uses the packing order of the widgets)
coroutines, the "wait for response" use case, and Tk.
There is a need to handle synchronous processing in Tk and let the event loop continue running. This is an area which is not well supported. There is a need for a parallel vwait, which does not exist at this time.
coroutines are not usable (from a maintenance perspective) for the "wait for response" use case in conjunction with the Tk event loop. It would be a maintenance nightmare.
vwait works, as long as you're aware of the nested vwait problem.
The only other alternative is writing wait loops and having short after timers in conjunction with vwait. Then even if the vwait is nested, the short timers should allow any nested vwaits to continue without much delay.
(I have no interest in people's comments on this. This page is just notes for my own purposes. See also TIP #374 for another example.)
#!/usr/bin/tclsh
#
# a simple echo response server for testing
#
variable vars
proc mainSocketHandler { handler sock addr port } {
chan configure $sock -blocking false
chan configure $sock -buffering none
fileevent $sock readable [list $handler $sock]
}
proc socketHandler { sock } {
while { [gets $sock cmd] >= 0 } {
puts "got $cmd"
set tm [expr {(round(rand()*3)+1)*1000}]
puts "waiting $tm"
after $tm ; # emulate some delay
puts "sending response to $cmd"
puts $sock "$cmd response"
}
}
proc main { } {
variable vars
set vars(sock) [socket -myaddr localhost \
-server [list mainSocketHandler socketHandler] 35000]
}
main
vwait forever#!/usr/bin/tclsh
#
# test program for synchronous response processing (works with wait loop).
#
package require Tk
variable vars
proc getcheck { sock varnm } {
variable vars
gets $sock resp
if { $resp ne {} } {
set vars(resp.$sock) $resp
set $varnm 2
} else {
set $varnm 1
}
}
proc sendget { sock msg } {
variable vars
puts $sock $msg
# wait loop
set vars(resp.$sock) {}
while { 1 } {
set vars(wait.$sock) 0
after 20 [list getcheck $sock ::vars(wait.$sock)]
vwait ::vars(wait.$sock)
if { $vars(wait.$sock) == 2 } {
set response $vars(resp.$sock)
break
}
}
return $response
}
proc getstatus { sock } {
variable vars
set resp [sendget $sock status]
puts "getstatus: $resp"
after 1000 [list getstatus $sock]
}
proc checkfileevent { sock } {
variable vars
set junk [read $vars(lsock.fe.in) 10000]
set resp [sendget $sock fileevent]
puts "fileevent:$resp"
}
proc localSocketHandler { sock addr port } {
variable vars
chan configure $sock -blocking false
chan configure $sock -buffering line
set vars(lsock.fe.in) $sock
fileevent $sock readable [list checkfileevent $vars(sock.fe)]
}
proc douserdata { sock } {
variable vars
set resp [sendget $sock $vars(user.data)]
puts "douserdata:$resp"
set vars(user.resp) $resp
}
proc main { } {
variable vars
# set up some sockets for use by the various processes
# getstatus will be a test for the after command
set vars(sock.status) [socket localhost 35000]
fconfigure $vars(sock.status) -blocking false
fconfigure $vars(sock.status) -buffering line
after 1000 [list getstatus $vars(sock.status)]
# local socket to create fileevents
set vars(lsock.main) [socket -myaddr localhost \
-server [list localSocketHandler] 35001]
set vars(sock.fe) [socket localhost 35000]
fconfigure $vars(sock.fe) -blocking false
fconfigure $vars(sock.fe) -buffering line
set vars(sock.user) [socket localhost 35000]
fconfigure $vars(sock.user) -blocking false
fconfigure $vars(sock.user) -buffering line
ttk::entry .e -textvariable vars(user.data)
pack .e
ttk::label .l -textvariable vars(user.resp)
pack .l
ttk::button .b -text go -command [list douserdata $vars(sock.user)]
pack .b
}
main