Updated 2018-02-05 19:46:56 by DDG

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.