bugfix.tcl
Go to the documentation of this file.00001 # Copyright (C) 1997-2004 The CDG Team <cdg@nats.informatik.uni-hamburg.de>
00002 #
00003 # This file is free software; as a special exception the author gives
00004 # unlimited permission to copy and/or distribute it, with or without
00005 # modifications, as long as this notice is preserved.
00006 #
00007 # This program is distributed in the hope that it will be useful, but
00008 # WITHOUT ANY WARRANTY, to the extent permitted by law; without even the
00009 # implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
00010
00011 ## ----------------------------------------------------------------------------
00012 ## \file bugfix.tcl
00013 ## TclTk Enhancements.
00014 ## Fixes for some common errors in the TclTk, Itcl/Itk/Iwidges toolkits.
00015 ## Til now the most importand fix here is the iwidgets::Shell:activate{}
00016 ## fix to get arround the display delay of a shell dialog before it gets
00017 ## accessable. You might have noticed that before in other TclTk apps, that
00018 ## sometimes you get a white box dialog. Whatever this is the activate()
00019 ## method below overwrites the Shell method in a way that things work better
00020 ## now. I don't clame to understand what I actually do here ;)
00021 ##
00022 ## \author Michael Daum
00023 ##
00024 ## $Id: bugfix.tcl,v 1.6 2004/02/25 14:40:41 micha Exp $
00025 ## ----------------------------------------------------------------------------
00026
00027 ##----------------------------------------------------------------------------
00028 ## the shell widget is lame; this fixes it.
00029 ##----------------------------------------------------------------------------
00030 body iwidgets::Shell::activate {} {
00031
00032 if {[winfo ismapped $itk_component(hull)]} {
00033 raise $itk_component(hull) .
00034 return
00035 }
00036
00037 if {($itk_option(-master) != {}) && \
00038 [winfo exists $itk_option(-master)]} {
00039 wm transient $itk_component(hull) $itk_option(-master)
00040 }
00041
00042 set _wait($this) 0
00043 wm deiconify $itk_component(hull)
00044 if {$itk_option(-master) != ""} {
00045 raise $itk_component(hull) $itk_option(-master)
00046 } else {
00047 raise $itk_component(hull) .
00048 }
00049 tkwait visibility $itk_component(hull)
00050
00051 if {$itk_option(-modality) == "application"} {
00052 if {$grabstack != {}} {
00053 grab release [lindex $grabstack end]
00054 }
00055
00056 set err 1
00057 while {$err == 1} {
00058 set err [catch [list grab $itk_component(hull)]]
00059 if {$err == 1} {
00060 after 1000
00061 }
00062 }
00063
00064 lappend grabstack [list grab $itk_component(hull)]
00065
00066 tkwait variable [scope _wait($this)]
00067 return $_result
00068
00069 } elseif {$itk_option(-modality) == "global" } {
00070 if {$grabstack != {}} {
00071 grab release [lindex $grabstack end]
00072 }
00073
00074 set err 1
00075 while {$err == 1} {
00076 set err [catch [list grab -global $itk_component(hull)]]
00077 if {$err == 1} {
00078 after 1000
00079 }
00080 }
00081
00082 lappend grabstack [list grab -global $itk_component(hull)]
00083
00084 tkwait variable [scope _wait($this)]
00085 return $_result
00086 }
00087 }
XCDG 0.95 (20 Oct 2004)