/usr/lib64/tcl8.5/Tix8.4.3
Edit: /usr/lib64/tcl8.5/Tix8.4.3/NoteBook.tcl (6160B)
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: NoteBook.tcl,v 1.7 2004/03/28 02:44:57 hobbs Exp $
#
# NoteBook.tcl --
#
# tixNoteBook: NoteBook type of window.
#
# Copyright (c) 1993-1999 Ioi Kim Lam.
# Copyright (c) 2000-2001 Tix Project Group.
# Copyright (c) 2004 ActiveState
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
tixWidgetClass tixNoteBook {
-classname TixNoteBook
-superclass tixVStack
-method {
}
-flag {
}
-configspec {
{-takefocus takeFocus TakeFocus 0 tixVerifyBoolean}
}
-default {
{.nbframe.tabPadX 8}
{.nbframe.tabPadY 5}
{.nbframe.borderWidth 2}
{*nbframe.relief raised}
}
}
proc tixNoteBook:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
set data(pad-x1) 0
set data(pad-x2) 0
set data(pad-y1) 20
set data(pad-y2) 0
}
proc tixNoteBook:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:top) [tixNoteBookFrame $w.nbframe -slave 1 -takefocus 1]
set data(w:nbframe) $data(w:top)
bind $data(w:top)
[list tixNoteBook:MouseDown $w %x %y]
bind $data(w:top) [list tixNoteBook:MouseUp $w %x %y]
bind $data(w:top) [list tixNoteBook:MouseDown $w %x %y]
bind $data(w:top) [list tixNoteBook:FocusNext $w prev]
bind $data(w:top) [list tixNoteBook:FocusNext $w next]
bind $data(w:top) [list tixNoteBook:SetFocusByKey $w]
bind $data(w:top) [list tixNoteBook:SetFocusByKey $w]
}
#----------------------------------------------------------------------
# Public methods
#----------------------------------------------------------------------
proc tixNoteBook:add {w child args} {
upvar #0 $w data
set ret [eval tixChainMethod $w add $child $args]
set new_args ""
foreach {flag value} $args {
if {$flag ne "-createcmd" && $flag ne "-raisecmd"} {
lappend new_args $flag
lappend new_args $value
}
}
eval [linsert $new_args 0 $data(w:top) add $child]
return $ret
}
proc tixNoteBook:raise {w child} {
upvar #0 $w data
tixChainMethod $w raise $child
if {[$data(w:top) pagecget $child -state] eq "normal"} {
$data(w:top) activate $child
}
}
proc tixNoteBook:delete {w child} {
upvar #0 $w data
tixChainMethod $w delete $child
$data(w:top) delete $child
}
#----------------------------------------------------------------------
# Private methods
#----------------------------------------------------------------------
proc tixNoteBook:Resize {w} {
upvar #0 $w data
# We have to take care of the size of the tabs so that
#
set rootReq [$data(w:top) geometryinfo]
set tW [lindex $rootReq 0]
set tH [lindex $rootReq 1]
set data(pad-x1) 2
set data(pad-x2) 2
set data(pad-y1) [expr {$tH + $data(-ipadx) + 1}]
set data(pad-y2) 2
set data(minW) [expr {$tW}]
set data(minH) [expr {$tH}]
# Now that we know data(pad-y1), we can chain the call
#
tixChainMethod $w Resize
}
proc tixNoteBook:MouseDown {w x y} {
upvar #0 $w data
focus $data(w:top)
set name [$data(w:top) identify $x $y]
$data(w:top) focus $name
set data(w:down) $name
}
proc tixNoteBook:MouseUp {w x y} {
upvar #0 $w data
#it could happen (using the tk/menu) that a MouseUp
#proceeds without a MouseDown event!!
if {![info exists data(w:down)] || ![info exists data(w:top)]} {
return
}
set name [$data(w:top) identify $x $y]
if {$name ne "" && $name eq $data(w:down)
&& [$data(w:top) pagecget $name -state] eq "normal"} {
$data(w:top) activate $name
tixCallMethod $w raise $name
} else {
$data(w:top) focus ""
}
}
#----------------------------------------------------------------------
#
# Section for keyboard bindings
#
#----------------------------------------------------------------------
proc tixNoteBook:FocusNext {w dir} {
upvar #0 $w data
if {[$data(w:top) info focus] == ""} {
set name [$data(w:top) info active]
$data(w:top) focus $name
if {$name ne ""} {
return
}
} else {
set name [$data(w:top) info focus$dir]
$data(w:top) focus $name
}
}
proc tixNoteBook:SetFocusByKey {w} {
upvar #0 $w data
set name [$data(w:top) info focus]
if {$name ne "" && [$data(w:top) pagecget $name -state] eq "normal"} {
tixCallMethod $w raise $name
$data(w:top) activate $name
}
}
#----------------------------------------------------------------------
# Automatic bindings for alt keys
#----------------------------------------------------------------------
proc tixNoteBookFind {w char} {
set char [string tolower $char]
foreach child [winfo child $w] {
if {![winfo ismapped $w]} {
continue
}
switch -exact -- [winfo class $child] {
Toplevel { continue }
TixNoteBook {
set nbframe [$child subwidget nbframe]
foreach page [$nbframe info pages] {
set char2 [string index [$nbframe pagecget $page -label] \
[$nbframe pagecget $page -underline]]
if {($char eq [string tolower $char2] || $char eq "")
&& [$nbframe pagecget $page -state] ne "disabled"} {
return [list $child $page]
}
}
}
}
# Well, this notebook doesn't match with the key, but maybe
# it contains a "subnotebook" that will match ..
set match [tixNoteBookFind $child $char]
if {$match ne ""} {
return $match
}
}
return ""
}
proc tixTraverseToNoteBook {w char} {
if {$char eq ""} {
return 0
}
if {![winfo exists $w]} {
return 0
}
set list [tixNoteBookFind [winfo toplevel $w] $char]
if {$list ne ""} {
[lindex $list 0] raise [lindex $list 1]
return 1
}
return 0
}
#----------------------------------------------------------------------
# Set default class bindings
#----------------------------------------------------------------------
bind all "+tixTraverseToNoteBook %W %A"
bind all "+tixTraverseToNoteBook %W %A"