toolbar.itk

windows下的GDB insight前端

    return $itk_component($name)
    
}

# -------------------------------------------------------------
#
# METHOD: delete index ?index2?
#
# This command deletes all components between index and 
# index2 inclusive. If index2 is omitted then it defaults 
# to index. Returns an empty string
#
# -------------------------------------------------------------
itcl::body iwidgets::Toolbar::delete { args } {
    # empty toolbar
    if { $_toolList == {} } {
	error "can't delete widget, no widgets in the Toolbar \
		\"$itk_component(hull)\""
    }
    
    set len [llength $args]
    switch -- $len {
	1 {
	    set fromWidget [_index $_toolList [lindex $args 0]]
	    
	    if { $fromWidget < 0 || $fromWidget >= [llength $_toolList] } {
		error "bad Toolbar widget index in delete method: \
		  should be between 0 and [expr {[llength $_toolList] - 1} ]"
	    }
	    
	    set toWidget $fromWidget
	    _deleteWidgets $fromWidget $toWidget
	}
	
	2 {
	    set fromWidget [_index $_toolList [lindex $args 0]]
	    
	    if { $fromWidget < 0 || $fromWidget >= [llength $_toolList] } {
		error "bad Toolbar widget index1 in delete method: \
		  should be between 0 and [expr {[llength $_toolList] - 1} ]"
	    }
	    
	    set toWidget [_index $_toolList [lindex $args 1]]
	    
	    if { $toWidget < 0 || $toWidget >= [llength $_toolList] } {
		error "bad Toolbar widget index2 in delete method: \
		  should be between 0 and [expr {[llength $_toolList] - 1} ]"
	    }
	    
	    if { $fromWidget > $toWidget } {
		error "bad Toolbar widget index1 in delete method: \
			index1 is greater than index2"
	    }
	    
	    _deleteWidgets $fromWidget $toWidget
	}
	
	default {
	    # ... too few/many parameters passed
	    error "wrong # args: should be \
		    \"$itk_component(hull) delete index1 ?index2?\""
	}
    }
    
    return {}
}


# -------------------------------------------------------------
#
# METHOD: index index 
#
# Returns the widget's numerical index for the entry corresponding 
# to index. If index is not found, -1 is returned
#
# -------------------------------------------------------------
itcl::body iwidgets::Toolbar::index { index } {
    
    return [_index $_toolList $index]
    
}

# -------------------------------------------------------------
#
# METHOD: insert beforeIndex widgetCommand name ?option value?
#
# Insert a new component named name with the command 
# widgetCommand before the com ponent specified by beforeIndex. 
# If widgetCommand is radiobutton or checkbutton, its packing 
# is slightly padded to match the geometry of button widgets.
#
# -------------------------------------------------------------
itcl::body iwidgets::Toolbar::insert {  beforeIndex widgetCommand name args } {
    
    set beforeIndex [_index $_toolList $beforeIndex]
    
    if {$beforeIndex < 0 || $beforeIndex > [llength $_toolList] } {
	error "bad toolbar entry index $beforeIndex"
    }
    
    eval "_addWidget $widgetCommand $name $args"
    
    # linsert into list
    set _toolList [linsert $_toolList $beforeIndex $itk_component($name)]
    
    # repack the tool bar
    _packToolbar
    
    return $itk_component($name)
    
}

# ----------------------------------------------------------------------
# METHOD: itemcget index ?option? 
#
# Returns the value for the option setting of the widget at index $index.
# index can be numeric or widget name
#
# ----------------------------------------------------------------------
itcl::body iwidgets::Toolbar::itemcget { index args} {
    
    return [lindex [eval itemconfigure $index $args] 4]
}

