Rocksolid Light

News from da outaworlds

mail  files  register  groups  login

Message-ID:  

BOFH excuse #222: I'm not sure. Try calling the Internet's head office -- it's in the book.


comp / comp.lang.tcl / how to bind widgets in a notebook tab?

SubjectAuthor
o how to bind widgets in a notebook tab?Mark Summerfield

1
Subject: how to bind widgets in a notebook tab?
From: Mark Summerfield
Newsgroups: comp.lang.tcl
Date: Thu, 27 Jun 2024 11:30 UTC
Path: eternal-september.org!news.eternal-september.org!feeder3.eternal-september.org!border-3.nntp.ord.giganews.com!nntp.giganews.com!Xl.tags.giganews.com!local-2.nntp.ord.giganews.com!nntp.brightview.co.uk!news.brightview.co.uk.POSTED!not-for-mail
NNTP-Posting-Date: Thu, 27 Jun 2024 11:30:35 +0000
From: mark@qtrac.eu (Mark Summerfield)
Subject: how to bind widgets in a notebook tab?
Newsgroups: comp.lang.tcl
MIME-Version: 1.0
User-Agent: Pan/0.154 (Izium; 517acf4)
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Message-ID: <uoycndaCnKnG0OD7nZ2dnZfqn_EAAAAA@brightview.co.uk>
Date: Thu, 27 Jun 2024 11:30:35 +0000
Lines: 253
X-Usenet-Provider: http://www.giganews.com
X-Trace: sv3-j0J3upq8dTMEXMi0VgbQpwk0612uPr/77zJNc38EueyWb+dTuSSa5ZOKywsnUJZ8Vq5iwAysXVyZJnt!pGpLAO1icexbpUNymCMSNQaDVwOztyDpmOZ4l5IsvZRV7nMUHsuUas0RYV1ZH4AnuTfuasH77Vmm!1MFc/UnlYScgtdY2eEvjAYFHEQ==
X-Abuse-and-DMCA-Info: Please be sure to forward a copy of ALL headers
X-Abuse-and-DMCA-Info: Otherwise we will be unable to process your complaint properly
X-Postfilter: 1.3.40
View all headers

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 ###

1

rocksolid light 0.9.8
clearnet tor