Sujet : how to bind widgets in a notebook tab?
De : mark (at) *nospam* qtrac.eu (Mark Summerfield)
Groupes : comp.lang.tclDate : 27. Jun 2024, 12:30:35
Autres entêtes
Message-ID : <uoycndaCnKnG0OD7nZ2dnZfqn_EAAAAA@brightview.co.uk>
User-Agent : Pan/0.154 (Izium; 517acf4)
I have an app with a notebook.
In some tabs I may need the same bindings, for example I might want <Alt-
s> to click a Save button in one tab but to click a [X] Show tooltips
Checkbutton in a different tab. So clearly I can't do:
bind . <Alt-s> ...
since I need it to work per tab.
In one tiny app eg this works fine, but in a more substantial one it
doesn't work at all.
Both are shown below.
### tabs.tcl one file app ###
#!/usr/bin/env wish9
tk scaling 1.67
tk appname Tabs
proc main {} {
wm withdraw .
wm title . [tk appname]
wm attributes . -type dialog
wm minsize . 200 200
make_widgets
make_bindings
wm deiconify .
raise .
}
namespace eval app {}
proc make_widgets {} {
set ::app::notebook [ttk::notebook .notebook]
ttk::notebook::enableTraversal .notebook
set ::app::matchFrame [ttk::frame .notebook.matchFrame]
make_match_frame $::app::matchFrame
.notebook add $::app::matchFrame -text Match -underline 0
set ::app::optionsFrame [ttk::frame .notebook.optionsFrame]
make_options_frame $::app::optionsFrame
.notebook add $::app::optionsFrame -text Options -underline 0
pack .notebook -expand true -fill both
}
proc make_match_frame {panel} {
set ::app::typeButton [ttk::button $panel.typeButton -text Type \
-underline 0 -command { puts "clicked typeButton" }]
pack $panel.typeButton
bind $panel <Alt-t> {
puts "Alt-t"
$::app::typeButton invoke
}
set ::app::sizeButton [ttk::button $panel.sizeButton -text Size \
-underline 0 -command { puts "clicked sizeButton" }]
pack $panel.sizeButton
bind $panel <Alt-s> {
puts "Alt-s"
$::app::sizeButton invoke
}
}
proc make_options_frame {panel} {
set ::app::scaleButton [ttk::button $panel.scaleButton -text Scale \
-underline 0 -command { puts "clicked scaleButton" }]
pack $panel.scaleButton
bind $panel <Alt-s> {
puts "Alt-s"
$::app::scaleButton invoke
}
}
proc make_bindings {} {
bind . <Escape> on_quit
bind . <Control-q> on_quit
wm protocol . WM_DELETE_WINDOW on_quit
}
proc on_quit {} {destroy .}
main
### the above works fine ###
### multi-file app where none of the Alt-keys work ###
#!/usr/bin/env wish9
# minicalc.tcl
const PATH [file normalize [file dirname [info script]]]
tcl::tm::path add $PATH
tk scaling 1.67
tk appname Minicalc
package require app
app::main
# app-1.tm
package require options
package require test
namespace eval app {}
proc app::main {} {
make_win
wm deiconify .
raise .
}
proc app::make_win {} {
wm withdraw .
wm title . [tk appname]
wm attributes . -type dialog
wm minsize . 400 320
make_widgets
pack .notebook -expand true -fill both
make_bindings
}
proc app::make_widgets {} {
set ::app::notebook [ttk::notebook .notebook]
ttk::notebook::enableTraversal .notebook
set ::app::optionsFrame [ttk::frame .notebook.optionsFrame]
options::make $::app::optionsFrame
.notebook add $::app::optionsFrame -text Options -underline 0
set ::app::testFrame [ttk::frame .notebook.testFrame]
test::make $::app::testFrame
.notebook add $::app::testFrame -text Test -underline 0
}
proc app::make_bindings {} {
bind . <Escape> app::on_quit
bind . <Control-q> app::on_quit
wm protocol . WM_DELETE_WINDOW app::on_quit
bind $::app::notebook <<NotebookTabChanged>> app::on_tab_change
}
proc app::on_tab_change {} {
switch [$::app::notebook select] {
.notebook.optionsFrame { focus $::app::optionsFrame.scaleSpinbox }
.notebook.testFrame { focus $::test::aboutButton }
}
}
proc app::on_quit {} { destroy . }
# globals-1.tm
const MARGIN 10
# options-1.tm
package require globals
package require tooltip
namespace eval options {
variable scaleSpinbox
variable themeSpinbox
}
proc options::make {panel {dialog false}} {
set opts {}
if {$dialog} { set opts {-underline 0} }
ttk::label $panel.scaleLabel -text Scale -underline 0 {*}$opts
set ::options::scaleSpinbox [ttk::spinbox $panel.scaleSpinbox \
-from 1.0 -to 4.0 -increment 0.01 -format %1.2f \
-command {tk scaling [$::options::scaleSpinbox get]}]
$panel.scaleSpinbox set [format %1.2f [tk scaling]]
tooltip::tooltip $panel.scaleSpinbox \
"Restart for scaling to take effect"
ttk::label $panel.themeLabel -text Theme -underline 1 {*}$opts
set ::options::themeSpinbox [ttk::spinbox $panel.themeSpinbox \
-values [lsort -decreasing [ttk::style theme names]] \
-command {ttk::style theme use [$::options::themeSpinbox get]}]
$panel.themeSpinbox set [ttk::style theme use]
set row 0
set opts "-pady {$::MARGIN 0} -padx $::MARGIN"
grid $panel.scaleLabel -row $row -column 0 -sticky w {*}$opts
grid $panel.scaleSpinbox -row $row -column 1 -sticky we {*}$opts
incr row
grid $panel.themeLabel -row $row -column 0 -sticky w {*}$opts
grid $panel.themeSpinbox -row $row -column 1 -sticky we {*}$opts
bind $panel <Alt-s> {focus $::options::scaleSpinbox}
bind $panel <Alt-h> {focus $::options::themeSpinbox}
return [incr row]
}
# test-1.tm
package require dialog
package require options
namespace eval test {}
proc test::make {panel} {
set ::test::aboutButton [ttk::button $panel.aboutButton -text About \
-underline 1 -command {puts test::on_about}]
set ::test::helpButton [ttk::button $panel.helpButton -text Help \
-underline 0 -command {puts test::on_help}]
pack $panel.aboutButton -side top
pack $panel.helpButton -side top
bind $panel <F1> { puts helpButton }
bind $panel <Alt-b> { puts aboutButton }
bind $panel <Alt-h> { puts helpButton }
}
# dialog-1.tm
package require tepam
namespace eval dialog {}
tepam::procedure {dialog prepare} {
-named_arguments_first 0
-args {
{-modeless -type none}
{-parent -default .}
{window}
}
} {
wm withdraw $window
wm attributes $window -type dialog
if {!$modeless} { wm transient $window $parent }
}
tepam::procedure {dialog show} {
-named_arguments_first 0
-args {
{-modeless -type none}
{-focuswidget -default ""}
{window}
}
} {
wm deiconify $window
raise $window
focus $window
if {$focuswidget ne ""} {focus $focuswidget}
if {!$modeless} {
catch {grab set $window}
catch {tkwait visibility $window}
}
}
tepam::procedure {dialog hide} {
-args { {window} }
} {
wm withdraw $window
grab release $window
}
### I can't understand why tabs.tcl's Alt-keys work and minicalc.tcl's
don't ###