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)