Main Page | Namespace List | Class Hierarchy | Alphabetical List | Class List | File List | Namespace Members | Class Members | File Members | Related Pages

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)