libgui/library/wingrab.tcl

   1 # wingrab.tcl -- grab support for Windows.
   2 # Copyright (C) 1997 Cygnus Solutions.
   3 # Written by Ian Lance Taylor <ian@cygnus.com>.
   4
   5 # Disable a list of windows.
   6
   7 proc WINGRAB_disable { args } {
   8   foreach w $args {
   9     ide_grab_support_disable [wm frame $w]
  10   }
  11 }
  12
  13 # Disable all top level windows, other than the argument, which are
  14 # children of `.'.  Note that if you do this, and then destroy the
  15 # frame of the only enabled window, your application will lose the
  16 # input focus to some other application.  Make sure that you reenable
  17 # the windows before calling wm transient or wm withdraw or destroy on
  18 # the only enabled window.
  19
  20 proc WINGRAB_disable_except { window } {
  21   foreach w [winfo children .] {
  22     if {$w != $window} then {
  23       ide_grab_support_disable [wm frame [winfo toplevel $w]]
  24     }
  25   }
  26 }
  27
  28 # Enable a list of windows.
  29
  30 proc WINGRAB_enable { args } {
  31   foreach w $args {
  32     ide_grab_support_enable [wm frame $w]
  33   }
  34 }
  35
  36 # Enable all top level windows which are children of `.'.
  37
  38 proc WINGRAB_enable_all {} {
  39   foreach w [winfo children .] {
  40     ide_grab_support_enable [wm frame [winfo toplevel $w]]
  41   }
  42 }
  43
  44 # The basic routine.  All commands are subcommands of this.
  45
  46 proc ide_grab_support {dispatch args} {
  47   global tcl_platform
  48
  49   if {[info commands WINGRAB_$dispatch] == ""} then {
  50     error "unrecognized key \"$dispatch\""
  51   }
  52
  53   # We only need to do stuff on Windows.
  54   if {$tcl_platform(platform) != "windows"} then {
  55     return
  56   }
  57
  58   eval WINGRAB_$dispatch $args
  59 }