toolbar.itk

这是一个Linux下的集成开发环境

	} {
	}
    } errMsg]
	
    # ... Clean up if the create failed, and exit.
    #     The _opts list if it has -helpstr, -balloonstr just entered for
    #     this, it must be cleaned up.
    if { $createFailed } {
	# clean up
	if {![catch {set _opts($_interior.$name,-helpstr)}]} {
	    set lastIndex [\
		    expr [llength \
		    $_opts($_interior.$name,-helpstr) ]-1]
	    lreplace $_opts($_interior.$name,-helpstr) \
		    $lastIndex $lastIndex ""
	}
	if {![catch {set _opts($_interior.$name,-balloonstr)}]} {
	    set lastIndex [\
		    expr [llength \
		    $_opts($_interior.$name,-balloonstr) ]-1]
	    lreplace $_opts($_interior.$name,-balloonstr) \
		    $lastIndex $lastIndex ""
	}
	error $errMsg
    }
    
    # ... Add in dynamic options that apply from the _optionList
    foreach optionSet [$itk_component($name) configure] {
	set option [lindex $optionSet 0]
	if { [lsearch $_optionList $option] != -1 } {
	    itk_option add $name.$option
	}
    }
    
    bindtags $itk_component($name) \
	    [linsert [bindtags $itk_component($name)] end \
	    toolbar-help-$itk_component(hull)]
    bindtags $itk_component($name) \
	    [linsert [bindtags $itk_component($name)] end \
	    toolbar-balloon-$itk_component(hull)]
    
    return $itk_component($name)
}

# -------------------------------------------------------------
#
# PRIVATE METHOD: _deleteWidgets
#
# deletes widget range by numerical index numbers.
#
# -------------------------------------------------------------
body iwidgets::Toolbar::_deleteWidgets { index1 index2 } {
    
    for { set index $index1 } { $index <= $index2 } { incr index } {
	
	# kill the widget
	set component [lindex $_toolList $index]
	destroy $component
	
    }
    
    # physically remove the page
    set _toolList [lreplace $_toolList $index1 $index2]
    
}

# -------------------------------------------------------------
# PRIVATE METHOD: _index
#
# toolList : list of widget names to search thru if index 
#            is non-numeric
# index    : either number, 'end', 'last', or pattern
#
# _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 $toolList array.
# If it fails it returns -1
#
# -------------------------------------------------------------
body iwidgets::Toolbar::_index { toolList index } {
    
    switch -- $index {
	end - last {
	    set number [expr [llength $toolList] -1]
	}
	default {
	    # is it a number already? Then just use the number
	    if { [regexp {^[0-9]+$} $index] } {
		set number $index
		# check bounds
		if { $number < 0 || $number >= [llength $toolList] } {
		    set number -1
		}
		# otherwise it is a widget name
	    } else {
		if { [catch { set itk_component($index) } ] } {
		    set number -1
		} else {
		    set number [lsearch -exact $toolList \
			    $itk_component($index)]
		}
	    }
	}
    }
    
    return $number
}
    
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# STATUS HELP for linking to helpVariable
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# -------------------------------------------------------------
# 
# PUBLIC METHOD: hideHelp
#
# Bound to the <Leave> event on a toolbar widget. This clears the
# status widget help area and resets the help entry.
#
# -------------------------------------------------------------
body iwidgets::Toolbar::hideHelp {} {
    if { $itk_option(-helpvariable) != {} } {
        upvar #0 $itk_option(-helpvariable) helpvar
	set helpvar {}
    }
    set _currHelpWidget {}
}

