Writing text into entry field in tcl/tk dialog - user-interface

In a tcl/tk dialog I need to get a text input from the user.
proc add_entry { command } {
global TestValue
entry .dialog_TC.enText -textvariable TestValue
grid .dialog_TC.enText -row 1 -column 1 -columnspan 2 -pady 1 -padx 1
}
The problem:
Whenever the user writes a single letter, into the entry-field, the dialog is closed immediately.

I'm guessing that you've got a trace elsewhere on the TestValue variable (possibly due to vwait or tkwait variable) that is detecting the change to the variable and destroying the widget when that happens, possibly by killing the whole dialog. You don't include the code, but it's probably something like:
proc make-me-a-dialog {} {
toplevel .dialog_TC
# ...
add_entry { something ... }
# ...
vwait TestValue
destroy .dialog_TC
return $TestValue
}
That's a guess, and probably greatly simplified too. But if that's the case, the first event to change the value in the variable (i.e., most key-presses in the entry) will cause the vwait to stop waiting and trigger the cascade of destruction.
You need to stop waiting on the contents of the entry. You don't want to trigger every time something is altered in it, but rather only when the user says “I'm done and want to make my changes, OK” or “I'm done and don't want to make my changes, Cancel”. Or, depending on interaction style, “I'm done; my changes are already live. Close this window”. With plenty of experience, the events that you are actually needing to listen for are the closing of the window, the press of Return and the press of Escape.
Let's fix.
proc make-me-a-dialog {}
global waiting
toplevel .dialog_TC
# ...
add_entry { something ... }
# ...
set dlg .dialog_TC
bind $dlg <Return> [list set waiting($dlg) 1]
bind $dlg <Escape> [list set waiting($dlg) 0]
# Trapping a window manager message; slightly different to normal events for historical reasons
wm protocol $dlg WM_DELETE_WINDOW [list set waiting($dlg) 0]
vwait waiting($dlg)
if {waiting($dlg)} {
return $ValueIndicatingOK
} else {
return $ValueIndicatingCancel
}
}

Ok, I did not think about my shortkeys, that I have also in that script. Whenever one of those letters is written into the entry field the window gets closed. I have to combine keys like ...
bind . <Control-Key-a> \
{ tk_messageBox -message "You pressed Control+A" } ;#Control+a

Related

How to bind 'Control-Control' event in Tcl/Tk

I would like to bind a very specific event, which is 'Control Key' followed by another 'Control Key', similar to KVM operation, to a widget.
I know how to bind various event but not this one, which comprises two sequential events.
Any idea how to implement it?
In theory, you'd be able to use a binding event sequence to do this:
# The keyboard often has two control keys; they have different names
bind $w <KeyPress-Control_L><KeyPress-Control_L> {puts "double-control (left)"}
bind $w <KeyPress-Control_R><KeyPress-Control_R> {puts "double-control (right)"}
However, the control keys (as with the other modifiers) are especially complicated to handle this way because they are repeated by the OS for you; they're a special case! Because of that, you instead need to build your own queue of keyboard events:
bind $w <KeyPress> {queueEvent %K}
set queue {no-such-key}
proc queueEvent {key} {
global queue
if {[llength [lappend queue $key]] > 2} {
set queue [lrange $queue end-1 end]
}
lassign $queue last this
if {$last eq $this && [string match Control* $this]} {
puts "double ctrl"
}
}
This can interact badly with other bindings. How to fix that depends on the wider context of your application.
Now with taking care of the quick delay required for "double-click"
bind . <KeyPress> {queueEvent %K}
set queue {}
set times {}
proc queueEvent {key} {
global queue times
if {![string match Control* $key]} {set queue {}; set times {}; return}
if {$key eq $queue} {
if {[expr [clock milliseconds] - $times] <= 500} {
puts "double ctrl $key"
set queue {}; set times {}
return
}
}
set queue $key
set times [clock milliseconds]
}

How can I setup an LLDB breakpoint firing every 10th time?

