"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tltcl/lib/tk8.6/ttk/notebook.tcl" (17 Mar 2020, 5619 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Tcl/Tk source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 #
    2 # Bindings for TNotebook widget
    3 #
    4 
    5 namespace eval ttk::notebook {
    6     variable TLNotebooks ;# See enableTraversal
    7 }
    8 
    9 bind TNotebook <ButtonPress-1>      { ttk::notebook::Press %W %x %y }
   10 bind TNotebook <Key-Right>      { ttk::notebook::CycleTab %W  1; break }
   11 bind TNotebook <Key-Left>       { ttk::notebook::CycleTab %W -1; break }
   12 bind TNotebook <Control-Key-Tab>    { ttk::notebook::CycleTab %W  1; break }
   13 bind TNotebook <Control-Shift-Key-Tab>  { ttk::notebook::CycleTab %W -1; break }
   14 catch {
   15 bind TNotebook <Control-ISO_Left_Tab>   { ttk::notebook::CycleTab %W -1; break }
   16 }
   17 bind TNotebook <Destroy>        { ttk::notebook::Cleanup %W }
   18 
   19 # ActivateTab $nb $tab --
   20 #   Select the specified tab and set focus.
   21 #
   22 #  Desired behavior:
   23 #   + take focus when reselecting the currently-selected tab;
   24 #   + keep focus if the notebook already has it;
   25 #   + otherwise set focus to the first traversable widget
   26 #     in the newly-selected tab;
   27 #   + do not leave the focus in a deselected tab.
   28 #
   29 proc ttk::notebook::ActivateTab {w tab} {
   30     set oldtab [$w select]
   31     $w select $tab
   32     set newtab [$w select] ;# NOTE: might not be $tab, if $tab is disabled
   33 
   34     if {[focus] eq $w} { return }
   35     if {$newtab eq $oldtab} { focus $w ; return }
   36 
   37     update idletasks ;# needed so focus logic sees correct mapped states
   38     if {[set f [ttk::focusFirst $newtab]] ne ""} {
   39     ttk::traverseTo $f
   40     } else {
   41     focus $w
   42     }
   43 }
   44 
   45 # Press $nb $x $y --
   46 #   ButtonPress-1 binding for notebook widgets.
   47 #   Activate the tab under the mouse cursor, if any.
   48 #
   49 proc ttk::notebook::Press {w x y} {
   50     set index [$w index @$x,$y]
   51     if {$index ne ""} {
   52     ActivateTab $w $index
   53     }
   54 }
   55 
   56 # CycleTab --
   57 #   Select the next/previous tab in the list.
   58 #
   59 proc ttk::notebook::CycleTab {w dir} {
   60     if {[$w index end] != 0} {
   61     set current [$w index current]
   62     set select [expr {($current + $dir) % [$w index end]}]
   63     while {[$w tab $select -state] != "normal" && ($select != $current)} {
   64         set select [expr {($select + $dir) % [$w index end]}]
   65     }
   66     if {$select != $current} {
   67         ActivateTab $w $select
   68     }
   69     }
   70 }
   71 
   72 # MnemonicTab $nb $key --
   73 #   Scan all tabs in the specified notebook for one with the 
   74 #   specified mnemonic. If found, returns path name of tab;
   75 #   otherwise returns ""
   76 #
   77 proc ttk::notebook::MnemonicTab {nb key} {
   78     set key [string toupper $key]
   79     foreach tab [$nb tabs] {
   80     set label [$nb tab $tab -text]
   81     set underline [$nb tab $tab -underline]
   82     set mnemonic [string toupper [string index $label $underline]]
   83     if {$mnemonic ne "" && $mnemonic eq $key} {
   84         return $tab
   85     }
   86     }
   87     return ""
   88 }
   89 
   90 # +++ Toplevel keyboard traversal.
   91 #
   92 
   93 # enableTraversal --
   94 #   Enable keyboard traversal for a notebook widget
   95 #   by adding bindings to the containing toplevel window.
   96 #
   97 #   TLNotebooks($top) keeps track of the list of all traversal-enabled 
   98 #   notebooks contained in the toplevel 
   99 #
  100 proc ttk::notebook::enableTraversal {nb} {
  101     variable TLNotebooks
  102 
  103     set top [winfo toplevel $nb]
  104 
  105     if {![info exists TLNotebooks($top)]} {
  106     # Augment $top bindings:
  107     #
  108     bind $top <Control-Key-Next>         {+ttk::notebook::TLCycleTab %W  1}
  109     bind $top <Control-Key-Prior>        {+ttk::notebook::TLCycleTab %W -1}
  110     bind $top <Control-Key-Tab>          {+ttk::notebook::TLCycleTab %W  1}
  111     bind $top <Control-Shift-Key-Tab>    {+ttk::notebook::TLCycleTab %W -1}
  112     catch {
  113     bind $top <Control-Key-ISO_Left_Tab> {+ttk::notebook::TLCycleTab %W -1}
  114     }
  115     if {[tk windowingsystem] eq "aqua"} {
  116         bind $top <Option-KeyPress> \
  117         +[list ttk::notebook::MnemonicActivation $top %K]
  118     } else {
  119         bind $top <Alt-KeyPress> \
  120         +[list ttk::notebook::MnemonicActivation $top %K]
  121     }
  122     bind $top <Destroy> {+ttk::notebook::TLCleanup %W}
  123     }
  124 
  125     lappend TLNotebooks($top) $nb
  126 }
  127 
  128 # TLCleanup -- <Destroy> binding for traversal-enabled toplevels
  129 #
  130 proc ttk::notebook::TLCleanup {w} {
  131     variable TLNotebooks
  132     if {$w eq [winfo toplevel $w]} {
  133     unset -nocomplain -please TLNotebooks($w)
  134     }
  135 }
  136 
  137 # Cleanup -- <Destroy> binding for notebooks
  138 #
  139 proc ttk::notebook::Cleanup {nb} {
  140     variable TLNotebooks
  141     set top [winfo toplevel $nb]
  142     if {[info exists TLNotebooks($top)]} {
  143     set index [lsearch -exact $TLNotebooks($top) $nb]
  144         set TLNotebooks($top) [lreplace $TLNotebooks($top) $index $index]
  145     }
  146 }
  147 
  148 # EnclosingNotebook $w -- 
  149 #   Return the nearest traversal-enabled notebook widget
  150 #   that contains $w.
  151 #
  152 # BUGS: this only works properly for tabs that are direct children
  153 #   of the notebook widget.  This routine should follow the
  154 #   geometry manager hierarchy, not window ancestry, but that
  155 #   information is not available in Tk.
  156 #
  157 proc ttk::notebook::EnclosingNotebook {w} {
  158     variable TLNotebooks
  159 
  160     set top [winfo toplevel $w]
  161     if {![info exists TLNotebooks($top)]} { return }
  162 
  163     while {$w ne $top  && $w ne ""} {
  164     if {[lsearch -exact $TLNotebooks($top) $w] >= 0} {
  165         return $w
  166     }
  167     set w [winfo parent $w]
  168     }
  169     return ""
  170 }
  171 
  172 # TLCycleTab --
  173 #   toplevel binding procedure for Control-Tab / Control-Shift-Tab
  174 #   Select the next/previous tab in the nearest ancestor notebook. 
  175 #
  176 proc ttk::notebook::TLCycleTab {w dir} {
  177     set nb [EnclosingNotebook $w]
  178     if {$nb ne ""} {
  179     CycleTab $nb $dir
  180     return -code break
  181     }
  182 }
  183 
  184 # MnemonicActivation $nb $key --
  185 #   Alt-KeyPress binding procedure for mnemonic activation.
  186 #   Scan all notebooks in specified toplevel for a tab with the
  187 #   the specified mnemonic.  If found, activate it and return TCL_BREAK.
  188 #
  189 proc ttk::notebook::MnemonicActivation {top key} {
  190     variable TLNotebooks
  191     foreach nb $TLNotebooks($top) {
  192     if {[set tab [MnemonicTab $nb $key]] ne ""} {
  193         ActivateTab $nb [$nb index $tab]
  194         return -code break
  195     }
  196     }
  197 }