In tk, the listbox can take a number of different selectModes: single, browse, multiple, and extended. What I want is to be to select only one item at a time (like single or browse) but then deselect the option when the user clicks again - essentially a "single or none" option.
I don't think I can use the ListboxSelect callback because that only is called "when the set of selected item(s) in the listbox is updated" - not when the user clicks a previous selection.
Do I have to resort to a series of checkboxes?
Note: For the listbox, I have exportselection=0 so I don't lose my selection when another widget takes focus.
You don't have to resort to a series of checkboxes, you can simply bind to the buttonpress event, and add a click handler.
Observe, an example:
bind $listbox <Button-1> {listbox_selection_toggler %W %x %y}
proc listbox_selection_toggler {W x y} {
set c [$W cursel]
set i [$W index #$x,$y]
lassign [$W bbox $i] x1 y1 x2 y2;
set x2 [expr {$x1 + $x2}]
set y2 [expr {$y1 + $y2}]
if { $y < $y1 || $y > $y2 } {
puts "(Cur: $c) Clicked on $W at $x,$y, index $i. (NOT IN BBOX)";
} else {
puts "(Cur: $c) Clicked on $W at $x,$y, index $i.";
if { $c != "" && $i == $c } {
puts "Toggling selection off."
after 0 [list $W sel clear 0 end]
}
}
}
Now, obviously there's room for improvement, but this demonstrates the general idea.
Related
I'm new to using DOORS and am trying to create a column/attribute that has the date of the last modification to the Object Text. I found the below code which uses "Last Modified On", but that that includes all attributes and I'm only concerned about the Object Text. Maybe there's a way to specifiy an attribute for this?
Date dMod
dMod = obj."Last Modified On"
dMod = dateAndTime(dMod)
display dMod ""
There's no such attribute on an attribute.
The only way to determine this is via the object's history. Below is the example script from DXL manual. The idea is to loop through the object's history until the history record's typeis modifyObjectand it's attrName equals 'Object Text'. Keep in mind, though, that the history in a module only goes back to the last baseline. So, you may have to browse through all baselines to find the history record you need. See Tony's "Smart History Viewer" at http://www.smartdxl.com/content/?page_id=125 for details.
// history DXL Example
/*
Example history DXL program.
Generate a report of the current Module's
history.
*/
// print a brief report of the history record
void print(History h) {
HistoryType ht = h.type
print h.author "\t" h.date "\t" ht "\t"
if (ht == createType ||
ht == modifyType ||
ht == deleteType) { // attribute type
print h.typeName
} else if (ht == createAttr ||
ht == modifyAttr ||
ht == deleteAttr) {
// attribute definition
print h.attrName
} else if (ht == createObject ||
ht == clipCopyObject ||
ht == modifyObject) { // object
print h.absNo
if (ht==modifyObject) {
// means an attribute has changed
string oldV = h.oldValue
string newV = h.newValue
print " (" h.attrName ":" oldV " -> " newV ")"
}
}
print "\n"
}
// Main program
History h
print "All history\n\n"
for h in current Module do print h
print "\nHistory for current Object\n\n"
for h in current Object do print h
print "\nNon object history\n\n"
for h in top current Module do print h
When using foreach in TCL to loop through a list it is desired to have a running number of the index of the current object. A way I have done this before is to maintain an extra counter variable.
set ct 0
foreach x $list {
puts "Items is $x index is $ct"
incr ct
}
One could use lsreach to retrieve the index but that's compute intensive and could be problematic with double occurrences.
Wondering if there is streamlined sleek-looking way of maintaining index information during a loop.
Pseudocode :
foreach x $list {
puts "Items is $x index is [foreach_index $x]"
}
Your feedback is appreciated.
UPDATE:
Run time tests with the provided answers:
Peter Lewerin : 86098.8 microseconds per iteration
Gert : 91057.4 microseconds per iteration
David B : 115860.0 microseconds per iteration
Loop through list with 100k random strings 80char long.
The loop proc is fastest, but hard to read.
While the control structure definitions in other languages are the law, in Tcl they're more like a set of guidelines.
proc foreachWithIndex {indexVar args} {
upvar 1 $indexVar var
set var 0
uplevel 1 [list foreach {*}[lrange $args 0 end-1] "[lindex $args end];incr $indexVar"]
}
foreachWithIndex x v {a b c} {puts "$x: $v"}
But I suggest using for instead. Radical language modifications are fun and occasionally useful, but if I had an Imperial credit for every such clever construct I ended up throwing away later I could build my own Death Star and still have money to put a grating over the exhaust port.
Your method of using incr with a counter works ok. This also works:
for { set i 0 } { $i < [llength $list] } { incr i } {
set x [lindex $list $i]
puts "Items is $x index is $i"
}
Another advantage of doing it this way is that you can modify the list while you are iterating. Let's say you want to remove all items with the value "bad" from a list.
set values { 1 2 3 bad 4 bad bad 5 }
for { set i 0 } { $i < [llength $values] } { incr i } {
if { [lindex $values $i] eq "bad" } {
set values [lreplace $values $i $i]
incr i -1
}
}
puts $values
In the following code I create 3 boxes with the text 1 to 3, in a fourth box I'd like to show the text of the box my mouse is hovering over. So i set an onMouseEnter FProperty for each of the boxes where I change the string of the fourth box and tell it to redraw.
bool redraw = false;
str s = "0";
Figure getTextbox() {
return computeFigure(bool() {bool temp = redraw; redraw = false; return temp; },
Figure() {
return text(str() {return s; });
});
}
list[Figure] boxes = [];
for (i <- [1..4]) {
boxes += box(text(toString(i)), onMouseEnter(void () {s = toString(i); redraw = true; }));
}
Figure changer = box(getTextbox());
render(vcat(boxes + changer));
However, for some odd reason all three boxes will tell the onMouseEnter method to change the text of the fourth box into "3" (the value of the last box) instead of their individual value.
Any clue why? Thanks!
Ah yes, this is the variable capturing closure problem with for loops, also known from other languages which have this particular feature like Javascript. This is the code with the issue:
for (i <- [1..4]) {
boxes += box(text(toString(i)), onMouseEnter(void () {s = toString(i); redraw = true; }));
}
The variable i is bound by the void closure and not its value. So every time the function which is created and passed to onMouseEnter it will read the latest value of the i variable. Since the callback is called after the loop terminates, all calls to the mouse enter function will have the value 3.
To fix this and "do what you want", the following code would work I believe:
for (i <- [1..4]) {
newS = toString(i);
boxes += box(text(toString(i)), onMouseEnter(void () {s = newS; redraw = true; }));
}
This works because for every pass of the for loop a new environment is created which binds the newS variable. So you'll get a fresh newS for every loop instead of the reused i.
I have two lists I'd like manipulate.. ( I am a tcl newbie..). I'd like to associate these two lists and create a third list with some data added.
The data I have:
set aes {ae0 ae3 ae6 ae1v1 ae1v8}
set c {c1 c2 c3 k1 k2}
foreach A $aes {
foreach C $c {
puts ${A}_$C
}
}
The data I get as you'd expect is:
ae0_c1
ae0_c2
ae0_c3
ae0_k1
ae0_k2
..
..
What I want to do is
append some data in front of this.
AE-To-c = All ae0_c1 ae0_c2 ae0_c3 ae0_k1 ae0_k2 .. End.
% set aes {ae0 ae3 ae6 ae1v1 ae1v8}
ae0 ae3 ae6 ae1v1 ae1v8
% set c {c1 c2 c3 k1 k2}
c1 c2 c3 k1 k2
% foreach A $aes {
foreach C $c {
# saving into 'result' variable
lappend result ${A}_${C}
}
}
% set data "some more here"
some more here
% set result
ae0_c1 ae0_c2 ae0_c3 ae0_k1 ae0_k2 ae3_c1 ae3_c2 ae3_c3 ae3_k1 ae3_k2 ae6_c1 ae6_c2 ae6_c3 ae6_k1 ae6_k2 ae1v1_c1 ae1v1_c2 ae1v1_c3 ae1v1_k1 ae1v1_k2 ae1v8_c1 ae1v8_c2 ae1v8_c3 ae1v8_k1 ae1v8_k2
% set result [linsert $result 0 $data]
some more here ae0_c1 ae0_c2 ae0_c3 ae0_k1 ae0_k2 ae3_c1 ae3_c2 ae3_c3 ae3_k1 ae3_k2 ae6_c1 ae6_c2 ae6_c3 ae6_k1 ae6_k2 ae1v1_c1 ae1v1_c2 ae1v1_c3 ae1v1_k1 ae1v1_k2 ae1v8_c1 ae1v8_c2 ae1v8_c3 ae1v8_k1 ae1v8_k2
Your question isn't 100% clear. Is it something like this you want?
set res [list AE-To-c = All]
foreach A $aes {
foreach C $c {
lappend res ${A}_$C
}
}
lappend res End
If you want to do what I think you want to do, you need to capture the permutations of the two lists in a list instead of printing them out, and then wrap that list in a prefix and suffix.
The method above pre-loads the result list with the AE-To-c = All prefix, then picks up the permutations using lappend, and finally adds the End suffix as a last element in the list.
Another way:
set res [list]
foreach A $aes {
foreach C $c {
lappend res ${A}_$C
}
}
concat [list AE-To-c = All] $res End
In this variant the list of permutations is created first, and then the prefix list, the permutation list, and the suffix list (yes, End is a list) are concatenated into one flat list.
Documentation: concat, foreach, lappend, list, set
I adapted code from Brent Welch's book so that my entry box can be filled using listbox. Can the code listed below be improved upon? Also, I want to convert this code into a widget so that any one using the code base can reuse it. What do I need to do convert this into a reusable widget?
The code is listed below:
#----------------------------------------------
# Code adapted from Brent Welch's book
#----------------------------------------------
proc scrolled_listbox { f args } {
frame $f
listbox $f.list
eval {$f.list configure} $args
scrollbar $f.xscroll -orient horizontal \
-command [list $f.list xview]
scrollbar $f.yscroll -orient vertical \
-command [list $f.list yview]
grid $f.list -sticky news
grid rowconfigure $f 0 -weight 1
grid columnconfigure $f 0 -weight 1
return $f.list
}
proc listbox_transfer_select {src dst} {
set select [$src curselection]
foreach i $select {
set elements [$dst get 0 end]
set e [$src get $i]
# insert only if the new element e is not present
if {$e ni $elements} {
$dst insert end $e
}
}
}
proc listbox_delete_select {dst} {
foreach i [lsort -integer -decreasing [$dst curselection]] {
$dst delete $i
}
}
proc onOk {picked parent window} {
set elements [$picked get 0 end]
$parent.e delete 0 end
$parent.e insert insert $elements
destroy $window
}
#----------------------------------------------
# Put everything together
#----------------------------------------------
proc list_select { parent values } {
# Create two lists side by side
set choiceWindow ${parent}.choices
toplevel $choiceWindow
set main [frame $choiceWindow.f1]
set choices [scrolled_listbox $main.choices \
-selectmode extended -width 20 -height 5 ]
set picked [scrolled_listbox $main.picked \
-selectmode extended -width 20 -height 5]
set inter [frame $main.inter -width 20 -height 5]
button $inter.b1 -width 10 -text ">>"
pack $inter.b1 -side top
button $inter.b2 -width 10 -text "<<"
pack $inter.b2 -side bottom
pack $main.choices $inter $main.picked -side left -expand true -fill both
set okcancel [frame $choiceWindow.f2]
button $okcancel.ok -text "OK" -command [list onOk $picked $parent $choiceWindow]
button $okcancel.cancel -text "Cancel" -command [list destroy $choiceWindow]
grid $okcancel.ok $okcancel.cancel
pack $main $okcancel -side top -anchor e
# Selecting in choices moves items into picked
bind $inter.b1 <ButtonRelease-1> [list listbox_transfer_select $choices $picked]
# Selecting in picked deletes items
bind $inter.b2 <ButtonRelease-1> [list listbox_delete_select $picked]
# ok
bind $choiceWindow <Return> [list onOk $picked $parent $choiceWindow]
# cancel
bind $choiceWindow <Escape> [list destroy $choiceWindow]
# Insert all the choices
foreach x $values {
$choices insert end $x
}
}
proc my_entry_list { parent options } {
frame $parent
label $parent.l -text "Fruits:"
entry $parent.e -width 15 -textvariable result -relief sunken
button $parent.b -text ... -command [list list_select $parent $options]
pack $parent.l $parent.e $parent.b -side left
}
#----------------------------------------------
# main
#----------------------------------------------
set options { grapes mangos peaches pears oranges berries }
my_entry_list .mel $options
pack .mel
No way to use the ttk::combobox widget from Tk 8.5 or the ComboBox widget from BWidget (if you have to stay at 8.4 or below)?