# -------------------------------------------------------------
# 
# PUBLIC METHOD: showHelp
#
# Bound to the <Motion> event on a tool bar widget. This puts the
# help string associated with the tool bar widget into the 
# status widget help area. If no help exists for the current
# entry, the status widget is cleared.
#
# -------------------------------------------------------------
body iwidgets::Toolbar::showHelp { window } {
    
    set widgetPath $window
    # already on this item?
    if { $window == $_currHelpWidget } {
	return
    }
    
    set _currHelpWidget $window
    
    # Do we have a helpvariable set on the toolbar?
    if { $itk_option(-helpvariable) != {} } {
        upvar #0 $itk_option(-helpvariable) helpvar
	
	# is the -helpstr set for this widget?
	set args "-helpstr"
	if {[_getAttachedOption _opts \
		$window args value]} {
	    set helpvar $value.
	} else {
	    set helpvar {}
	}
    }
}

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# BALLOON HELP for show/hide of hint window
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# -------------------------------------------------------------
# 
# PUBLIC METHOD: showBalloon
#
# -------------------------------------------------------------
body iwidgets::Toolbar::showBalloon {window} {
    set _balloonClick false
    set _balloonAfterID 0
    # Are we still inside the window?
    set mouseWindow \
	    [winfo containing [winfo pointerx .] [winfo pointery .]]

    if { [string match $window* $mouseWindow] } {
	# set up the balloonString
	set args "-balloonstr"
	if {[_getAttachedOption _opts \
		$window args hintStr]} {
	    # configure the balloon help
	    $_hintWindow.label configure -text $hintStr		
	    
	    # Coordinates of the balloon
	    set balloonLeft \
		    [expr [winfo rootx $window] + round(([winfo width $window]/2.0))]
	    set balloonTop \
		    [expr [winfo rooty $window] + [winfo height $window]]
	    
	    # put up balloon window
	    wm overrideredirect $_hintWindow 0
	    wm geometry $_hintWindow "+$balloonLeft+$balloonTop"
	    wm overrideredirect $_hintWindow 1
	    wm deiconify $_hintWindow
	    raise $_hintWindow
	} else {
	    #NO BALLOON HELP AVAILABLE
	}
    } else {
	#NOT IN BUTTON
    }
    
}

# -------------------------------------------------------------
# 
# PUBLIC METHOD: hideBalloon
#
# -------------------------------------------------------------
body iwidgets::Toolbar::hideBalloon {} {
    wm withdraw $_hintWindow
}

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# OPTION MANAGEMENT for -helpstr, -balloonstr
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# -------------------------------------------------------------
# PRIVATE METHOD: _getAttachedOption
#
# optionListName : the name of the array that holds all attached
#              options. It is indexed via widget,option to get
#              the value.
# widget     : the widget that the option is associated with
# option     : the option whose value we are looking for on 
#              this widget.
#
# expects to be called only if the $option is length 1
# -------------------------------------------------------------
body iwidgets::Toolbar::_getAttachedOption { optionListName widget args retValue} {
    
    # get a reference to the option, so we can change it.
    upvar $args argsRef
    upvar $retValue retValueRef
    
    set success false
    
    if { ![catch { set retValueRef \
	    [eval set [subst [set optionListName]]($widget,$argsRef)]}]} {
	
	# remove the option argument 
	set success true
	set argsRef ""
    }
    
    return $success
}

# -------------------------------------------------------------
# PRIVATE METHOD: _setAttachedOption
#
# This method allows us to attach new options to a widget. It
# catches the 'option' to be attached, strips it out of 'args'
# attaches it to the 'widget' by stuffing the value into
# 'optionList(widget,option)'
#
# optionListName:  where to store the option and widget association
# widget: is the widget we want to associate the attached option
# option: is the attached option (unknown to this widget)
# args:   the arg list to search and remove the option from (if found)
#
# Modifies the args parameter.
# Returns boolean indicating the success of the method
#
# -------------------------------------------------------------
body iwidgets::Toolbar::_setAttachedOption {optionListName widget option args} {
    
    upvar args argsRef
    
    set success false
    
    # check for 'option' in the 'args' list for the 'widget'
    set optPos [eval lsearch $args $option]
    
    # ... found it
    if { $optPos != -1 } {
	# grab a copy of the option from arg list
	set [subst [set optionListName]]($widget,$option) \
		[eval lindex $args [expr $optPos + 1]]
	
	# remove the option argument and value from the arg list
	set argsRef [eval lreplace $args $optPos [expr $optPos + 1]]
	set success true
    }
    # ... if not found, will leave args alone
    
    return $success
}

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# GEOMETRY MANAGEMENT for tool widgets
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# -------------------------------------------------------------
# 
# PRIVATE METHOD: _packToolbar
#
#
#
# -------------------------------------------------------------
body iwidgets::Toolbar::_packToolbar {} {

    # forget the previous locations
    foreach tool $_toolList {
	pack forget $tool
    }
    
    # pack in order of _toolList.
    foreach tool $_toolList {
	# adjust for radios and checks to match buttons
	if { [winfo class $tool] == "Radiobutton" || 
	[winfo class $tool] == "Checkbutton" } {
	    set iPad 1
	} else {
	    set iPad 0
	}
	
	# pack by horizontal or vertical orientation
	if {$itk_option(-orient) == "horizontal" } {
	    pack $tool -side left -fill y \
		    -ipadx $iPad -ipady $iPad
	} else {
	    pack $tool -side top -fill x \
		    -ipadx $iPad -ipady $iPad
	}
    }
}