# -------------------------------------------------------------
#
# METHOD: itemconfigure index ?option? ?value? ?option value...?
#
# Query or modify the configuration options of the widget of 
# the Toolbar specified by index. If no option is specified, 
# returns a list describing all of the available options for 
# index (see Tk_ConfigureInfo for information on the format 
# of this list). If option is specified with no value, then 
# the command returns a list describing the one named option 
# (this list will be identical to the corresponding sublist 
# of the value returned if no option is specified). If one 
# or more option-value pairs are specified, then the command 
# modifies the given widget option(s) to have the given 
# value(s); in this case the command returns an empty string. 
# The component type of index determines the valid available options.
#
# -------------------------------------------------------------
itcl::body iwidgets::Toolbar::itemconfigure { index args } {
    
    # Get a numeric index.
    set index [_index $_toolList $index]
    
    # Get the tool path
    set toolPath [lindex $_toolList $index]
    
    set len [llength $args]
    
    switch $len {
	0 {
	    # show all options
	    # ''''''''''''''''
	    
	    # support display of -helpstr and -balloonstr configs
	    set optList [$toolPath configure]
	    
	    ## @@@ might want to use _getAttachedOption instead...
	    if { [info exists _opts($toolPath,-helpstr)] } {
		set value $_opts($toolPath,-helpstr)
	    } else {
		set value {}
	    }
	    lappend optList [list -helpstr helpStr HelpStr {} $value]
	    if { [info exists _opts($toolPath,-balloonstr)] } {
		set value $_opts($toolPath,-balloonstr)
	    } else {
		set value {}
	    }
	    lappend optList [list -balloonstr balloonStr BalloonStr {} $value]
	    return $optList
	}
	1 {
	    # show only option specified
	    # ''''''''''''''''''''''''''
	    # did we satisfy the option get request?
	    
	    if { [regexp -- {-helpstr} $args] } {
		if { [info exists _opts($toolPath,-helpstr)] } {
		    set value $_opts($toolPath,-helpstr)
		} else {
		    set value {}
		}
		return [list -helpstr helpStr HelpStr {} $value]
	    } elseif { [regexp -- {-balloonstr} $args] } {
		if { [info exists _opts($toolPath,-balloonstr)] } {
		    set value $_opts($toolPath,-balloonstr)
		} else {
		    set value {}
		}
		return [list -balloonstr balloonStr BalloonStr {} $value]
	    } else {
		return [eval $toolPath configure $args]
	    }
	    
	}
	default {
	    # ... do a normal configure
	    
	    # first screen for all our child options we are adding
	    _setAttachedOption \
		    _opts \
		    $toolPath \
		    "-helpstr" \
		    $args
	    
	    _setAttachedOption \
		    _opts \
		    $toolPath \
		    "-balloonstr" \
		    $args 
	    
	    # with a clean args list do a configure
	    
	    # if the stripping process brought us down to no options
	    # to set, then forget the configure of widget.
	    if { [llength $args] != 0 } {
		return [eval $toolPath configure $args]
	    } else {
		return ""
	    }
	}
    }
    
}

# -------------------------------------------------------------
#
# METHOD: _resetBalloonDelay1 
#
# Sets the delay that will occur before a balloon could be popped
# up to balloonDelay1
#
# -------------------------------------------------------------
itcl::body iwidgets::Toolbar::_resetBalloonTimer {} {
    set _balloonTimer $itk_option(-balloondelay1)
    
    # reset the <1> longer delay
    set _balloonClick false
}

# -------------------------------------------------------------
#
# METHOD: _startBalloonDelay 
#
# Starts waiting to pop up a balloon id
#
# -------------------------------------------------------------
itcl::body iwidgets::Toolbar::_startBalloonDelay {window} {
    if {$_balloonAfterID != 0} {
	after cancel $_balloonAfterID
    }
    set _balloonAfterID [after $_balloonTimer [itcl::code $this showBalloon $window]]
}

# -------------------------------------------------------------
#
# METHOD: _stopBalloonDelay  
#
# This method will stop the timer for a balloon popup if one is
# in progress. If however there is already a balloon window up
# it will hide the balloon window and set timing to delay 2 stage.
#
# -------------------------------------------------------------
itcl::body iwidgets::Toolbar::_stopBalloonDelay { window balloonClick } {
    
    # If <1> then got a click cancel
    if { $balloonClick } {
	set _balloonClick true
    }
    if { $_balloonAfterID != 0 } {
	after cancel $_balloonAfterID
	set _balloonAfterID 0
    } else {
	hideBalloon
	
	# If this was cancelled with a <1> use longer delay.
	if { $_balloonClick } {
	    set _balloonTimer $itk_option(-balloondelay1)
	} else {
	    set _balloonTimer $itk_option(-balloondelay2)
	}
    }
}

# -------------------------------------------------------------
# PRIVATE METHOD: _addWidget
#
# widgetCommand : command to invoke to create the added widget
# name          : name of the new widget to add
# args          : options for the widget create command
#
# Looks for -helpstr, -balloonstr and grabs them, strips from
# args list. Then tries to add a component and keeps based
# on known type. If it fails, it tries to clean up. Then it
# binds handlers for helpstatus and balloon help.
#
# Returns the path of the widget added.
#
# -------------------------------------------------------------
itcl::body iwidgets::Toolbar::_addWidget { widgetCommand name args } {
    
    # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Add the widget to the tool bar
    # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    # ... Strip out and save the -helpstr, -balloonstr options from args
    #     and save it in _opts
    _setAttachedOption \
	    _opts \
	    $_interior.$name \
	    -helpstr \
	    $args 
    
    _setAttachedOption \
	    _opts \
	    $_interior.$name \
	    -balloonstr \
	    $args
    
    
    # ... Add the new widget as a component (catch an error if occurs)
    set createFailed [catch { 
	itk_component add $name {
	    eval $widgetCommand $_interior.$name $args