I want to create labels that the text in them can be selected for copy/paste. To do this I tried to use entries that are read-only. But I can't seem to initialize the text value in them. The labels are generated inside a loop and the number of labels and their content is unknown. The code to produce the labels is:
proc test_labels {} {
toplevel .labels
# Main Frame
frame .labels.main_frame -relief "groove" -bd 2
pack .labels.main_frame
set r 1
foreach t [list banana apple grapes orange lemon peach] {
set lbl [label .labels.main_frame.lbl_$r -text "fruit $r:"]
set lbl2 [label .labels.main_frame.val_$r -text $t]
grid $lbl -row $r -column 1 -sticky nse
grid $lbl2 -row $r -column 2 -sticky nsw
incr r
}
set ok_btn [button .labels.main_frame.ok_b -text "OK" -command {prop_menu_ok_button}]
grid $ok_btn -row [expr $r+2] -column 1 -columnspan 2 -sticky nsew
grab release .
grab set .labels
center_the_toplevel .labels
bind .labels <Key-Return> {test_labels_ok_button}
}
And it creates the fallowing window:
Then I try to replace the line set lbl2 [label .labels.main_frame.val_$r -text $t] with the lines:
eval "set text_val_$r $t"
eval "set lbl2 [entry .labels.main_frame.val_$r -relief flat -state readonly -textvar text_val_$r]"
But this only creates empty lines:
How can I put default values to entry widgets?
Related to the question How to make the text in a Tk label selectable?
These lines are almost certainly not what you want! (If you're using eval, you should always ask whether it's really necessary; from 8.5 onwards, the likely answer is “it's not necessary”.)
eval "set text_val_$r $t"
eval "set lbl2 [entry .labels.main_frame.val_$r -relief flat -state readonly -textvar \$\{text_var_$r\}]"
The key problem — apart from the use of eval — is that the -textvariable option takes the name of a variable. Let's fix that by using an array to hold the values:
set text_val($r) $t
set lbl2 [entry .labels.main_frame.val_$r -relief flat -state readonly \
-textvariable text_val($r)]
Also, be aware that the text_val array needs to be global (or in a namespace, if you fully qualify the name when giving it to the -textvariable option). This is because it is accessed from places which are outside the scope of any procedure.
Of course, it turns out that if we are keeping values constant then we can avoid using a variable at all and just insert the value manually.
set lbl2 [entry .labels.main_frame.val_$r -relief flat]
$lbl2 insert 0 $t
$lbl2 configure -state readonly
If you're never changing the value, that will work fine.
Related
I'm using DynamicHelp to display tooltips. The problem is that it only displays help when the cursor is on the body of the tab: not when it is on the tab itself. What I'd like to happen is for the help text to be displayed when the user is hovering over the tabs instead of having to select the tab, then move the cursor to the body before the help is displayed.
package require BWidget
## create a notebook with 2 text panes
NoteBook .n
.n insert 0 tb1 -text "Tab 1"
.n insert 1 tb2 -text "Tab 2"
foreach panel {tb1 tb2} {
set pane [.n getframe $panel]
text $pane.t
pack $pane.t -fill both -expand 1
}
pack .n
.n raise tb1
# ,-- How do I get the tab?
DynamicHelp::add [.n getframe tb1] -text "The essence of silly\nsally silica"
DynamicHelp::add [.n getframe tb2] -text "acetyl sali cylic\nacid is aspirin"
I found this piece of code on the notebook implementation - I don't know if it helps. I can't figure out how it gets the handle of the tab from this.
proc NoteBook::_highlight { type path page } {
variable $path
upvar 0 $path data
if { [string equal [Widget::cget $path.f$page -state] "disabled"] } {
return
}
switch -- $type {
on {
$path.c itemconfigure "$page:poly" \
-fill [_getoption $path $page -activebackground]
$path.c itemconfigure "$page:text" \
-fill [_getoption $path $page -activeforeground]
}
off {
$path.c itemconfigure "$page:poly" \
-fill [_getoption $path $page -background]
$path.c itemconfigure "$page:text" \
-fill [_getoption $path $page -foreground]
}
}
}
I have written a small extension to the Notebook widget what does exactly what you want. You can download it from notebook-tip.tcl. Use it as follows:
After package require, source this file. Create your tabs and add the balloons. Multiple lines are possible.
Example:
package require BWidget
source notebook-tip.tcl
NoteBook .n
.n insert 0 tb1 -text "Tab 1"
.n balloon tb1 "balloon text for Tab 1"
.n insert 1 tb2 -text "Tab 2"
.n balloon tb2 "balloon text for Tab 2"
foreach panel {tb1 tb2} {
# add contents
set pane [.n getframe $panel]
text $pane.t
pack $pane.t -fill both -expand 1
}
.n raise tb1
grid .n -sticky ew
You can change the balloon text dynamically with itemconfigure:
$path itemconfigure $page -balloon text
For example:
.n itemconfigure tb1 -balloon "another text"
Really, you can. You must add the the option -helptext in the command "insert".
According to Bwidget doc :
[...]
pathName insert index page ?option value...?
Insert a new page identified by page at position index in the pages list. index must be numeric or end. The pathname of the new page
is returned. Dynamic help, if it is specified by the options, is
displayed when the pointer hovers over the tab that belongs to the
page.
-helpcmd
Has no effect. See also DynamicHelp.
-helptext
Text for dynamic help. If empty, no help is available for this page. See also DynamicHelp.
-helptype
Type of dynamic help. Use balloon (the default for a NoteBook page) or variable. See also DynamicHelp.
-helpvar
Variable to use when -helptype option is variable. See also DynamicHelp.
[...]
Not quite the solution I was looking for but it is good enough. Create a label for the help text and bind the entry of the tab to the label
package require BWidget
# Creat a bar for help
grid [label .l1 -textvariable tabhelp -justify left] -sticky w -row 0
## create a notebook with 2 text panes
NoteBook .n
.n insert 0 tb1 -text "Tab 1"
.n insert 1 tb2 -text "Tab 2"
foreach panel {tb1 tb2} {
set pane [.n getframe $panel]
text $pane.t
pack $pane.t -fill both -expand 1
}
.n raise tb1
grid .n -sticky ew -row 1
DynamicHelp::add [.n getframe tb1] -text "The essence of silly\nsally silica"
DynamicHelp::add [.n getframe tb2] -text "acetyl sali cylic\nacid is aspirin"
# Add help on entry into the tabs
.n.c bind p:tb1 <Enter> {set tabhelp "Woody Woodpecker"}
.n.c bind p:tb1 <Leave> {set tabhelp ""}
.n.c bind p:tb2 <Enter> {set tabhelp "Aspirins are great"}
.n.c bind p:tb2 <Leave> {set tabhelp ""}
I am beginner with running a tcl/tk script. In my script i have created a popup window to select a file to open and then this file path is given to the source function. I was expecting this script to run stepwise but instead source function is running before i select any file. I also tried using vwait function. Unfortunately it is not running in the 1st run. But in the 2nd run script is working as desire. Can anybody help me to run this script?
destroy .buttons
toplevel .buttons -width 400 -height 100 -background red -relief ridge -borderwidth 8 -padx 10 -pady 10
wm title .buttons "Select a file containing nodes coordinates"
wm geometry .buttons 350x81
set count 0
proc add_button {title command} {
global count
button .buttons.$count -text $title -command $command
pack .buttons.$count -side top -pady 1 -padx 1 -fill x
incr count
}
set types { {{TCL Scripts} {.tcl}} }
add_button "File name" {set accept_button [tk_getOpenFile -filetypes $types]
puts "the path is: $accept_button"
destroy .buttons}
add_button "Exit" {destroy .buttons}
#puts above------------------------
#vwait [namespace which -variable accept_button]
#puts below-----------------------
source "$accept_button"
puts "the src is: $accept_button"
Looks like you are missing the idea of event-driving programming in Tk.
Lets try to find out what is going on in your script. When you run it, the only things are should be done: construct window with widgets for user and bind scripts to widgets events. That is all. After that program is doing nothing but waiting for users action. The command that you bind to a button does not evaluated instantly.
In you case, all work with selected file should be after user have chose it. You should run file reading from button's command. Try to run this script with tclsh
package require Tk
destroy .buttons
toplevel .buttons -width 400 -height 100 -background red -relief ridge -borderwidth 8 -padx 10 -pady 10
wm title .buttons "Select a file containing nodes coordinates"
wm geometry .buttons 350x81
set count 0
proc add_button {title command} {
global count
button .buttons.$count -text $title -command $command
pack .buttons.$count -side top -pady 1 -padx 1 -fill x
incr count
}
set types { {{TCL Scripts} {.tcl}} }
add_button "File name" {set accept_button [tk_getOpenFile -filetypes $types]
puts "the path is: $accept_button"
what_program_should_do_after_file_is_chosen $accept_button
destroy .buttons}
add_button "Exit" {destroy .buttons}
proc what_program_should_do_after_file_is_chosen {path} {
puts "You've chose file: $path"
}
vwait forever
i want "LED" kind of radio buttons placed next to each other.
I used this command to set the color and disabled the state.
radiobutton .field1 -disabledforeground green -state "disabled"
radiobutton .field2 -disabledforeground red -state "disabled"
radiobutton .field3 -disabledforeground green -state "disabled"
grid .field1 -row 0 -column 1
grid .field2 -row 0 -column 2
grid .field3 -row 0 -column 3
I want something like led kind of. Filling solid green color and turning off the indicator inside the radio button.
I tried "-indicatoron" setting to false. It doesnt work still.
My Application will look like this,
Code:
proc changeDisabledColor {w color} {
puts "gng inside"
$w configure -disabledforeground $color
}
set rowList [list "row1" "row2" "row3" "row4" "row5" "row6"]
set colList [list "1" "2" "3" "4" "5" "6"]
label .textNames -text "Description"
grid .textNames -row 0 -column 0
foreach temItem $colList {
label .field$temItem -text "col $temItem"
grid .field$temItem -row 0 -column $temItem
}
set rowIndex 1
foreach item $rowList {
set colIndex 0
label .$item -text "$item"
grid .$item -row $rowIndex -column $colIndex
foreach temCol $colList {
set frameId "frame_$item\_$temCol"
frame .$frameId -borderwidth 2 -relief ridge
grid .$frameId -row $rowIndex -column [expr $colIndex + 1]
radiobutton .$frameId.field1 -disabledforeground green -state "disabled"
radiobutton .$frameId.field2 -disabledforeground red -state "disabled"
radiobutton .$frameId.field3 -disabledforeground green -state "disabled"
grid .$frameId.field1 -row $rowIndex -column [expr $colIndex + 1]
grid .$frameId.field2 -row $rowIndex -column [expr $colIndex + 2]
grid .$frameId.field3 -row $rowIndex -column [expr $colIndex + 3]
incr colIndex
}
incr rowIndex
}
bind .frame_row3_2.field3 <Map> [list after 10000 {changeDisabledColor %W blue}]
Expected Output:
Is it possible to make radio button look like this?
Firstly, what you are trying to do is not portable. It will not work on all platforms, some of which override the way that radiobuttons look quite thoroughly. You'd be better off using labels and configuring the images in them. Except…
Secondly, it's looking like it will create a large number of widgets. That's usually an indication that you're not doing things the right way. Such as…
Thirdly, it's really not that difficult to use a canvas, and that gives you both efficiency and flexibility.
pack [canvas .c]
# Some helper procedures
proc makeClickableDot {x y bgVariable callback} {
upvar #0 $bgVariable background
set coords [list $x $y [expr {$x+10}] [expr {$y+10}]]
set id1 [.c create oval $coords -fill $background -outline grey75]
set id2 [.c create arc $coords -style arc -start 45 -extent 180 -outline black]
.c bind $id1 <1> $callback
.c bind $id2 <1> $callback
trace add variable background write [list clickableDotWrite $bgVariable $id1]
}
proc clickableDotWrite {bgVariable id args} {
upvar #0 $bgVariable background
.c itemconf $id -fill $background
}
# Now we can just make our variables and dots
set rowList [list "row1" "row2" "row3" "row4" "row5" "row6"]
set colList [list "1" "2" "3" "4" "5" "6"]
set Y 10
foreach row $rowList {
set X 10
foreach col $colList {
set cell($row,$col,1) green
# It's a dumbass callback!
makeClickableDot $X $Y cell($row,$col,1) [list set cell($row,$col,1) red]
incr X 15
set cell($row,$col,2) blue
makeClickableDot $X $Y cell($row,$col,2) [list set cell($row,$col,2) yellow]
incr X 15
set cell($row,$col,3) magenta
makeClickableDot $X $Y cell($row,$col,3) [list set cell($row,$col,3) cyan]
incr X 15
}
incr Y 15
}
OK, that's very colourful and you'll need a bit more work to tune it to how you want (I've not totally nailed the look, the callbacks are dumb and you probably need a second array to hold some sort of state) but it's the core of it all and all you need to do after setting it up is manipulate variables. The traces take care of reflecting the changes to those to the GUI. Which is nice, and how Tk is supposed to work most of the time.
I am new to tcl/tk programming. Here is a small code snippet on combo box. How can I dynamically add and remove values from the combo box?
set ff [ frame f]
set label [Label $ff.label -text "Name:" ]
set name [ComboBox $ff.name \
-editable yes \
-textvariable name]
set addButton [Button $ff.addButton -text "+" -width 1 -command {addNameToComboBox}]
set removeButton [Button $ff.removeButton -text "-" -width 1 -command removeNameFromComboBox}]
grid $ff.addButton -row 0 -column 2 -sticky w
grid $ff.removeButton -row 0 -column 3 -sticky sw -padx 5
proc addNameToComboBox {name} {
}
proc removeNameFromComboBox {name} {
}
Cheers!
Your example code has a few bugs (*), and it's not entirely clear what you want to do. Are you wanting to add the current value of the combobox to the dropdown list, or is the value you want to add coming from somewhere else?
Here's a solution that adds the current value of the combobox to the list. It uses the built-in versions of the combobox, label and button widgets. Whatever combobox widget you are using probably works similarly, though maybe not exactly.
(*) Button, Label and ComboBox aren't standard widgets -- did you mean "button", "label" and "ttk::combobox" or are you using some custom widgets?. Also, you forgot to use grid to manage the combobox and label, and your procs are expecting arguments but you aren't passing any in).
This solution works with tcl/tk 8.5 and the built-in ttk::combobox widget:
package require Tk 8.5
set ff [frame .f]
set label [label $ff.label -text "Name:" ]
set name [ttk::combobox $ff.name -textvariable name]
set addButton [button $ff.addButton -text "+" -width 1 \
-command [list addNameToComboBox $name]]
set removeButton [button $ff.removeButton -text "-" -width 1 \
-command [list removeNameFromComboBox $name]]
grid $label $name
grid $ff.addButton -row 0 -column 2 -sticky w
grid $ff.removeButton -row 0 -column 3 -sticky sw -padx 5
pack $ff -side top -fill both -expand true
proc addNameToComboBox {name} {
set values [$name cget -values]
set current_value [$name get]
if {$current_value ni $values} {
lappend values $current_value
$name configure -values $values
}
}
proc removeNameFromComboBox {name} {
set values [$name cget -values]
set current_value [$name get]
if {$current_value in $values} {
set i [lsearch -exact $values $current_value]
set values [lreplace $values $i $i]
$name configure -values $values
}
}
Pursuant to the advice given in this question I have written a little gui to take the options for a command line C program and pass them on to said C program which is already set up to process them. It displays just like I wanted.
However, I would like to verify that the values stored in the variables are correct. Getting the values to print out is giving me a lot of grief (I can't test in vivo right now due to some hardware issues). What am I missing?
Prepending the variable name with '$' gives me '$variableName' rather than the value of the variable.
Adding these variables to an array and calling array get arr is supposed to print the index and the array value; I get variable names.
I tried pathName cget option, but apparently -value isn't an option, and leaving off the option doesn't give me a list of valid options.
Here's all the code with the various things that didn't work (from option #1, which is the most straightforward way; the others were just me trying workarounds). They all produce
errors along the lines of: "can't read "::": no such variable" or "can't read
"colorimetric": no such variable".
#!/opt/ActiveTcl-8.5/bin/wish8.5
wm title . "Gretag"
ttk::frame .f -borderwidth 5 -relief sunken -padding "5 10"
# next line part of the "puts" tests at the bottom
global colorimetric
ttk::label .f.dataLabel -text "Data Type"
ttk::label .f.colorimetricLabel -text "Colorimetric"
ttk::checkbutton .f.colorimetric -onvalue "-c" -offvalue "" -command getFilename1
ttk::label .f.spectralLabel -text "Spectral"
ttk::checkbutton .f.spectral -onvalue "-s" -offvalue "" -command getFilename2
ttk::label .f.gretagNumLabel -text "Gretag #"
ttk::label .f.gretagLabel0 -text "1"
ttk::radiobutton .f.gretagRadio0 -variable gretagNum -value "/dev/ttyS0"
ttk::label .f.gretagLabel1 -text "2"
ttk::radiobutton .f.gretagRadio1 -variable gretagNum -value "/dev/ttyS1"
ttk::label .f.gretagLabel2 -text "3"
ttk::radiobutton .f.gretagRadio2 -variable gretagNum -value "/dev/ttyS2"
ttk::label .f.gretagLabel3 -text "4"
ttk::radiobutton .f.gretagRadio3 -variable gretagNum -value "/dev/ttyS3"
ttk::label .f.gretagLabel4 -text "5"
ttk::radiobutton .f.gretagRadio4 -variable gretagNum -value "/dev/ttyS4"
ttk::label .f.sampleSize -text "Sample Size"
ttk::label .f.samplex -text "X"
ttk::label .f.sampley -text "Y"
ttk::entry .f.x -textvariable x -width 5
ttk::entry .f.y -textvariable y -width 5
ttk::label .f.filterLabel -text "Filter Type"
ttk::label .f.filterLabel0 -text "D50"
ttk::radiobutton .f.filterRadio0 -variable filter -value "-d50"
ttk::label .f.filterLabel1 -text "D65"
ttk::radiobutton .f.filterRadio1 -variable filter -value "-d65"
ttk::label .f.filterLabel2 -text "Unfiltered"
ttk::radiobutton .f.filterRadio2 -variable filter -value "-U"
ttk::label .f.filterLabel3 -text "Polarized"
ttk::radiobutton .f.filterRadio3 -variable filter -value "-p"
ttk::label .f.baudLabel -text "Baud Rate"
ttk::label .f.baudLabel0 -text "4800"
ttk::radiobutton .f.baudRadio0 -variable baud -value "B4800"
ttk::label .f.baudLabel1 -text "9600"
ttk::radiobutton .f.baudRadio1 -variable baud -value "B9600"
ttk::label .f.baudLabel2 -text "19200"
ttk::radiobutton .f.baudRadio2 -variable baud -value "B19200"
ttk::label .f.baudLabel3 -text "38400"
ttk::radiobutton .f.baudRadio3 -variable baud -value "B38400"
ttk::label .f.baudLabel4 -text "57600"
ttk::radiobutton .f.baudRadio4 -variable baud -value "B57600"
ttk::button .f.submitBtn -text "Submit" -command finish
grid columnconfigure . 0 -weight 1
grid rowconfigure . 0 -weight 1
grid .f -column 0 -row 0 -columnspan 11 -rowspan 5
grid .f.dataLabel -column 0 -row 0 -sticky we
grid .f.colorimetricLabel -column 1 -row 0 -sticky e
grid .f.colorimetric -column 2 -row 0 -sticky w
grid .f.spectralLabel -column 3 -row 0 -sticky e
grid .f.spectral -column 4 -row 0 -sticky w
grid .f.gretagNumLabel -column 0 -row 1 -sticky we
grid .f.gretagLabel0 -column 1 -row 1 -sticky e
grid .f.gretagRadio0 -column 2 -row 1 -sticky w
grid .f.gretagLabel1 -column 3 -row 1 -sticky e
grid .f.gretagRadio1 -column 4 -row 1 -sticky w
grid .f.gretagLabel2 -column 5 -row 1 -sticky e
grid .f.gretagRadio2 -column 6 -row 1 -sticky w
grid .f.gretagLabel3 -column 7 -row 1 -sticky e
grid .f.gretagRadio3 -column 8 -row 1 -sticky w
grid .f.gretagLabel4 -column 9 -row 1 -sticky e
grid .f.gretagRadio4 -column 10 -row 1 -sticky w
grid .f.sampleSize -column 0 -row 2 -sticky we
grid .f.samplex -column 1 -row 2 -sticky e
grid .f.x -column 2 -row 2 -sticky w
grid .f.sampley -column 3 -row 2 -sticky e
grid .f.y -column 4 -row 2 -sticky w
grid .f.filterLabel -column 0 -row 3 -sticky we
grid .f.filterLabel0 -column 1 -row 3 -sticky e
grid .f.filterRadio0 -column 2 -row 3 -sticky w
grid .f.filterLabel1 -column 3 -row 3 -sticky e
grid .f.filterRadio1 -column 4 -row 3 -sticky w
grid .f.filterLabel2 -column 5 -row 3 -sticky e
grid .f.filterRadio2 -column 6 -row 3 -sticky w
grid .f.filterLabel3 -column 7 -row 3 -sticky e
grid .f.filterRadio3 -column 8 -row 3 -sticky w
grid .f.baudLabel -column 0 -row 4 -sticky we
grid .f.baudLabel0 -column 1 -row 4 -sticky e
grid .f.baudRadio0 -column 2 -row 4 -sticky w
grid .f.baudLabel1 -column 3 -row 4 -sticky e
grid .f.baudRadio1 -column 4 -row 4 -sticky w
grid .f.baudLabel2 -column 5 -row 4 -sticky e
grid .f.baudRadio2 -column 6 -row 4 -sticky w
grid .f.baudLabel3 -column 7 -row 4 -sticky e
grid .f.baudRadio3 -column 8 -row 4 -sticky w
grid .f.baudLabel4 -column 9 -row 4 -sticky e
grid .f.baudRadio4 -column 10 -row 4 -sticky w
grid .f.submitBtn -column 1 -row 5 -columnspan 7 -sticky we
foreach w [winfo children .f] {grid configure $w -padx 5 -pady 5}
focus .f.colorimetric
.f.colorimetric state selected
.f.filterRadio1 state selected
.f.baudRadio1 state selected
bind . <Return> {finish}
proc getFilename1 {} {
set filename1 [tk_getSaveFile]
}
proc getFilename2 {} {
set filename2 [tk_getSaveFile]
}
proc finish {} {
.f.x insert 0 "-x"
.f.y insert 0 "-y"
# Pick one
# puts $colorimetric
# puts colorimetric
# puts "$colorimetric"
# puts $::colorimetric
# puts .f.colorimetric
# puts $.f.colorimetric
# puts $::.f.colorimetric
# puts "$::colorimetric"
exec ./gretag .f.colorimetric filename1 .f.spectral filename2 .f.gretagNum .f.x .f.y .f.filter .f.baud
}
Edit:
I've posted all the code rather than just part, and in the next to last line are the various syntaxes from option #1 that I've tried in order to view the values of the variables before they're passed to the next program. None of these are working and I don't understand why or how to fix it. I'm hoping another set of eyes will catch what's wrong.
Variable Basics
As others have pointed out, the confusing to $ or not to $ notation can be simplified by the following rule.
var is a reference to the variable itself, not its value
$var yields the value held in the variable
It can become a little more confusing when you start to think of everything in Tcl as a string (it's really not, but close enough), so you can store the name of one variable in another and restore its value by reference.
% set foo "hi"
hi
% set bar "foo"
foo
% set $foo
can't read "hi": no such variable
% set $bar
hi
Here the notation set $foo is evaluated in step - first $foo yields its value hi and then the set expression (when run with no third argument) attempts to return the value held in the variable hi. This fails. The notation set $bar takes the same steps but this time set can operate on the value of bar, which is foo, and thus returns the value of foo which is hi. (link to "set" API)
Initialization
One problem you have in this script is initialization. In Tcl variables don't exist until they're assigned a value. That's clearly why trying to set $foo above didn't work, because there was no variable hi.
At the top of your script you attempt to declare a variable with,
global colorimetric
which doesn't work, because you are already operating in global scope. Global "has no effect unless executed in the context of a proc body." (link to "global" API) You actually have to use a set command to initialize the variable. This is why none of your attempts to print colorimetric in proc finish worked.
Scope
The other problem you have in this script is scope, particularly with mixing global and procedural/local scope. You're correct that, had you initialized colorimetric correctly then the code,
puts $::colorimetric ;# print the value of the global variable colorimetric
would have worked. Another way to achieve this is with,
global colorimetric ;# reference a global variable into the local scope
puts $colorimetric ;# print the value of colorimetric in the local scope
My Solution
I'd like to present my solution. I admit that I've moved a lot of code around, and I will go into a short explanation of what changes I implemented to make it more concise.
#!/usr/bin/env wish
# --- default configuration --- #
array set CONF {
colorimetric "-c"
spectral ""
cfilename "/path/to/defaultCI.txt"
sfilename ""
x 0
y 0
gretagnum "/dev/ttyS0"
filter "-d65"
baud "B9600"
}
# --- build the interface --- #
wm title . "Gretag"
ttk::frame .f -borderwidth 5 -relief sunken -padding "5 10"
grid columnconfigure . 0 -weight 1
grid rowconfigure . 0 -weight 1
grid .f
ttk::label .f.dataLabel -text "Data Type: "
foreach {dtname dttag dtfile} {
colorimetric "-c" cfilename
spectral "-s" sfilename
} {
lappend mygrid [
ttk::checkbutton .f.$dtname -text [string totitle $dtname] \
-variable CONF($dtname) -onvalue $dttag -offvalue "" \
-command [list getFilename $dtname $dttag $dtfile ]
]
}
grid .f.dataLabel {*}$mygrid -sticky w ; set mygrid { }
ttk::label .f.gretagNumLabel -text "Gretag #: "
for {set tty 0} {$tty < 5} {incr tty} {
lappend mygrid [
ttk::radiobutton .f.gretagRadio$tty -text [expr $tty + 1] \
-variable CONF(gretagnum) -value "/dev/ttyS$tty"
]
}
grid .f.gretagNumLabel {*}$mygrid -sticky w ; set mygrid { }
ttk::label .f.sampleSize -text "Sample Size: "
ttk::label .f.samplex -text "X"
ttk::label .f.sampley -text "Y"
ttk::entry .f.x -textvariable CONF(x) -width 5
ttk::entry .f.y -textvariable CONF(x) -width 5
grid .f.sampleSize .f.samplex .f.x .f.sampley .f.y
ttk::label .f.filterLabel -text "Filter Type: "
foreach {ftname ftval} {
D50 "-d50"
D65 "-d65"
Unfiltered "-U"
Polarized "-P"
} {
lappend mygrid [
ttk::radiobutton .f.filterRadio$ftname -text $ftname \
-variable CONF(filter) -value $ftval
]
}
grid .f.filterLabel {*}$mygrid -sticky w ; set mygrid { }
ttk::label .f.baudLabel -text "Baud Rate: "
foreach {baud} {
4800 9600 19200 38400 57600
} {
lappend mygrid [
ttk::radiobutton .f.baudRadio$baud -text $baud \
-variable CONF(baud) -value "B$baud"
]
}
grid .f.baudLabel {*}$mygrid -sticky w ; set mygrid { }
ttk::button .f.submitBtn -text "Submit" -command submit
grid .f.submitBtn -columnspan 6 -sticky we
foreach w [winfo children .f] {
grid configure $w -padx 5 -pady 5
}
focus .f.colorimetric
bind . <Return> submit
# --- callbacks --- #
proc getFilename {type tag file} {
global CONF
if {$CONF($type) eq $tag} {
set CONF($file) [tk_getOpenFile]
if {$CONF($file) eq ""} { .f.$type invoke }
} else {
set CONF($file) ""
}
}
proc submit { } {
global CONF
exec ./gretag $CONF(colorimetric) $CONF(cfilename) \
$CONF(spectral) $CONF(sfilename) $CONF(gretagnum) \
$CONF(x) $CONF(y) $CONF(filter) $CONF(baud)
}
Discussion of Changes
1. The first changes I made were to use the -text options on the ttk::checkbutton and ttk::radiobutton. Granted, using an extra label for these allows you to place the text before the button, but doing so is non-standard and requires more code.
ttk::label .f.colorimetricLabel -text "Colorimetric"
ttk::checkbutton .f.colorimetric -onvalue "-c" -offvalue "" -command getFilename1
becomes
ttk::checkbutton .f.colorimetric -text "Colorimetric" -onvalue "-c" -offvalue "" -command getFilename1
2. Next I used the similarities between these two checkbuttons to abstract the creation into a foreach. (I do this all the time in my Tcl code for work.) This generates much easier code to read and allows you to add/remove/swap names and tags for the widgets. It results in slightly more but much more versitile code.
ttk::checkbutton .f.colorimetric -text "Colorimetric" -onvalue "-c" -offvalue "" -command getFilename1
ttk::checkbutton .f.colorimetric -text "Spectral" -onvalue "-s" -offvalue "" -command getFilename2
becomes
foreach {dtname dttag dtcommand} {
colorimetric "-c" getFilename1
spectral "-s" getFilename2
} {
ttk::checkbutton .f.$dtname -text [string totitle $dtname] -onvalue $dttag -offvalue "" -command $dtcommand
}
3. The next change was to merge your getFilename1 and getFilename2 into a single getFilename procedure. We can pass arguments into this function to determine who is calling it. I use the list command to generate the call for this new function. (link to "list" API)
I also started to combine your grid commands into the widget code itself. Here mygrid keeps a list of what needs to be gridded per line in the GUI and then is evaluated at the end of each section to propagate the GUI on the fly. (link to "grid" API)
The previous code gets its final revision and becomes,
foreach {dtname dttag dtfile} {
colorimetric "-c" cfilename
spectral "-s" sfilename
} {
lappend mygrid [
ttk::checkbutton .f.$dtname -text [string totitle $dtname] -variable CONF($dtname) -onvalue $dttag -offvalue "" -command [list getFilename $dtname $dttag $dtfile ]
]
}
Then the grid command can be evaluated and the mygrid variable cleared after every use!
4. If you've been paying attention I also added a -variable option to your ttk::checkbutton and at this point started storing the button state in a global variable CONF. This is a big change.
Tk loves to pollute your global namespace and it's good practice to fight back. I usually put all of my configuration state in a global array, and set that right up top of the code so that anyone can come in and change the default state of my code, without digging into it or doing search/replace calls or anything like that. Just good practice, so wherever you had a variable I moved it into CONF and moved CONF up top.
array set CONF {
colorimetric "-c"
spectral ""
cfilename "/path/to/defaultCI.txt"
sfilename ""
x 0
y 0
gretagnum "/dev/ttyS0"
filter "-d65"
baud "B9600"
}
5. Next I propagated these changes throughout your code. Almost all of the widget creation was susceptible to these revisions. With respect to the widget creation this sometimes made independent code sections larger. But it also allowed me to remove your entire grid section, merging this code up into the widget code as I've discussed, greatly decreasing the size and clutter of your code at the added expense of complexity.
6. The final changes I made were to your function code. You have a couple of minor bugs in your getFilename1 and getFilename2 code. The first bug was that you want to call tk_getOpenFile because I gather you are only grabbing an existing file name to pass it to gretag. (link to 'tk_getOpenFile' API) If you use tk_getOpenFile the dialog will make sure the file exists.
The second bug in getFilename1 is that the dialog has a Cancel button, and if the user clicks this cancel button the dialog returns an empty string. In this case you have to un-check the ttk::checkbutton and you have to unset the CONF(colorimetric) variable. Or more correctly you have to set CONF(colorimetric) to the button's -offvalue. You can do both of these at once by sending a click event to the current button.
proc getFilename1 {} {
set filename1 [tk_getSaveFile]
}
becomes
proc getFilename {type tag file} {
global CONF
if {$CONF($type) eq $tag} {
set CONF($file) [tk_getOpenFile]
if {$CONF($file) eq ""} { .f.$type invoke }
} else {
set CONF($file) ""
}
}
In your finish function I renamed the function to submit (sorry) and rewrote it to make use of the new CONF variable.
The Answer
Of course most of this was unnecessary. I wanted to give you some interesting Tcl/Tk code to think about while at the same time solving your problem. At this point we should have the vocabulary to answer your question, though.
The reason your variables weren't printing out was because of initialization and scope. You should always use a -variable or -textvariable on widgets that you need to reference later. I generally initialize my referenced variables before building their containing widgets. So at the top of your file if you had done,
set colorimetric "-c"
ttk::checkbutton .f.colorimetric -variable colorimetric [...]
Then you would have been able to do, in the finish function,
puts $::colorimetric
You have not assigned any variable to the colorimetric checkbutton.
Add -variable colorimetric to the checkbutton, and then in finish
you can use:
puts $::colorimetric
Also, set ::colorimetric first to select your default value. That
is easier than trying to mess with the state of the widget.
I see that the values colorimetric can have are "" and "-c" so
I assume you will use that value in the exec line.
Beware that [exec something yada $::colorimetric something] will
probably not work then. You'll probably need {*}$::colorimetric in the
exec line to make the argument disappear if it is empty.
Here's a little tcl snippet - run from tclsh or wish
[nigel#rose ~]$ wish
% set foo /dev/ttys0
/dev/ttys0
% puts $foo
/dev/ttys0
% puts "$foo"
/dev/ttys0
% puts [$foo]
invalid command name "/dev/ttys0"
% puts ($foo)
(/dev/ttys0)
% puts {$foo}
$foo
%
Quoting in Tcl:
"" (double quotes): Evaluate substitutions ($variable)
{} {Squiggly brackets): Treat the entire string as a literal with no substitution
[] (Square brackets): Execute the string as a command with substitution
As an alternative you could pop up the diagnostic in a dialog box:
% set mb [tk_messageBox -message "Port is $foo" -type ok -icon info]
ok
%
At your "# Just here" comment, try adding
puts $::gretagNum
:: signifies a global variable, and the -variable option to widgets
are always global.
I'm not sure what you want to do, put if you end put printing the variable name and not the variable content, use the set command as function:
set content "hello"
set blah content
if you do:
puts $blah
.. you get the content of the blah variable, which is content.
To get the content of the variable content via blah, use the following:
puts [set $blah]
Just remember this rule and you will always get it right:
$foo is shorthand for [set foo]
Try rewriting your code with [set foo] and it will work.
In particular,
$$foo ;# not what you think
is replaced by
[set [set foo]] ;# does what you think