To debug the values of high frequency timers or sensors it would be useful to configure a breakpoint that only fires every x times. What's the best way to accomplish this?
I tried the "Ignore x times before stopping" option in Xcode but that only works for the first time. Can I reset this counter using an LLDB command?
You can reset the ignore counter at any time with:
(lldb) break modify -i <NEW_VALUE> <BKPT_SPECIFICATION>
Note, a breakpoint which doesn't satisfy its "ignore count" is not considered to be hit, so its breakpoint command does NOT get run. So if you wanted to stop every tenth the time you hit the breakpoint automatically, just do:
(lldb) break set -l 10 -i 10 -N my_bkpt
Breakpoint 1: where = foo`main + 46 at foo.c:10, address = 0x0000000100000f5e
(lldb) break com add
Enter your debugger command(s). Type 'DONE' to end.
> break modify -i 10 my_bkpt
> DONE
(lldb)
Then just hit "continue" at each stop and you will hit the breakpoint once every 10 times.
Note, I used the ability to name the breakpoint (the -N option) so I didn't have to know the breakpoint number in the breakpoint command that I added. That's convenient if you're going to store these breakpoints in a command file, etc.
Ref: Apple docs on Managing breakpoints. You can also do help breakpoint set command for a complete list of available options
I'm not sure you can define a persistent variable(counter) in lldb. You can always have one global var that you use as a counter helper and simply not include it in the release builds.
class BrCounter{
static var freq = 10
}
Edit the breakpoint and add the following condition:
BrCounter.freq--;
if(BrCounter.freq == 0){
BrCounter.freq = 10;
return true;
}else{
return false;
}
Oneliner:
BrCounter.freq--; if(BrCounter.freq == 0){ BrCounter.freq = 10; return true; }else{ return false; }

How do I use stack content in an LLDB breakpoint condition?

The problem:
I've got a situation where we have a media playback during launch, and objc_exception_throw() hits about 5 times during that period, but is always caught, and it's way south of the media player object.
I'm tired of either (a) having to manually continue n times, or (b) having to leave breakpoints disabled until after the playback is complete.
What I've tried:
making the breakpoint ignore the first five hits (problem: it's not always exactly five times)
creating my own symbolic breakpoint using my target as the module (problem: nothing changed)
What I'd like to do:
One solution that comes to mind is to evaluate the stack when the breakpoint hits, and continue if a particular method or function is listed therein. But I have no idea how to do this.
Other ideas welcome as well.
You do it using Python.
The following defines an ignore list and a function you can attach as a command to a breakpoint.
The function grabs the names of functions in the backtrace and set-intersects those names with the ignore list. If any names match, it continues running the process. This effectively skips dropping into the debugger for unwanted stacks.
(lldb) b objc_exception_throw
Breakpoint 1: where = libobjc.A.dylib`objc_exception_throw, address = 0x00000000000113c5
(lldb) script
Python Interactive Interpreter. To exit, type 'quit()', 'exit()' or Ctrl-D.
>>> ignored_functions = ['recurse_then_throw_and_catch']
def continue_ignored(frame, bp_loc, dict):
global ignored_functions
names = set([frame.GetFunctionName() for frame in frame.GetThread()])
all_ignored = set(ignored_functions)
ignored_here = all_ignored.intersection(names)
if len(ignored_here) > 0:
frame.GetThread().GetProcess().Continue()
quit()
(lldb) br comm add -F continue_ignored 1
(lldb) r
I tried it against the following file, and it successfully skips the first throw inside recurse_then_throw_and_catch and drops into the debugger during the throw inside throw_for_real.
#import <Foundation/Foundation.h>
void
f(int n)
{
if (n <= 0) #throw [NSException exceptionWithName:#"plugh" reason:#"foo" userInfo:nil];
f(n - 1);
}
void
recurse_then_throw_and_catch(void)
{
#try {
f(5);
} #catch (NSException *e) {
NSLog(#"Don't care: %#", e);
}
}
void
throw_for_real(void)
{
f(2);
}
int
main(void)
{
recurse_then_throw_and_catch();
throw_for_real();
}
I imagine you could add this function to your .lldbinit and then connect it to breakpoints as needed from the console. (I don't think you can set a script command from within Xcode.)
break command add -s python -o "return any('xyz' in f.name for f in frame.thread)"
If a python breakpoint command returns False, lldb will keep going. So this is saying: if any frame in the stack has the string 'xyz' in its name, then return True (to stop). Otherwise if no frame has that name, this any expression will return False (to keep going).

Running commands in background from TCL script and formatting output

I have a tcl script which runs multiple shell commands serially.
Something like this:
abc.tcl
command 1
command 2
command 3
...
command n
This script prints the outputs of these commands into a text file in the following format:
### ### ### ### ### ###
Command name
### ### ### ### ### ###
Command Output
### ### ### ### ### ##
I was trying to get the script to run faster but making the shell commands run in parallel instead of serially. By pushing them to the background (command a &). But I'm at a loss how to retain the formatting of my output text file as was the case before.
When I push the commands in to background I'm forced to append their outputs into a temporary file, but these files just have the output of the commands in a dump together. It's difficult to differentiate between the different outputs.
Is there someway I can redirect the output of each command running in the background to an individual temp file (maybe the name of the temp file can have the process id of the background running process). And once all commands have run, I can cat the outputs together in to the proper format? Any ideas/suggestions on how I can accomplish this.
If the commands don't have state that depends on each other, you can parallelize them. There are many ways to do this, but one of the easier is to use the thread package's thread pooling (which requires a threaded Tcl, the norm on many platform nowadays):
package require Thread
set pool [tpool::create -maxworkers 4]
# The list of *scripts* to evaluate
set tasks {
{command 1}
{command 2}
...
{command n}
}
# Post the work items (scripts to run)
foreach task $tasks {
lappend jobs [tpool::post $pool $task]
}
# Wait for all the jobs to finish
for {set running $jobs} {[llength $running]} {} {
tpool::wait $pool $running running
}
# Get the results; you might want a different way to print the results...
foreach task $tasks job $jobs {
set jobResult [tpool::get $pool $job]
puts "TASK: $task"
puts "RESULT: $jobResult"
}
The main tweakable is the size of the thread pool, which defaults to a limit of 4. (Set it via the -maxworkers option to tpool::create which I've listed explicitly above.) The best value to choose depends on how many CPU cores you've got and how much CPU load each task generates on average; you'll need to measure and tune…
You can also use the -initcmd option to pre-load each worker thread in the pool with a script of your choice. That's a good place to put your package require calls. The workers are all completely independent of each other and of the master thread; they do not share state. You'd get the same model if you ran each piece of code in a separate process (but then you'd end up writing more code to do the coordinating).
[EDIT]: Here's a version that will work with Tcl 8.4 and which uses subprocesses instead.
namespace eval background {}
proc background::task {script callback} {
set f [open |[list [info nameofexecutable]] "r+"]
fconfigure $f -buffering line
puts $f [list set script $script]
puts $f {fconfigure stdout -buffering line}
puts $f {puts [list [catch $script msg] $msg]; exit}
fileevent $f readable [list background::handle $f $script $callback]
}
proc background::handle {f script callback} {
foreach {code msg} [read $f] break
catch {close $f}
uplevel "#0" $callback [list $script $code $msg]
}
proc accumulate {script code msg} {
puts "#### COMMANDS\n$script"
puts "#### CODE\n$code"
puts "#### RESULT\n$msg"
# Some simple code to collect the results
if {[llength [lappend ::accumulator $msg]] == 3} {
set ::done yes
}
}
foreach task {
{after 1000;subst hi1}
{after 2000;subst hi2}
{after 3000;subst hi3}
} {
background::task $task accumulate
}
puts "WAITING FOR TASKS..."
vwait done
Notes: the tasks are Tcl commands that produce a result, but they must not print the result out; the fabric code (in background::task) handles that. These are subprocesses; they share nothing with one another, so anything you want them to do or be configured with must be sent as part of the task. A more sophisticated version could keep a hot pool of subprocesses around and in general work very much like a thread pool (subject to the subtle differences due to being in a subprocess and not a thread) but that was more code than I wanted to write here.
Result codes (i.e., exception codes) are 0 for “ok”, 1 for “error”, and other values in less common cases. They're exactly the values documented on the Tcl 8.6 catch manual page; it's up to you to interpret them correctly. (I suppose I should also add code to make the ::errorInfo and ::errorCode variable contents be reported back in the case of an error, but that makes the code rather more complex…)

How to display a listbox or text when a program is running

This is my coding. I am facing a problem where it didn't display the ".display_message" while it is still running. I receive the message only after the proc torun {} completed its task. Btw, after 2000 is actually my program running. It is a very long code where I feel it is not applicable so I removed it to simplified it. Please guide me in this. Thanks.
proc torun {} {
set total [.display_pc2 size]
.display_message insert end "test"
for {set x 0} {$x < $total} {incr x} {
set machine [.display_pc2 get $x]
.display_message insert end "Copy to $machine now. Please wait..."
.display_message see end
after 2000
.display_message insert end "Copy to $machine done"
.display_message see end
after 2000
}
}
You should completely change the way you write this code and use idle callbacks.
The idea is that you create a list of "tasks" to do (probably that would be a list of targets computers), save it somewhere and then process it one item at a time, rescheduling the execution using idle callback.
A sketch follows:
proc show_transfer_start {target} {
.display_progress add ... $target
}
proc show_transfer_result {res} {
.display_progress add ... $res
}
proc schedule_transfer {target rest} {
after idle [after 0 [list do_step $target $rest]]
}
proc do_step {target rest} {
set res [copy --to $target]
show_transfer_result $res
if {[llength $rest] > 0} {
set next [lindex $rest 0]
show_transfer_start $next
schedule_tranfer $next [lrange $rest 1 end]
}
}
set targets [list box1 box2 box3]
set first [lindex $targets 0]
show_transfer_start $first
schedule_transfer $first [lrange $targets 1 end]
I've never done tk (if it's gui what you're doing), but maybe you need some equivalent to flush when using puts to force-display a message.
Since I can't guess what's done inside the .display_message proc.
Edit:
Just got an idea: You can use the after command to fake-multithread your app.
after 0 [list .display_message insert end "Copy to $machine now. Please wait..."; .display_message see end]
Which will run independently from your current proc as event handler. Maybe that fixes your flush problem. (Requires the eventloop or update command)

Resources