I am using ttk:notebook for creating frames.
Attaching children's to these slaves, but it didn't resize properly, when listbox widget gets created.
I am using following code:
ttk::notebook .top.d -width 880 -height 600 -padding 5
ttk::frame .top.d.f1;
ttk::frame .top.d.f2;
.top.d add .top.d.f2 -text "Memory Characterization" -padding 5
.top.d add .top.d.f1 -text "Standard cells Characterization" -padding 5
When more widgets are added they hide, until i have to manually resize it.
As Jerry said, what did you expect, when giving a width and height?
Maybe your confusion comes from the width resizing when adding notebook tabs, but this is by intention, because otherwise you cannot see all configured tabs. Unfortunately there is no standard code for scrolling tab headers.
The following code shows the effect:
#!/usr/bin/env wish
set conf(width) 200
set conf(height) 100
ttk::button .b1 -command addNewPage -text "Add"
ttk::button .b2 -command toggleSize -text "Toggle Size"
ttk::notebook .d -width 200 -height 100 -padding 5
grid .b1 .b2
grid .d - -sticky eswn
grid columnconfigure . all -weight 1
grid rowconfigure . 2 -weight 1
set numpages 0
set pages [dict create \
.d.f1 "Memory Characterization" \
.d.f2 "Standard cells Characterization" \
.d.f3 "Just another long title" \
.d.f4 "Hope this is long enough"]
proc addNewPage {} {
variable pages
variable numpages
if {$numpages < [dict size $pages]} {
set w [lindex [dict keys $pages] ${numpages}]
ttk::frame $w
set title [dict get $pages $w]
.d add $w -text $title -padding 5
addChildren $w
incr numpages
if {$numpages >= [dict size $pages]} {
.b configure -state disabled
}
}
}
proc addChildren {w} {
for {set i 1} {$i < 9} {incr i} {
for {set j 1} {$j < 9} {incr j} {
grid [ttk::button $w.b$i$j -text "Button $i:$j"] -row $i -column $j -padx 5 -pady 5
}
}
}
proc toggleSize {} {
variable conf
if {[.d cget -width] == $conf(width)} {
set width 0
set height 0
} else {
set width $conf(width)
set height $conf(height)
}
.d configure -width $width -height $height
}
I would recommend to use relative placement of child widgets w.r.t your notebook by using
Place geometry manager
Related
Currently:
Before execution (fig. 1)
after execution (fig. 2)
I am poor at tcl/tk. But nowadays I am studying tcl/tk for my work. I want to make GUI like figures. figure 1 is before clicking buttons. If I click right-side button and select files, the file names appear in the button text. I want to position these names in the middle-side entry region and want to use these file names as global variables. Here is my code. Could anyone help me?
#-------------------------------------------------------------------------
namespace eval ::dyna::partupdate {
variable p_mainWin ".partupdate";
variable str_curDir [file dirname [info script]];
variable str_basefile "";
variable str_appendfile "";
variable str_spotweldfile "";
variable str_outputfile "";
}
set types {
{"LS-DYNA Files" {.key .k .dyn .d } }
{"IGES Files" {.iges .igs } }
{"MCF Files" {.mcf } }
{"All files" *}
}
##############################################################################
##### Procedure Name: ::dyna::partupdate::CreateGUI
##### Functionality: creates the main window for file selection
##############################################################################
proc ::dyna::partupdate::CreateGUI {} {
variable p_mainWin;
destroy $p_mainWin;
set base [ toplevel $p_mainWin];
wm title $base {Update FE Model};
wm resizable $base 1 1;
set frm_main [frame $base.frm_main];
pack $frm_main -side top -anchor nw -padx 0 -pady 0;
set frm_fileselect [frame $frm_main.frm_fileselect -bd 0 -relief groove];
set frm_create [frame $frm_main.frm_create -bd 0 -relief groove]
# pack $frm_create -side right -anchor ne -padx 0 -pady 4;
grid $frm_fileselect -row 0 -padx 1 -pady 4 -sticky nw;
grid $frm_create -row 3 -padx 1 -pady 4 -sticky ne;
# set frm_create [frame $frm_main.frm_create -bd 0 -relief groove]
# pack $frm_create -side right -anchor ne -padx 0 -pady 4;
# UI for base file
set lbl_basefile [label $frm_fileselect.lbl_basefileName -text "Base File"];
set ent_basefile [entry $frm_fileselect.ent_basefileName -width 30 \
-textvariable "::dyna::partupdate::str_basefile" -state disabled];
set btn_basefile [button $frm_fileselect.btn_basefile -text " ... " \
-command "::dyna::partupdate::onSelect $frm_fileselect.btn_basefile" ]
grid $lbl_basefile -row 0 -col 0 -padx 5 -pady 7 -sticky nw;
grid $ent_basefile -row 0 -col 1 -padx 5 -pady 7 -sticky nw;
grid $btn_basefile -row 0 -col 2 -padx 0 -pady 6 -sticky nw;
# UI for appended file
set lbl_appendfile [label $frm_fileselect.lbl_appendfileName -text "Appended File"];
set ent_appendfile [entry $frm_fileselect.ent_appendfileName -width 30 \
-textvariable "::dyna::partupdate::str_appendfile" -state disabled];
set btn_appendfile [button $frm_fileselect.btn_appendfile -text " ... " \
-command "::dyna::partupdate::onSelect $frm_fileselect.btn_appendfile" ]
grid $lbl_appendfile -row 1 -col 0 -padx 5 -pady 2 -sticky nw;
grid $ent_appendfile -row 1 -col 1 -padx 5 -pady 2 -sticky nw;
grid $btn_appendfile -row 1 -col 2 -padx 0 -pady 6 -sticky nw;
# UI for spotweld file
set lbl_spotweldfile [label $frm_fileselect.lbl_spotweldfileName -text "Spotweld File"];
set ent_spotweldfile [entry $frm_fileselect.ent_spotweldfileName -width 30 \
-textvariable "::dyna::partupdate::str_spotweldfile" -state disabled];
set btn_spotweldfile [button $frm_fileselect.btn_spotweldfile -text " ... " \
-command "::dyna::partupdate::onSelect $frm_fileselect.btn_spotweldfile" ]
grid $lbl_spotweldfile -row 2 -col 0 -padx 5 -pady 2 -sticky nw;
grid $ent_spotweldfile -row 2 -col 1 -padx 5 -pady 2 -sticky nw;
grid $btn_spotweldfile -row 2 -col 2 -padx 0 -pady 6 -sticky nw;
# UI for output file
set lbl_outputfile [label $frm_fileselect.lbl_outputfileName -text "Output File"];
set ent_outputfile [entry $frm_fileselect.ent_outputfileName -width 30 \
-textvariable "::dyna::partupdate::str_outputfile" -state disabled];
set btn_outputfile [button $frm_fileselect.btn_outputfile -text " ... " \
-command "::dyna::partupdate::saveAs $frm_fileselect.btn_outputfile" ]
grid $lbl_outputfile -row 3 -col 0 -padx 5 -pady 2 -sticky nw;
grid $ent_outputfile -row 3 -col 1 -padx 5 -pady 2 -sticky nw;
grid $btn_outputfile -row 3 -col 2 -padx 0 -pady 6 -sticky nw;
set btn_update [hwt::CanvasButton $frm_create.btn_update \
[::hwt::DluWidth 40] [::hwt::DluHeight 14] \
-command "::dyna::partupdate::uPDATE" \
-text "Update" ]
set btn_close [hwt::CanvasButton $frm_create.btn_close \
[::hwt::DluWidth 40] [::hwt::DluHeight 14] \
-command "::dyna::partupdate::CloseWindow" \
-text "Close" ]
pack $btn_update -anchor ne -padx 5 -pady 5 -side left;
pack $btn_close -anchor ne -padx 5 -pady 5 -side left;
}
proc ::dyna::partupdate::onSelect { label } {
global types
set file [tk_getOpenFile -filetypes $types -parent .]
$label configure -text $file
}
proc ::dyna::partupdate::saveAs { label } {
global types
set file [tk_getSaveFile -filetypes $types -parent . -initialdir .]
$label configure -text $file
}
proc ::dyna::partupdate::uPDATE { args } {
variable str_basefile;
variable str_appendfile;
variable str_spotweldfile;
variable str_outputfile;
set executable C:\CENSor\\CENSor.exe
# base file name should not be empty
if {$str_basefile == ""} {
tk_messageBox -message "Please select an base file." -title "aaa" \
-type ok -icon info;
return;
}
# append file name should not be empty
if {$str_appendfile == ""} {
tk_messageBox -message "Please select an appended file." -title "aaa" \
-type ok -icon info;
return;
}
# execution case
if {$str_spotweldfile == ""} {
exec $executable -e 0 $str_outputfile $str_basefile $str_appendfile
}
else {
exec $executable -e 0 $str_outputfile $str_basefile $str_appendfile $str_spotweldfile
}
}
proc ::dyna::partupdate::CloseWindow { args } {
variable p_mainWin;
set windowPath [lindex $args 0];
if {[winfo exists $p_mainWin]} {
destroy $p_mainWin
}
}
# ----- bring up the main gui --------
::dyna::partupdate::CreateGUI;
For the first one, this line:
set btn_basefile [button $frm_fileselect.btn_basefile -text " ... " \
-command "::dyna::partupdate::onSelect $frm_fileselect.btn_basefile" ]
will execute this proc:
proc ::dyna::partupdate::onSelect { label } {
global types
set file [tk_getOpenFile -filetypes $types -parent .]
$label configure -text $file
}
The first line above will update the widget $frm_fileselect.btn_basefile which is the button, when onSelect is executed. You will first need to change the first line to modify the entry box, like so:
set btn_basefile [button $frm_fileselect.btn_basefile -text " ... " \
-command "::dyna::partupdate::onSelect $frm_fileselect.ent_basefile" ]
Then change the proc so that it is able to edit the entry text (entries don't have a -text option, you have to insert. Usually it's better to delete everything just in case)
proc ::dyna::partupdate::onSelect { label } {
global types
set file [tk_getOpenFile -filetypes $types -parent .]
$label configure -state normal ;# makes the entry normal to allow editing
$label delete 0 end ;# delete everything
$label insert end $file ;# insert the text
$label configure -state disabled ;# disable the entry again
}
Then you will have to modify the remaining 3 buttons similarly:
set btn_appendfile [button $frm_fileselect.btn_appendfile -text " ... " \
-command "::dyna::partupdate::onSelect $frm_fileselect.ent_appendfile" ]
set btn_spotweldfile [button $frm_fileselect.btn_spotweldfile -text " ... " \
-command "::dyna::partupdate::onSelect $frm_fileselect.ent_spotweldfile" ]
set btn_outputfile [button $frm_fileselect.btn_outputfile -text " ... " \
-command "::dyna::partupdate::saveAs $frm_fileselect.ent_outputfile" ]
manual for entry widget
As for the last part, you don't really need them to be global. You can use widget get, for example:
set filename [.partupdate.frm_main.frm_fileselect.ent_basefile get]
Will give you the text in the Base File entry (of course, if you have the widget path in a variable, it'll be easier)
set filename [.partupdate.frm_main.frm_fileselect.ent_spotweldfile get]
Will give you the one for Spotweld File, and so on.
Sidenote: I would probably rename the variable in onSelect from label to entry.
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 have a problem with my display of multiple choice questions. I have a frame which shows the questions and choices above a text widget which shows if the chosen answer is correct. Yet I want to hide the text while the test is not finished.
It looks like that:
My procedures are following:
proc beginTest { number } {
startTest
.frq.txt configure -state normal
.frq.txt delete 1.0 end
set score 0
set save 0
set path Files/Tutorials/$::Tuto
set numbers { 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 }
for {set i 1} {$i<=10} {incr i} {
if { $::stop == 1 } {
set answer [tk_dialog .dialog "Quit test?" "If you quit the test now, your answers will be lost. Do you want to continue?" \
question 1 "Continue test" "Quit test"]
if {$answer == 0} {
continue
} else {
break
}
} else {
set ind [expr {int(rand()*[llength $numbers])} ]
incr score [displayQuestion $path [lindex $numbers $ind] $i 10]
set numbers [lreplace $numbers $ind $ind]
}
}
.frq.txt insert end "Your score: $score/10"
.frq.txt configure -state disabled
if {[info exist user]} {
if {[lindex $::testScores $number]== "Not Taken" || [lindex $::testScores $number] < $score} {
set ::testScores [lreplace $::testScores $number $number $score]
}
}
destroy .frq.fr2
}
The following procedure called at the first line of the previous one create and define the windows, frames, text zone, etc.
proc startTest {} {
destroy .fr
#window definition
toplevel .frq
wm title .frq "Test"
wm geometry .frq 740x670+0+0
.frq configure -bg $::bgColour
# title of section
label .frq.titl
.frq.titl configure -font "arial 20" -pady 10
grid .frq.titl -column 0 -row 0 -sticky swe
.frq.titl configure -background "White"
# define the main text zone
text .frq.txt -wrap word -yscroll {.frq.vscroll set} -highlightthickness 0
.frq.txt configure -background "White" ;#"slate gray" to debug
scrollbar .frq.vscroll -orient vertical -command {.frq.txt yview}
grid .frq.txt -column 0 -row 1 -sticky snwe
grid rowconfigure .frq 1 -weight 1
grid columnconfigure .frq 0 -weight 1
grid .frq.vscroll -column 1 -row 1 -sticky snwe
.frq.txt tag configure center -justify center
.frq.txt configure -font "times 12" -state disabled
.frq.vscroll configure -orient vertical -command {.frq.txt yview}
grid .frq.txt -column 0 -row 1 -sticky snwe
.frq.txt configure -state normal
.frq.txt delete 1.0 end
#text styles
.frq.txt tag configure Normal -font "times 12"
.frq.txt tag configure subTitle -font "times 14"
.frq.txt tag configure Titlec -font "times 16" -justify "center"
.frq.txt tag configure subTitlec -font "times 14" -justify "center"
.frq.txt tag configure subTitlecu -font "times 14" -justify "center" -underline on
.frq.txt tag configure Titlecu -font "times 16" -justify "center" -underline on
.frq.txt tag configure Title -font "times 16"
.frq.txt tag configure link -foreground blue -font "times 12"
.frq.txt tag configure right -foreground "forest green"
.frq.txt tag configure wrong -foreground red
.frq.txt tag configure enhance -background "light goldenrod"
.frq.txt tag configure rightenhance -background "light goldenrod" -foreground "forest green"
.frq.txt tag bind link <Enter> ".fr.txt configure -cursor hand1"
.frq.txt tag bind link <Leave> ".fr.txt configure -cursor arrow"
#questions frame
frame .frq.fr2 -background white
grid .frq.fr2 -row 1
label .frq.lbl -relief flat -font arial -text "Question 1 of 5"
grid .frq.lbl -row 0
text .frq.fr2.txt -relief flat -background white -font "times 13" -wrap word
grid .frq.fr2.txt -columnspan 2 -row 1
.frq.fr2.txt tag configure center -justify center
grid rowconfigure .frq 1 -weight 1
checkbutton .frq.fr2.cb1 -command "choose A" -cursor hand1
grid .frq.fr2.cb1 -column 0 -row 2
label .frq.fr2.lblA -background white -font "arial 12" -pady 3
bind .frq.fr2.lblA <ButtonRelease> "choose A; .frq.fr2.cb1 toggle"
grid .frq.fr2.lblA -column 1 -row 2 -sticky w
checkbutton .frq.fr2.cb2 -command "choose B" -cursor hand1
grid .frq.fr2.cb2 -column 0 -row 3
label .frq.fr2.lblB -background white -font "arial 12" -pady 3
bind .frq.fr2.lblB <ButtonRelease> "choose B; .frq.fr2.cb2 toggle"
grid .frq.fr2.lblB -column 1 -row 3 -sticky w
checkbutton .frq.fr2.cb3 -command "choose C" -cursor hand1
grid .frq.fr2.cb3 -column 0 -row 4
label .frq.fr2.lblC -background white -font "arial 12" -pady 3
bind .frq.fr2.lblC <ButtonRelease> "choose C; .frq.fr2.cb3 toggle"
grid .frq.fr2.lblC -column 1 -row 4 -sticky w
checkbutton .frq.fr2.cb4 -command "choose D" -cursor hand1
grid .frq.fr2.cb4 -column 0 -row 5
label .frq.fr2.lblD -background white -font "arial 12" -pady 3
bind .frq.fr2.lblD <ButtonRelease> "choose D; .frq.fr2.cb4 toggle"
grid .frq.fr2.lblD -column 1 -row 5 -sticky w
frame .frq.bar
grid .frq.bar -row 2
button .frq.bar.next -text "Next question >>" -state disabled -pady 5 -borderwidth 0 -command "set ::goOn 1"
pack .frq.bar.next -padx 5 -pady 5 -side right -fill none
button .frq.bar.dp -text "Open drawing pad" -pady 5 -borderwidth 0 -command notepad
pack .frq.bar.dp -padx 5 -pady 5 -side right -fill none
button .frq.bar.calc -text "Open calculator" -pady 5 -borderwidth 0 -command calculator
pack .frq.bar.calc -padx 5 -pady 5 -side right -fill none
button .frq.bar.quit -text "Quit test" -pady 5 -borderwidth 0 -command "set ::stop 1; set ::goOn 1"
pack .frq.bar.quit -padx 5 -pady 5 -side right -fill none
}
And finally, the procedure which display the question:
proc displayQuestion {path filename ind maxind} {
set fd [open $path/$filename r]
set questionFile [split [read $fd] "\n"]
set ::goOn 0
set answers [list]
set imgFlag 0
set fd [open $path/answers/$filename r]
set goodAnswer [read $fd]
close $fd
.frq.lbl configure -text "Question $ind of $maxind"
.frq.fr2.txt configure -state normal
.frq.fr2.txt delete 1.0 end
.frq.fr2.txt insert end \n
foreach line $questionFile {
if {$line == "<image>"} {
set imgFlag 1
continue
}
if {$imgFlag == 1} {
set imgFlag 0
.frq.fr2.txt insert end " " center
.frq.fr2.txt image create end -image [image create photo -file [file join "$path/$line"]]
continue
}
if {[string match A)* $line]} {
.frq.fr2.lblA configure -text $line
lappend answers $line
continue
}
if {[string match B)* $line]} {
.frq.fr2.lblB configure -text $line
lappend answers $line
continue
}
if {[string match C)* $line]} {
.frq.fr2.lblC configure -text $line
lappend answers $line
continue
}
if {[string match D)* $line]} {
.frq.fr2.lblD configure -text $line
lappend answers $line
continue
}
.frq.fr2.txt insert end $line\n center
}
.frq.fr2.txt configure -state disabled
.frq.txt insert end [lindex $questionFile 0]\n
.frq.fr2.cb1 deselect
.frq.fr2.cb2 deselect
.frq.fr2.cb3 deselect
.frq.fr2.cb4 deselect
.frq.bar.next configure -state disabled
set ::choice 0
vwait ::goOn
switch $::choice {
A { set ind 0 }
B { set ind 1 }
C { set ind 2 }
default { set ind 3 }
}
if { $::choice == $goodAnswer} {
.frq.txt insert end "Correct answer: [lindex $answers $ind]\n\n" right
return 1
} else {
switch $goodAnswer {
A { set i 0 }
B { set i 1 }
C { set i 2 }
default { set i 3 }
}
.frq.txt insert end "Wrong answer: [lindex $answers $ind]\n\tYou should have pick [lindex $answers $i]\n\n" wrong
return 0
}
}
The widget concerned is ".frq.txt".
I have tried "pack" and "pack forget", even tried a way to use the option "-elide" but I am out of ideas.
Could you help me?
Since you're using grid to manage the contents of the .frq widget, including the .frq.txt widget, you need to use grid remove or grid forget to make the widget vanish. The difference between the two? With grid remove, the sizing metadata for the cell is remembered.
pack forget is for undoing a pack (strictly, a pack configure, though the simple pack pretends you said pack configure).
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