Extra bindings for ttk::notebook for tab handling edit
- All options and methods are delegated to ttk::notebook
- There are the following bindings provided if notebook has focus
- F2 or right mouse click - rename tab
- Control-Shift-Left move tab to the left
- Control-Shift-Right move tab to the right
- Control-w delete current tab and destroy its childs
- Control-t create new tab
- a -createcmd option is added to perform an action after the user creates a new tab using <Control-t>
- bindings should targeted to the ttk::notebook using: pathname bind event ?script? see at the example code
#
# Created By : Dr. Detlef Groth
# Created : Mon Feb 05 17:11:44 2018
# Last Modified : <180205.2040>
#
# Description : Extended bindings for ttk::treeview for tab handling
#
# Requirements : snit and Tcl/Tk 8.6
#
# History : 0.1 initial release 2018-02-05
#
#
# Copyright (c) 2018 Dr. Detlef Groth.
#
# License BSD
package require snit
package provide SnitTtkNotebook 0.1
snit::widget SnitTtkNotebook {
option -createcmd ""
option -closecmd ""
variable nb
variable nbtext
variable child
delegate option * to nb
delegate method * to nb except [list add bind]
constructor {args} {
$self configurelist $args
install nb using ttk::notebook $win.nb ;#-side top -width 150 -height 50
pack $nb -fill both -expand yes -side top
bind $nb <KeyPress-F2> [mymethod tabRename %x %y]
bind $nb <Button-3> [mymethod tabRename %x %y]
bind $nb <Control-Shift-Left> [mymethod tabMove left %W]
bind $nb <Control-Shift-Right> [mymethod tabMove right %W]
bind $nb <Control-w> [mymethod tabClose %W]
bind $nb <Control-t> [mymethod new %W]
bind $nb <Enter> [list focus -force $nb]
}
method add {page args} {
$nb add $page {*}$args
if {$options(-createcmd) ne ""} {
eval $options(-createcmd) $nb $page
}
}
method new {w} {
frame $nb.f[llength [$nb tabs]]
$self add $nb.f[llength [$nb tabs]] -text "Tab [expr {[llength [$nb tabs]] + 1}]"
}
method bind {ev script} {
bind $nb $ev $script
}
method tabClose {w} {
set child [$w select]
set answer [tk_messageBox -title "Question!" -message "Really close tab [$w tab $child -text] ?" -type yesno -icon question]
if { $answer } {
$w forget $child
destroy $child
}
}
method tabRename {x y} {
set nbtext ""
if {![info exists .rename]} {
toplevel .rename
wm overrideredirect .rename true
#wm title .rename "DGApp" ;# for floating on i3
set x [winfo pointerx .]
set y [winfo pointery .]
entry .rename.ent -textvariable [myvar nbtext]
pack .rename.ent -padx 5 -pady 5
}
wm geometry .rename "180x40+$x+$y"
set tab [$nb select]
set nbtext [$nb tab $tab -text]
focus -force .rename.ent
bind .rename.ent <Return> [mymethod doTabRename %W]
bind .rename.ent <Escape> [list destroy .rename]
}
method doTabRename {w} {
set tab [$nb select]
$nb tab $tab -text $nbtext
destroy .rename
}
method tabMove {dir w} {
puts move$dir
set idx [lsearch [$nb tabs] [$nb select]]
puts $idx
set current [$nb select]
if {$dir eq "left"} {
if {$idx > 0} {
$nb insert [expr {$idx - 1}] $current
}
} else {
if {$idx < [expr {[llength [$nb tabs]] -1}]} {
$nb insert [expr {$idx + 1}] $current
}
}
# how to break automatic switch??
after 100 [list $nb select $current]
}
}
if {$argv0 eq [info script]} {
if {[llength $argv] <= 1 } {
proc testCreate {w page} {
puts "$w $page"
}
set nb [SnitTtkNotebook .nb -createcmd testCreate]
frame .nb.f1
pack [label .nb.f1.l -text "Tab Content 1"]
pack [text .nb.f1.t] -side top -fill both -expand true
frame .nb.f2
pack [label .nb.f2.l -text "Tab Content 2"]
frame .nb.f3
pack [label .nb.f3.l -text "Tab Content 3"]
$nb add .nb.f1 -text "Tab 1"
$nb add .nb.f2 -text "Tab 2"
$nb add .nb.f3 -text "Tab 3"
pack $nb -side top -fill both -expand yes
# demonstrate remove binding
$nb bind <Control-t> ""
# demonstrate add binding
$nb bind <KeyPress-F3> [list puts %W]
}
}
Installation edit
- copy the code to a file SnitTtkNotebook-0.1.tm
- put it to your collection of Tcl-Module files
- at the beginning of your script add the Module-path with cmd: ::tcl::tm::path add ?path...?
- next line the package require SnitTtkNotebook
Discussion edit
Place your comments, ideas here.
