notebook.itk

windows下的GDB insight前端

		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: [e-mail]
#
# ------------------------------------------------------------------
#               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)
}