I've created a window with menu and two notebook tabs. In the menu I have a button "Open" and it's opening me a file aaa.txt in a text widget in notebook tab 1. The problem is that I would like to open it not in tab 1 but in current selected/displayed/active notebook tab (could be tab 1 or tab 2). Code below:
proc CommandOpen { } {
set f [open aaa.txt r]
set x [read $f]
.f.nb.f1.f11.t1 insert 1.0 $x
close $f
}
wm title .
wm geometry . 640x460
pack [frame .f] -fill both
pack [ttk::notebook .f.nb] -fill both
.f.nb add [frame .f.nb.f1] -text "tab1"
pack [frame .f.nb.f1.f11] -side top -fill both
pack [text .f.nb.f1.f11.t1 -bg white] -side left -fill both
.f.nb add [frame .f.nb.f2] -text "tab2"
pack [text .f.nb.f2.t1 -bg white] -side left -fill both
menu .mbar -borderwidth 1
. configure -menu .mbar
.mbar add cascade -label "File" -underline 0 -menu [menu .mbar.file -tearoff 0]
set mf .mbar.file
$mf add command -label "Open" -command CommandOpen -underline 0
Thanks
You can get the currently selected tab index using:
.f.nb index current
This is documented on the manual page (it's the index method and the current tabid).
To get the slave widget which is managed by a particular tab, you index into the results of the tabs method. Overall, you get:
set currentSubwindow [lindex [.f.nb tabs] [.f.nb index current]]
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 created a tcl notebook, it have two tabs, if the file is too big, i am not able to scroll down. Sharing my code here.
To execute this code, you need 2 files (Warning.txt and Error.txt), place them into same directory before running this code.
Please create two files Error.txt and Warning.txt.
Put some content to it make it some 10,000 lines.
#!/usr/bin/wish -f
#
package require Tk
proc noteb {} {
global rundir logfile
frame .lpo
pack .lpo -side top -fill both -expand true
#cd $rundir
set ft [exec grep -c Warning ./Warning.txt]
puts $ft
set ert [exec grep -c Error ./Error.txt]
puts $ert
pack [frame .fa] -fill both -side top
pack [ttk::notebook .fa.nb] -fill both
set gt "Errors"
set bt "Warnings"
set delim ":"
set rt [concat [string trim $bt][string trim $delim][string trim $ft]]
set dt [concat [string trim $gt][string trim $delim][string trim $ert]]
if {$ft > 0} {
.fa.nb add [frame .fa.nb.f1] -text $rt
} else {
.fa.nb add [frame .fa.nb.f1] -text "Warnings"
}
pack [frame .fa.nb.f1.f11] -side top -fill both -expand true
pack [text .fa.nb.f1.f11.t1 -bg LightYellow -borderwidth 2 -width 80 -height 6 -relief raised -setgrid true ] -side left -fill both -expand true
scrollbar .fa.nb.f1.f11.scroll -command {.fa.nb.f1.f11.t1 yview}
pack .fa.nb.f1.f11.scroll -side right -fill y
set fp1 [open Warning.txt r]
set v [read $fp1]
.fa.nb.f1.f11.t1 insert 1.0 $v
close $fp1
if {$ert > 0} {
.fa.nb add [frame .fa.nb.f2] -text $dt
} else {
.fa.nb add [frame .fa.nb.f2] -text "Errors"
}
pack [frame .fa.nb.f2.f11] -side top -fill both -expand true
pack [text .fa.nb.f2.f11.t1 -bg LightYellow -borderwidth 2 -width 80 -height 6 -relief raised -setgrid true ] -side left -fill both -expand true
scrollbar .fa.nb.f2.f11.scroll -command {.fa.nb.f2.f11.t1 yview}
pack .fa.nb.f2.f11.scroll -side right -fill y
set fp [open Error.txt r]
set c [read $fp]
.fa.nb.f2.f11.t1 insert 1.0 $c
close $fp
}
button .mn -text summary -command {noteb}
pack .mn -side left
In these lines below, you tell the scrollbar about the text widget, but not the text widget about the scrollbar. You need to do both.
pack [text .fa.nb.f1.f11.t1 -bg LightYellow -borderwidth 2 -width 80 -height 6 -relief raised -setgrid true ] -side left -fill both -expand true
scrollbar .fa.nb.f1.f11.scroll -command {.fa.nb.f1.f11.t1 yview}
pack .fa.nb.f1.f11.scroll -side right -fill y
Let that instead become this:
text .fa.nb.f1.f11.t1 -bg LightYellow -borderwidth 2 -width 80 -height 6 \
-relief raised -setgrid true -yscroll {.fa.nb.f1.f11.scroll set}
scrollbar .fa.nb.f1.f11.scroll -command {.fa.nb.f1.f11.t1 yview}
pack .fa.nb.f1.f11.t1 -side left -fill both -expand true
pack .fa.nb.f1.f11.scroll -side right -fill y
Though I'd actually be inclined to do this instead:
set w .fa.nb.f1.f11
text $w.t1 -bg LightYellow -borderwidth 2 -width 80 -height 6 -relief raised \
-setgrid true -yscroll [list $w.scroll set]
scrollbar $w.scroll -command [list $w.t1 yview]
pack $w.t1 -side left -fill both -expand true
pack $w.scroll -side right -fill y
Putting the container widget name in a variable helps keep your code more sensible, and makes it more obvious that the text and scrollbar are related. (It also makes it easier to refactor the code, if desired.)
I think it will work if you set the -yscroll option on the text widget.
I have now created the same user interface with initially using a gui builder for tcl. However, it became limited in terms of how I could structure my interface and the spacing between widgets. Now that I've created my interface I'm looking to create a procedure block to a specific widget. For example, I would like the quit button to exit the program.
To achieve this I created the following procedure:
proc btnQuit args {
exit
}
This doesn't cause a syntax or runtime error however, when the button is pressed, the program does not exit. This is the simplest case as there are others that are more complex so the -command flag will not apply to all situations.
Thoughts?
Below is my entire code. This is just bringing up the user interface.
#Includes the necessary packages
package require BWidget
package require Tk
namespace eval Main_Menu {}
#DO NOT MODIFY!! Graphical User Interface Code DO NOT MODIFY!!
#Limit the size of window
wm maxsize . 475 180 ;#x-500, y-210
wm minsize . 475 180 ;#x-500, y-210
#[Device name] Test Frame w/ associated check boxes
labelframe .lblfrmSelection -text "Testable Devices" -padx 1 -relief groove -height 175 -width 200
button .btnDualUTA -text "Dual UTA" -padx 5 -anchor "center" -justify "center" -padx 3
button .btnTProbe -text "T-Probe" -padx 5 -anchor "center" -justify "center" -padx 7
button .btnOctal -text "Octal" -padx 5 -anchor "center" -justify "center" -padx 14
button .btnUniversal -text "Universal" -padx 5 -anchor "center" -justify "center"
button .btnQuit -text "Exit" -padx 5 -anchor "center" -justify "center" -padx 18
#Setup second frame with image label
labelframe .lblfrmHWSetup -text "Hardware Setup" -padx 1 -relief groove -height 200 -width 175
image create photo glcomm.gif
label .lblSetup -text "Image goes here"
#*************** Render User Environment ******************
#Create Device Test Interface with check boxes in frame.
place .lblfrmSelection -anchor nw -x 5 -y 1 -width 165 -height 175
place .btnDualUTA -in .lblfrmSelection -x 40 -y 15 -anchor "w"
place .btnTProbe -in .lblfrmSelection -x 40 -y 46 -anchor "w"
place .btnOctal -in .lblfrmSelection -x 40 -y 76 -anchor "w"
place .btnUniversal -in .lblfrmSelection -x 40 -y 106 -anchor "w"
place .btnQuit -in .lblfrmSelection -x 40 -y 136 -anchor "w"
#Create label frame "Hardware Setup"
place .lblfrmHWSetup -anchor nw -x 170 -y 1 -height 175 -width 300
place .lblSetup -in .lblfrmHWSetup -x 171 -y 2
# MODIFY BELOW THIS LINE!! MODIFY BELOW THIS LINE!!
proc btnQuit args {
exit
}
You haven't shown how the button is created, but the -command option is what you need
$ tclsh <<'END'
package req Tk
proc btnQuit args {exit}
button .b -text Quit -command btnQuit
pack .b
END
If your button is already created, you can configure it with the -command option
button .b -text Quit
.b configure -command btnQuit
Note that this looks for the "btnQuit" proc in the global namespace. If you're using namespaces, you have to fully qualify the command name. This will throw an error when you click the button (invalid command name "btnQuit")
namespace eval MySpace {
proc btnQuit args {exit}
}
button .b -text Quit -command btnQuit
In this case, you need
button .b -text Quit -command MySpace::btnQuit
If you need to pass arguments to the btnQuit proc, you'll do something like
button .b -text Quit -command [list btnQuit $local_var1 $local_var2]
or
button .b -text Quit -command {btnQuit $global_var1 $global_var2}
The different quoting mechanisms cause the variables to be substituted at different times:
the first when the button is created;
the second when the button is clicked.
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.