You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
947 lines
30 KiB
Plaintext
947 lines
30 KiB
Plaintext
#
|
|
# Notebook Widget
|
|
# ----------------------------------------------------------------------
|
|
# The Notebook command creates a new window (given by the pathName
|
|
# argument) and makes it into a Notebook widget. Additional options,
|
|
# described above may be specified on the command line or in the
|
|
# option database to configure aspects of the Notebook such as its
|
|
# colors, font, and text. The Notebook command returns its pathName
|
|
# argument. At the time this command is invoked, there must not exist
|
|
# a window named pathName, but path Name's parent must exist.
|
|
#
|
|
# A Notebook is a widget that contains a set of pages. It displays one
|
|
# page from the set as the selected page. When a page is selected, the
|
|
# page's contents are displayed in the page area. When first created a
|
|
# Notebook has no pages. Pages may be added or deleted using widget commands
|
|
# described below.
|
|
#
|
|
# A special option may be provided to the Notebook. The -auto option
|
|
# specifies whether the Nptebook will automatically handle the unpacking
|
|
# and packing of pages when pages are selected. A value of true signifies
|
|
# that the notebook will automatically manage it. This is the default
|
|
# value. A value of false signifies the notebook will not perform automatic
|
|
# switching of pages.
|
|
#
|
|
# WISH LIST:
|
|
# This section lists possible future enhancements.
|
|
#
|
|
# ----------------------------------------------------------------------
|
|
# AUTHOR: Bill W. Scott EMAIL: bscott@spd.dsccc.com
|
|
#
|
|
# @(#) $Id: notebook.itk,v 1.4 2001/08/15 18:33:31 smithc Exp $
|
|
# ----------------------------------------------------------------------
|
|
# Copyright (c) 1995 DSC Technologies Corporation
|
|
# ======================================================================
|
|
# Permission to use, copy, modify, distribute and license this software
|
|
# and its documentation for any purpose, and without fee or written
|
|
# agreement with DSC, is hereby granted, provided that the above copyright
|
|
# notice appears in all copies and that both the copyright notice and
|
|
# warranty disclaimer below appear in supporting documentation, and that
|
|
# the names of DSC Technologies Corporation or DSC Communications
|
|
# Corporation not be used in advertising or publicity pertaining to the
|
|
# software without specific, written prior permission.
|
|
#
|
|
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
|
|
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
|
|
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
|
|
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
|
|
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
|
|
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
|
|
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
|
|
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
|
|
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
|
|
# SOFTWARE.
|
|
# ======================================================================
|
|
|
|
#
|
|
# Default resources.
|
|
#
|
|
option add *Notebook.background #d9d9d9 widgetDefault
|
|
option add *Notebook.auto true widgetDefault
|
|
|
|
#
|
|
# Usual options.
|
|
#
|
|
itk::usual Notebook {
|
|
keep -background -cursor
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# NOTEBOOK
|
|
# ------------------------------------------------------------------
|
|
itcl::class iwidgets::Notebook {
|
|
inherit itk::Widget
|
|
|
|
constructor {args} {}
|
|
|
|
itk_option define -background background Background #d9d9d9
|
|
itk_option define -auto auto Auto true
|
|
itk_option define -scrollcommand scrollCommand ScrollCommand {}
|
|
|
|
public method add { args }
|
|
public method childsite { args }
|
|
public method delete { args }
|
|
public method index { args }
|
|
public method insert { args }
|
|
public method prev { }
|
|
public method next { }
|
|
public method pageconfigure { args }
|
|
public method pagecget { index option }
|
|
public method select { index }
|
|
public method view { args }
|
|
|
|
private method _childSites { }
|
|
private method _scrollCommand { }
|
|
private method _index { pathList index select}
|
|
private method _createPage { args }
|
|
private method _deletePages { fromPage toPage }
|
|
private method _configurePages { args }
|
|
private method _tabCommand { }
|
|
|
|
private variable _currPage -1 ;# numerical index of current page selected
|
|
private variable _pages {} ;# list of Page components
|
|
private variable _uniqueID 0 ;# one-up number for unique page numbering
|
|
|
|
}
|
|
|
|
#
|
|
# Provide a lowercase access method for the Notebook class
|
|
#
|
|
proc ::iwidgets::notebook {pathName args} {
|
|
uplevel ::iwidgets::Notebook $pathName $args
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# CONSTRUCTOR
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Notebook::constructor {args} {
|
|
#
|
|
# Create the outermost frame to maintain geometry.
|
|
#
|
|
itk_component add cs {
|
|
frame $itk_interior.cs
|
|
} {
|
|
keep -cursor -background -width -height
|
|
}
|
|
pack $itk_component(cs) -fill both -expand yes
|
|
pack propagate $itk_component(cs) no
|
|
|
|
eval itk_initialize $args
|
|
|
|
# force bg of all pages to reflect Notebook's background.
|
|
_configurePages -background $itk_option(-background)
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# OPTIONS
|
|
# ------------------------------------------------------------------
|
|
# ------------------------------------------------------------------
|
|
# OPTION -background
|
|
#
|
|
# Sets the bg color of all the pages in the Notebook.
|
|
# ------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Notebook::background {
|
|
if {$itk_option(-background) != {}} {
|
|
_configurePages -background $itk_option(-background)
|
|
}
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# OPTION -auto
|
|
#
|
|
# Determines whether pages are automatically unpacked and
|
|
# packed when pages get selected.
|
|
# ------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Notebook::auto {
|
|
if {$itk_option(-auto) != {}} {
|
|
}
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# OPTION -scrollcommand
|
|
#
|
|
# Command string to be invoked when the notebook
|
|
# has any changes to its current page, or number of pages.
|
|
#
|
|
# typically for scrollbars.
|
|
# ------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Notebook::scrollcommand {
|
|
if {$itk_option(-scrollcommand) != {}} {
|
|
_scrollCommand
|
|
}
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD: add add ?<option> <value>...?
|
|
#
|
|
# Creates a page and appends it to the list of pages.
|
|
# processes pageconfigure for the page added.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Notebook::add { args } {
|
|
# The args list should be an even # of params, if not then
|
|
# prob missing value for last item in args list. Signal error.
|
|
set len [llength $args]
|
|
if {$len % 2} {
|
|
error "value for \"[lindex $args [expr {$len - 1}]]\" missing"
|
|
}
|
|
|
|
# add a Page component
|
|
set pathName [eval _createPage $args]
|
|
lappend _pages $pathName
|
|
|
|
# update scroller
|
|
_scrollCommand
|
|
|
|
# return childsite for the Page component
|
|
return [eval $pathName childsite]
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD: childsite ?<index>?
|
|
#
|
|
# If index is supplied, returns the child site widget corresponding
|
|
# to the page index. If called with no arguments, returns a list
|
|
# of all child sites
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Notebook::childsite { args } {
|
|
set len [llength $args]
|
|
|
|
switch $len {
|
|
0 {
|
|
# ... called with no arguments, return a list
|
|
if { [llength $args] == 0 } {
|
|
return [_childSites]
|
|
}
|
|
}
|
|
1 {
|
|
set index [lindex $args 0]
|
|
# ... otherwise, return child site for the index given
|
|
# empty notebook
|
|
if { $_pages == {} } {
|
|
error "can't get childsite,\
|
|
no pages in the notebook \"$itk_component(hull)\""
|
|
}
|
|
|
|
set index [_index $_pages $index $_currPage]
|
|
|
|
# index out of range
|
|
if { $index < 0 || $index >= [llength $_pages] } {
|
|
error "bad Notebook page index in childsite method:\
|
|
should be between 0 and [expr {[llength $_pages] - 1}]"
|
|
}
|
|
|
|
set pathName [lindex $_pages $index]
|
|
|
|
set cs [eval $pathName childsite]
|
|
return $cs
|
|
}
|
|
default {
|
|
# ... too many parameters passed
|
|
error "wrong # args: should be\
|
|
\"$itk_component(hull) childsite ?index?\""
|
|
}
|
|
}
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD: delete <index1> ?<index2>?
|
|
#
|
|
# Deletes a page or range of pages from the notebook
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Notebook::delete { args } {
|
|
# empty notebook
|
|
if { $_pages == {} } {
|
|
error "can't delete page, no pages in the notebook\
|
|
\"$itk_component(hull)\""
|
|
}
|
|
|
|
set len [llength $args]
|
|
switch -- $len {
|
|
1 {
|
|
set fromPage [_index $_pages [lindex $args 0] $_currPage]
|
|
|
|
if { $fromPage < 0 || $fromPage >= [llength $_pages] } {
|
|
error "bad Notebook page index in delete method:\
|
|
should be between 0 and [expr {[llength $_pages] - 1}]"
|
|
}
|
|
|
|
set toPage $fromPage
|
|
_deletePages $fromPage $toPage
|
|
}
|
|
|
|
2 {
|
|
set fromPage [_index $_pages [lindex $args 0] $_currPage]
|
|
|
|
if { $fromPage < 0 || $fromPage >= [llength $_pages] } {
|
|
error "bad Notebook page index1 in delete method:\
|
|
should be between 0 and [expr {[llength $_pages] - 1}]"
|
|
}
|
|
|
|
set toPage [_index $_pages [lindex $args 1] $_currPage]
|
|
|
|
if { $toPage < 0 || $toPage >= [llength $_pages] } {
|
|
error "bad Notebook page index2 in delete method:\
|
|
should be between 0 and [expr {[llength $_pages] - 1}]"
|
|
error "bad Notebook page index2"
|
|
}
|
|
|
|
if { $fromPage > $toPage } {
|
|
error "bad Notebook page index1 in delete method:\
|
|
index1 is greater than index2"
|
|
}
|
|
|
|
_deletePages $fromPage $toPage
|
|
|
|
}
|
|
|
|
default {
|
|
# ... too few/many parameters passed
|
|
error "wrong # args: should be\
|
|
\"$itk_component(hull) delete index1 ?index2?\""
|
|
}
|
|
}
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD: index <index>
|
|
#
|
|
# Given an index identifier returns the numeric index of the page
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Notebook::index { args } {
|
|
if { [llength $args] != 1 } {
|
|
error "wrong # args: should be\
|
|
\"$itk_component(hull) index index\""
|
|
}
|
|
|
|
set index $args
|
|
|
|
set number [_index $_pages $index $_currPage]
|
|
|
|
return $number
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD: insert <index> ?<option> <value>...?
|
|
#
|
|
# Inserts a page before a index. The before page may
|
|
# be specified as a label or a page position.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Notebook::insert { args } {
|
|
# ... Error: no args passed
|
|
set len [llength $args]
|
|
if { $len == 0 } {
|
|
error "wrong # args: should be\
|
|
\"$itk_component(hull) insert index ?option value?\""
|
|
}
|
|
|
|
# ... set up index and args
|
|
set index [lindex $args 0]
|
|
set args [lrange $args 1 $len]
|
|
|
|
# ... Error: unmatched option value pair (len is odd)
|
|
# The args list should be an even # of params, if not then
|
|
# prob missing value for last item in args list. Signal error.
|
|
set len [llength $args]
|
|
if { $len % 2 } {
|
|
error "value for \"[lindex $args [expr {$len - 1}]]\" missing"
|
|
}
|
|
|
|
# ... Error: catch notebook empty
|
|
if { $_pages == {} } {
|
|
error "can't insert page, no pages in the notebook\
|
|
\"$itk_component(hull)\""
|
|
}
|
|
|
|
# ok, get the page
|
|
set page [_index $_pages $index $_currPage]
|
|
|
|
# ... Error: catch bad value for before page.
|
|
if { $page < 0 || $page >= [llength $_pages] } {
|
|
error "bad Notebook page index in insert method:\
|
|
should be between 0 and [expr {[llength $_pages] - 1}]"
|
|
}
|
|
|
|
# ... Start the business of inserting
|
|
# create the new page and get its path name...
|
|
set pathName [eval _createPage $args]
|
|
|
|
# grab the name of the page currently selected. (to keep in sync)
|
|
set currPathName [lindex $_pages $_currPage]
|
|
|
|
# insert pathName before $page
|
|
set _pages [linsert $_pages $page $pathName]
|
|
|
|
# keep the _currPage in sync with the insert.
|
|
set _currPage [lsearch -exact $_pages $currPathName]
|
|
|
|
# give scrollcommand chance to update
|
|
_scrollCommand
|
|
|
|
# give them child site back...
|
|
return [eval $pathName childsite]
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD: prev
|
|
#
|
|
# Selects the previous page. Wraps at first back to last page.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Notebook::prev { } {
|
|
# catch empty notebook
|
|
if { $_pages == {} } {
|
|
error "can't move to previous page,\
|
|
no pages in the notebook \"$itk_component(hull)\""
|
|
}
|
|
|
|
# bump to the previous page and wrap if necessary
|
|
set prev [expr {$_currPage - 1}]
|
|
if { $prev < 0 } {
|
|
set prev [expr {[llength $_pages] - 1}]
|
|
}
|
|
|
|
select $prev
|
|
|
|
return $prev
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD: next
|
|
#
|
|
# Selects the next page. Wraps at last back to first page.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Notebook::next { } {
|
|
# catch empty notebook
|
|
if { $_pages == {} } {
|
|
error "can't move to next page,\
|
|
no pages in the notebook \"$itk_component(hull)\""
|
|
}
|
|
|
|
# bump to the next page and wrap if necessary
|
|
set next [expr {$_currPage + 1}]
|
|
if { $next >= [llength $_pages] } {
|
|
set next 0
|
|
}
|
|
|
|
select $next
|
|
|
|
return $next
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD: pageconfigure <index> ?<option> <value>...?
|
|
#
|
|
# Performs configure on a given page denoted by index. Index may
|
|
# be a page number or a pattern matching the label associated with
|
|
# a page.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Notebook::pageconfigure { args } {
|
|
# ... Error: no args passed
|
|
set len [llength $args]
|
|
if { $len == 0 } {
|
|
error "wrong # args: should be\
|
|
\"$itk_component(hull) pageconfigure index ?option value?\""
|
|
}
|
|
|
|
# ... set up index and args
|
|
set index [lindex $args 0]
|
|
set args [lrange $args 1 $len]
|
|
|
|
set page [_index $_pages $index $_currPage]
|
|
|
|
# ... Error: page out of range
|
|
if { $page < 0 || $page >= [llength $_pages] } {
|
|
error "bad Notebook page index in pageconfigure method:\
|
|
should be between 0 and [expr {[llength $_pages] - 1}]"
|
|
}
|
|
|
|
# Configure the page component
|
|
set pathName [lindex $_pages $page]
|
|
return [eval $pathName configure $args]
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD: pagecget <index> <option>
|
|
#
|
|
# Performs cget on a given page denoted by index. Index may
|
|
# be a page number or a pattern matching the label associated with
|
|
# a page.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Notebook::pagecget { index option } {
|
|
set page [_index $_pages $index $_currPage]
|
|
|
|
# ... Error: page out of range
|
|
if { $page < 0 || $page >= [llength $_pages] } {
|
|
error "bad Notebook page index in pagecget method:\
|
|
should be between 0 and [expr {[llength $_pages] - 1}]"
|
|
}
|
|
|
|
# Get the page info.
|
|
set pathName [lindex $_pages $page]
|
|
return [$pathName cget $option]
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD: select <index>
|
|
#
|
|
# Select a page by index. Hide the last _currPage if it existed.
|
|
# Then show the new one if it exists. Returns the currently
|
|
# selected page or -1 if tried to do a select select when there is
|
|
# no selection.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Notebook::select { index } {
|
|
global page$itk_component(hull)
|
|
|
|
# ... Error: empty notebook
|
|
if { $_pages == {} } {
|
|
error "can't select page $index,\
|
|
no pages in the notebook \"$itk_component(hull)\""
|
|
}
|
|
|
|
# if there is not current selection just ignore trying this selection
|
|
if { $index == "select" && $_currPage == -1 } {
|
|
return -1
|
|
}
|
|
|
|
set reqPage [_index $_pages $index $_currPage]
|
|
|
|
if { $reqPage < 0 || $reqPage >= [llength $_pages] } {
|
|
error "bad Notebook page index in select method:\
|
|
should be between 0 and [expr {[llength $_pages] - 1}]"
|
|
}
|
|
|
|
# if we already have this page selected, then ignore selection.
|
|
if { $reqPage == $_currPage } {
|
|
return $_currPage
|
|
}
|
|
|
|
# if we are handling packing and unpacking the unpack if we can
|
|
if { $itk_option(-auto) } {
|
|
# if there is a current page packed, then unpack it
|
|
if { $_currPage != -1 } {
|
|
set currPathName [lindex $_pages $_currPage]
|
|
pack forget $currPathName
|
|
}
|
|
}
|
|
|
|
# set this now so that the -command cmd can do an 'index select'
|
|
# to operate on this page.
|
|
set _currPage $reqPage
|
|
|
|
# invoke the command for this page
|
|
set cmd [lindex [pageconfigure $index -command] 4]
|
|
eval $cmd
|
|
|
|
# give scrollcommand chance to update
|
|
_scrollCommand
|
|
|
|
# if we are handling packing and unpacking the pack if we can
|
|
if { $itk_option(-auto) } {
|
|
set reqPathName [lindex $_pages $reqPage]
|
|
pack $reqPathName -anchor nw -fill both -expand yes
|
|
}
|
|
|
|
return $_currPage
|
|
}
|
|
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD: view
|
|
#
|
|
# Return the current page
|
|
#
|
|
# view <index>
|
|
#
|
|
# Selects the page denoted by index to be current page
|
|
#
|
|
# view 'moveto' <fraction>
|
|
#
|
|
# Selects the page by using fraction amount
|
|
#
|
|
# view 'scroll' <num> <what>
|
|
#
|
|
# Selects the page by using num as indicator of next or previous
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Notebook::view { args } {
|
|
set len [llength $args]
|
|
switch -- $len {
|
|
0 {
|
|
# Return current page
|
|
return $_currPage
|
|
}
|
|
1 {
|
|
# Select by index
|
|
select [lindex $args 0]
|
|
}
|
|
2 {
|
|
# Select using moveto
|
|
set arg [lindex $args 0]
|
|
if { $arg == "moveto" } {
|
|
set fraction [lindex $args 1]
|
|
if { [catch { set page \
|
|
[expr {round($fraction/(1.0/[llength $_pages]))}]}]} {
|
|
error "expected floating-point number \
|
|
but got \"$fraction\""
|
|
}
|
|
if { $page == [llength $_pages] } {
|
|
incr page -1
|
|
}
|
|
|
|
if { $page >= 0 && $page < [llength $_pages] } {
|
|
select $page
|
|
}
|
|
} else {
|
|
error "expected \"moveto\" but got $arg"
|
|
}
|
|
}
|
|
3 {
|
|
# Select using scroll keyword
|
|
set arg [lindex $args 0]
|
|
if { $arg == "scroll" } {
|
|
set amount [lindex $args 1]
|
|
# check for integer value
|
|
if { ! [regexp {^[-]*[0-9]*$} $amount] } {
|
|
error "expected integer but got \"$amount\""
|
|
}
|
|
set page [expr {$_currPage + $amount}]
|
|
if { $page >= 0 && $page < [llength $_pages] } {
|
|
select $page
|
|
}
|
|
|
|
} else {
|
|
error "expected \"scroll\" but got $arg"
|
|
}
|
|
}
|
|
default {
|
|
set arg [lindex $args 0]
|
|
if { $arg == "moveto" } {
|
|
error "wrong # args: should be\
|
|
\"$itk_component(hull) view moveto fraction\""
|
|
} elseif { $arg == "scroll" } {
|
|
error "wrong # args: should be\
|
|
\"$itk_component(hull) view scroll units|pages\""
|
|
} else {
|
|
error "wrong # args: should be\
|
|
\"$itk_component(hull) view index\""
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# PRIVATE METHOD: _childSites
|
|
#
|
|
# Returns a list of child sites for all pages in the notebook.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Notebook::_childSites { } {
|
|
# empty notebook
|
|
if { $_pages == {} } {
|
|
error "can't get childsite list,\
|
|
no pages in the notebook \"$itk_component(hull)\""
|
|
}
|
|
|
|
set csList {}
|
|
|
|
foreach pathName $_pages {
|
|
lappend csList [eval $pathName childsite]
|
|
}
|
|
|
|
return $csList
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# PRIVATE METHOD: _scrollCommand
|
|
#
|
|
# If there is a -scrollcommand set up, then call the tcl command
|
|
# and suffix onto it the standard 4 numbers scrollbars get.
|
|
#
|
|
# Invoke the scrollcommand, this is like the y/xscrollcommand
|
|
# it is designed to talk to scrollbars and the the
|
|
# tabset also knows how to obey scrollbar protocol.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Notebook::_scrollCommand { } {
|
|
if { $itk_option(-scrollcommand) != {} } {
|
|
if { $_currPage != -1 } {
|
|
set relTop [expr {($_currPage*1.0) / [llength $_pages]}]
|
|
set relBottom [expr {(($_currPage+1)*1.0) / [llength $_pages]}]
|
|
set scrollCommand "$itk_option(-scrollcommand) $relTop $relBottom"
|
|
} else {
|
|
set scrollCommand "$itk_option(-scrollcommand) 0 1"
|
|
}
|
|
uplevel #0 $scrollCommand
|
|
}
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# PRIVATE METHOD: _index
|
|
#
|
|
# pathList : list of path names to search thru if index is a label
|
|
# index : either number, 'select', 'end', or pattern
|
|
# select : current selection
|
|
#
|
|
# _index takes takes the value $index converts it to
|
|
# a numeric identifier. If the value is not already
|
|
# an integer it looks it up in the $pathList array.
|
|
# If it fails it returns -1
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Notebook::_index { pathList index select} {
|
|
switch -- $index {
|
|
select {
|
|
set number $select
|
|
}
|
|
end {
|
|
set number [expr {[llength $pathList] -1}]
|
|
}
|
|
default {
|
|
# is it a number already?
|
|
if { [regexp {^[0-9]+$} $index] } {
|
|
set number $index
|
|
if { $number < 0 || $number >= [llength $pathList] } {
|
|
set number -1
|
|
}
|
|
|
|
# otherwise it is a label
|
|
} else {
|
|
# look thru the pathList of pathNames and
|
|
# get each label and compare with index.
|
|
# if we get a match then set number to postion in $pathList
|
|
# and break out.
|
|
# otherwise number is still -1
|
|
set i 0
|
|
set number -1
|
|
foreach pathName $pathList {
|
|
set label [lindex [$pathName configure -label] 4]
|
|
if { [string match $label $index] } {
|
|
set number $i
|
|
break
|
|
}
|
|
incr i
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
return $number
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# PRIVATE METHOD: _createPage
|
|
#
|
|
# Creates a page, using unique page naming, propagates background
|
|
# and keeps unique id up to date.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Notebook::_createPage { args } {
|
|
#
|
|
# create an internal name for the page: .n.cs.page0, .n.cs.page1, etc.
|
|
#
|
|
set pathName $itk_component(cs).page$_uniqueID
|
|
|
|
eval iwidgets::Page $pathName -background $itk_option(-background) $args
|
|
|
|
incr _uniqueID
|
|
return $pathName
|
|
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# PRIVATE METHOD: _deletePages
|
|
#
|
|
# Deletes pages from $fromPage to $toPage.
|
|
#
|
|
# Operates in two passes, destroys all the widgets
|
|
# Then removes the pathName from the page list
|
|
#
|
|
# Also keeps the current selection in bounds.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Notebook::_deletePages { fromPage toPage } {
|
|
for { set page $fromPage } { $page <= $toPage } { incr page } {
|
|
# kill the widget
|
|
set pathName [lindex $_pages $page]
|
|
destroy $pathName
|
|
}
|
|
|
|
# physically remove the page
|
|
set _pages [lreplace $_pages $fromPage $toPage]
|
|
|
|
# If we deleted a selected page set our selection to none
|
|
if { $_currPage >= $fromPage && $_currPage <= $toPage } {
|
|
set _currPage -1
|
|
}
|
|
|
|
# make sure _currPage stays in sync with new numbering...
|
|
if { $_pages == {} } {
|
|
# if deleted only remaining page,
|
|
# reset current page to undefined
|
|
set _currPage -1
|
|
|
|
# or if the current page was the last page, it needs come back
|
|
} elseif { $_currPage >= [llength $_pages] } {
|
|
incr _currPage -1
|
|
if { $_currPage < 0 } {
|
|
# but only to zero
|
|
set _currPage 0
|
|
}
|
|
}
|
|
|
|
# give scrollcommand chance to update
|
|
_scrollCommand
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# PRIVATE METHOD: _configurePages
|
|
#
|
|
# Does the pageconfigure method on each page in the notebook
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Notebook::_configurePages { args } {
|
|
# make sure we have pages
|
|
if { [catch {set _pages}] } {
|
|
return
|
|
}
|
|
|
|
# go thru all pages and pageconfigure them.
|
|
foreach pathName $_pages {
|
|
eval "$pathName configure $args"
|
|
}
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# PRIVATE METHOD: _tabCommand
|
|
#
|
|
# Calls the command that was passed in through the
|
|
# $itk_option(-tabcommand) argument.
|
|
#
|
|
# This method is up for debate... do we need the -tabcommand option?
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Notebook::_tabCommand { } {
|
|
global page$itk_component(hull)
|
|
|
|
if { $itk_option(-tabcommand) != {} } {
|
|
set newTabCmdStr $itk_option(-tabcommand)
|
|
lappend newTabCmdStr [set page$itk_component(hull)]
|
|
|
|
#eval $newTabCmdStr
|
|
uplevel #0 $newTabCmdStr
|
|
}
|
|
}
|
|
|
|
#
|
|
# Page widget
|
|
# ------------------------------------------------------------------
|
|
#
|
|
# The Page command creates a new window (given by the pathName argument)
|
|
# and makes it into a Page widget. Additional options, described above
|
|
# may be specified on the com mand line or in the option database to
|
|
# configure aspects of the Page such as its back ground, cursor, and
|
|
# geometry. The Page command returns its pathName argument. At the time
|
|
# this command is invoked, there must not exist a window named pathName,
|
|
# but path Name's parent must exist.
|
|
#
|
|
# A Page is a frame that holds a child site. It is nothing more than a
|
|
# frame widget with some intelligence built in. Its primary purpose is
|
|
# to support the Notebook's concept of a page. It allows another widget
|
|
# like the Notebook to treat a page as a single object. The Page has an
|
|
# associated label and knows how to return its child site.
|
|
#
|
|
# ------------------------------------------------------------------
|
|
# AUTHOR: Bill W. Scott EMAIL: bscott@spd.dsccc.com
|
|
#
|
|
# ------------------------------------------------------------------
|
|
# Copyright (c) 1995 DSC Communications Corp.
|
|
# ======================================================================
|
|
# Permission is hereby granted, without written agreement and without
|
|
# license or royalty fees, to use, copy, modify, and distribute this
|
|
# software and its documentation for any purpose, provided that the
|
|
# above copyright notice and the following two paragraphs appear in
|
|
# all copies of this software.
|
|
#
|
|
# IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR
|
|
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
|
|
# ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN
|
|
# IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
|
|
# DAMAGE.
|
|
#
|
|
# THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING,
|
|
# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
|
# FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
|
|
# ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO
|
|
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
|
|
# ======================================================================
|
|
#
|
|
# Option database default resources:
|
|
#
|
|
option add *Page.disabledForeground #a3a3a3 widgetDefault
|
|
option add *Page.label {} widgetDefault
|
|
option add *Page.command {} widgetDefault
|
|
|
|
itcl::class iwidgets::Page {
|
|
inherit itk::Widget
|
|
|
|
constructor {args} {}
|
|
|
|
itk_option define \
|
|
-disabledforeground disabledForeground DisabledForeground #a3a3a3
|
|
itk_option define -label label Label {}
|
|
itk_option define -command command Command {}
|
|
|
|
public method childsite { }
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# CONSTRUCTOR
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Page::constructor {args} {
|
|
#
|
|
# Create the outermost frame to maintain geometry.
|
|
#
|
|
itk_component add cs {
|
|
frame $itk_interior.cs
|
|
} {
|
|
keep -cursor -background -width -height
|
|
}
|
|
pack $itk_component(cs) -fill both -expand yes
|
|
pack propagate $itk_component(cs) no
|
|
|
|
eval itk_initialize $args
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# OPTIONS
|
|
# ------------------------------------------------------------------
|
|
# ------------------------------------------------------------------
|
|
# OPTION -disabledforeground
|
|
#
|
|
# Sets the disabledForeground color of this page
|
|
# ------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Page::disabledforeground {
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# OPTION -label
|
|
#
|
|
# Sets the label of this page. The label is a string identifier
|
|
# for this page.
|
|
# ------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Page::label {
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# OPTION -command
|
|
#
|
|
# The Tcl Command to associate with this page.
|
|
# ------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Page::command {
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHODS
|
|
# ------------------------------------------------------------------
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD: childsite
|
|
#
|
|
# Returns the child site widget of this page
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Page::childsite { } {
|
|
return $itk_component(cs)
|
|
}
|
|
|