You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
248 lines
6.0 KiB
248 lines
6.0 KiB
# -*- 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) <ButtonPress-1> [list tixNoteBook:MouseDown $w %x %y]
|
|
bind $data(w:top) <ButtonRelease-1> [list tixNoteBook:MouseUp $w %x %y]
|
|
|
|
bind $data(w:top) <B1-Motion> [list tixNoteBook:MouseDown $w %x %y]
|
|
|
|
bind $data(w:top) <Left> [list tixNoteBook:FocusNext $w prev]
|
|
bind $data(w:top) <Right> [list tixNoteBook:FocusNext $w next]
|
|
|
|
bind $data(w:top) <Return> [list tixNoteBook:SetFocusByKey $w]
|
|
bind $data(w:top) <space> [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 <Alt-KeyPress> "+tixTraverseToNoteBook %W %A"
|
|
bind all <Meta-KeyPress> "+tixTraverseToNoteBook %W %A"
|
|
|