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

bugfixes.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 bugfixes.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 bugfixes.tcl$ 00025 ## ---------------------------------------------------------------------------- 00026 00027 ##---------------------------------------------------------------------------- 00028 ## the button in the combobox looks uggly, here are nicer versions 00029 ## of the downarrow and the uparrow 00030 ##---------------------------------------------------------------------------- 00031 ## \comment 00032 image create bitmap downarrow -file $env(YADA_IMAGES)/down.xbm 00033 image create bitmap uparrow -file $env(YADA_IMAGES)/up.xbm 00034 ## \endcomment 00035 00036 ##---------------------------------------------------------------------------- 00037 ## the shell widget is lame; this fixes it. 00038 ##---------------------------------------------------------------------------- 00039 body iwidgets::Shell::activate {} { 00040 00041 if {[winfo ismapped $itk_component(hull)]} { 00042 raise $itk_component(hull) . 00043 return 00044 } 00045 00046 if {($itk_option(-master) != {}) && \ 00047 [winfo exists $itk_option(-master)]} { 00048 wm transient $itk_component(hull) $itk_option(-master) 00049 } 00050 00051 set _wait($this) 0 00052 wm deiconify $itk_component(hull) 00053 if {$itk_option(-master) != ""} { 00054 raise $itk_component(hull) $itk_option(-master) 00055 } else { 00056 raise $itk_component(hull) . 00057 } 00058 tkwait visibility $itk_component(hull) 00059 00060 if {$itk_option(-modality) == "application"} { 00061 if {$grabstack != {}} { 00062 grab release [lindex $grabstack end] 00063 } 00064 00065 set err 1 00066 while {$err == 1} { 00067 set err [catch [list grab $itk_component(hull)]] 00068 if {$err == 1} { 00069 after 1000 00070 } 00071 } 00072 00073 lappend grabstack [list grab $itk_component(hull)] 00074 00075 tkwait variable [scope _wait($this)] 00076 return $_result 00077 00078 } elseif {$itk_option(-modality) == "global" } { 00079 if {$grabstack != {}} { 00080 grab release [lindex $grabstack end] 00081 } 00082 00083 set err 1 00084 while {$err == 1} { 00085 set err [catch [list grab -global $itk_component(hull)]] 00086 if {$err == 1} { 00087 after 1000 00088 } 00089 } 00090 00091 lappend grabstack [list grab -global $itk_component(hull)] 00092 00093 tkwait variable [scope _wait($this)] 00094 return $_result 00095 } 00096 }

YADA 2.0-alpha (20 Oct 2004)