neingeist
/
arduinisten
Archived
1
0
Fork 0
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.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.

376 lines
12 KiB
Plaintext

# Shell
# ----------------------------------------------------------------------
# This class is implements a shell which is a top level widget
# giving a childsite and providing activate, deactivate, and center
# methods.
#
# ----------------------------------------------------------------------
# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
# Kris Raney EMAIL: kraney@spd.dsccc.com
#
# @(#) $Id: shell.itk,v 1.7 2002/02/25 06:43:26 mgbacke Exp $
# ----------------------------------------------------------------------
# Copyright (c) 1996 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.
# ======================================================================
#
# Usual options.
#
itk::usual Shell {
keep -background -cursor -modality
}
# ------------------------------------------------------------------
# SHELL
# ------------------------------------------------------------------
itcl::class iwidgets::Shell {
inherit itk::Toplevel
constructor {args} {}
itk_option define -master master Window ""
itk_option define -modality modality Modality none
itk_option define -padx padX Pad 0
itk_option define -pady padY Pad 0
itk_option define -width width Width 0
itk_option define -height height Height 0
public method childsite {}
public method activate {}
public method deactivate {args}
public method center {{widget {}}}
private variable _result {} ;# Resultant value for modal activation.
private variable _busied {} ;# List of busied top level widgets.
common grabstack {}
common _wait
}
#
# Provide a lowercased access method for the Shell class.
#
proc ::iwidgets::shell {pathName args} {
uplevel ::iwidgets::Shell $pathName $args
}
# ------------------------------------------------------------------
# CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Shell::constructor {args} {
itk_option add hull.width hull.height
#
# Maintain a withdrawn state until activated.
#
wm withdraw $itk_component(hull)
#
# Create the user child site
#
itk_component add -protected shellchildsite {
frame $itk_interior.shellchildsite
}
pack $itk_component(shellchildsite) -fill both -expand yes
#
# Set the itk_interior variable to be the childsite for derived
# classes.
#
set itk_interior $itk_component(shellchildsite)
#
# Bind the window manager delete protocol to deactivation of the
# widget. This can be overridden by the user via the execution
# of a similar command outside the class.
#
wm protocol $itk_component(hull) WM_DELETE_WINDOW [itcl::code $this deactivate]
#
# Initialize the widget based on the command line options.
#
eval itk_initialize $args
}
# ------------------------------------------------------------------
# OPTIONS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# OPTION: -master
#
# Specifies the master window for the shell. The window manager is
# informed that the shell is a transient window whose master is
# -masterwindow.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Shell::master {}
# ------------------------------------------------------------------
# OPTION: -modality
#
# Specify the modality of the dialog.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Shell::modality {
switch $itk_option(-modality) {
none -
application -
global {
}
default {
error "bad modality option \"$itk_option(-modality)\":\
should be none, application, or global"
}
}
}
# ------------------------------------------------------------------
# OPTION: -padx
#
# Specifies a padding distance for the childsite in the X-direction.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Shell::padx {
pack config $itk_component(shellchildsite) -padx $itk_option(-padx)
}
# ------------------------------------------------------------------
# OPTION: -pady
#
# Specifies a padding distance for the childsite in the Y-direction.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Shell::pady {
pack config $itk_component(shellchildsite) -pady $itk_option(-pady)
}
# ------------------------------------------------------------------
# OPTION: -width
#
# Specifies the width of the shell. The value may be specified in
# any of the forms acceptable to Tk_GetPixels. A value of zero
# causes the width to be adjusted to the required value based on
# the size requests of the components placed in the childsite.
# Otherwise, the width is fixed.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Shell::width {
#
# The width option was added to the hull in the constructor.
# So, any width value given is passed automatically to the
# hull. All we have to do is play with the propagation.
#
if {$itk_option(-width) != 0} {
pack propagate $itk_component(hull) no
} else {
pack propagate $itk_component(hull) yes
}
}
# ------------------------------------------------------------------
# OPTION: -height
#
# Specifies the height of the shell. The value may be specified in
# any of the forms acceptable to Tk_GetPixels. A value of zero
# causes the height to be adjusted to the required value based on
# the size requests of the components placed in the childsite.
# Otherwise, the height is fixed.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Shell::height {
#
# The height option was added to the hull in the constructor.
# So, any height value given is passed automatically to the
# hull. All we have to do is play with the propagation.
#
if {$itk_option(-height) != 0} {
pack propagate $itk_component(hull) no
} else {
pack propagate $itk_component(hull) yes
}
}
# ------------------------------------------------------------------
# METHODS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# METHOD: childsite
#
# Return the pathname of the user accessible area.
# ------------------------------------------------------------------
itcl::body iwidgets::Shell::childsite {} {
return $itk_component(shellchildsite)
}
# ------------------------------------------------------------------
# METHOD: activate
#
# Display the dialog and wait based on the modality. For application
# and global modal activations, perform a grab operation, and wait
# for the result. The result may be returned via an argument to the
# "deactivate" method.
# ------------------------------------------------------------------
itcl::body iwidgets::Shell::activate {} {
if {[winfo ismapped $itk_component(hull)]} {
raise $itk_component(hull)
return
}
if {($itk_option(-master) != {}) && \
[winfo exists $itk_option(-master)]} {
wm transient $itk_component(hull) $itk_option(-master)
}
set _wait($this) 0
raise $itk_component(hull)
wm deiconify $itk_component(hull)
tkwait visibility $itk_component(hull)
# Need to flush the event loop. This line added as a result of
# SF ticket #227885.
update idletasks
if {$itk_option(-modality) == "application"} {
if {$grabstack != {}} {
grab release [lindex $grabstack end]
}
set err 1
while {$err == 1} {
set err [catch [list grab $itk_component(hull)]]
if {$err == 1} {
after 1000
}
}
lappend grabstack [list grab $itk_component(hull)]
tkwait variable [itcl::scope _wait($this)]
return $_result
} elseif {$itk_option(-modality) == "global" } {
if {$grabstack != {}} {
grab release [lindex $grabstack end]
}
set err 1
while {$err == 1} {
set err [catch [list grab -global $itk_component(hull)]]
if {$err == 1} {
after 1000
}
}
lappend grabstack [list grab -global $itk_component(hull)]
tkwait variable [itcl::scope _wait($this)]
return $_result
}
}
# ------------------------------------------------------------------
# METHOD: deactivate
#
# Deactivate the display of the dialog. The method takes an optional
# argument to passed to the "activate" method which returns the value.
# This is only effective for application and global modal dialogs.
# ------------------------------------------------------------------
itcl::body iwidgets::Shell::deactivate {args} {
if {! [winfo ismapped $itk_component(hull)]} {
return
}
if {$itk_option(-modality) == "none"} {
wm withdraw $itk_component(hull)
} elseif {$itk_option(-modality) == "application"} {
grab release $itk_component(hull)
if {$grabstack != {}} {
if {[set grabstack [lreplace $grabstack end end]] != {}} {
eval [lindex $grabstack end]
}
}
wm withdraw $itk_component(hull)
} elseif {$itk_option(-modality) == "global"} {
grab release $itk_component(hull)
if {$grabstack != {}} {
if {[set grabstack [lreplace $grabstack end end]] != {}} {
eval [lindex $grabstack end]
}
}
wm withdraw $itk_component(hull)
}
if {[llength $args]} {
set _result $args
} else {
set _result {}
}
set _wait($this) 1
return
}
# ------------------------------------------------------------------
# METHOD: center
#
# Centers the dialog with respect to another widget or the screen
# as a whole.
# ------------------------------------------------------------------
itcl::body iwidgets::Shell::center {{widget {}}} {
update idletasks
set hull $itk_component(hull)
set w [winfo width $hull]
set h [winfo height $hull]
set sh [winfo screenheight $hull] ;# display screen's height/width
set sw [winfo screenwidth $hull]
#
# User can request it centered with respect to root by passing in '{}'
#
if { $widget == "" } {
set reqX [expr {($sw-$w)/2}]
set reqY [expr {($sh-$h)/2}]
} else {
set wfudge 5 ;# wm width fudge factor
set hfudge 20 ;# wm height fudge factor
set widgetW [winfo width $widget]
set widgetH [winfo height $widget]
set reqX [expr {[winfo rootx $widget]+($widgetW-($widgetW/2))-($w/2)}]
set reqY [expr {[winfo rooty $widget]+($widgetH-($widgetH/2))-($h/2)}]
#
# Adjust for errors - if too long or too tall
#
if { ($reqX+$w+$wfudge) > $sw } { set reqX [expr {$sw-$w-$wfudge}] }
if { $reqX < $wfudge } { set reqX $wfudge }
if { ($reqY+$h+$hfudge) > $sh } { set reqY [expr {$sh-$h-$hfudge}] }
if { $reqY < $hfudge } { set reqY $hfudge }
}
wm geometry $hull +$reqX+$reqY
}