scripts/mytoplevel.itk

   1 # vim: foldmarker=<<<,>>> ft=tcl foldmethod=marker shiftwidth=4 ts=4
   2
   3 # Based on the itk::Toplevel class, with the addition of the -menu
   4 # link to allow configuring the toplevel's menu
   5
   6 class tlc::Mytoplevel {
   7         inherit itk::Archetype
   8
   9         constructor {args} {}
  10         destructor {}
  11
  12         itk_option define -title title Title ""
  13
  14         private {
  15                 variable topw
  16
  17                 method checkbackground {}
  18         }
  19 }
  20
  21
  22 configbody tlc::Mytoplevel::title { #<<<
  23         wm title $topw $itk_option(-title)
  24 }
  25
  26 #>>>
  27 body tlc::Mytoplevel::constructor {args} { #<<<
  28         set itk_interior        [namespace tail $this]
  29         set topw                        $itk_interior
  30
  31         itk_component add hull {
  32                 toplevel $topw -class [namespace tail [info class]]
  33         } {
  34                 keep -cursor -takefocus -menu -background
  35         }
  36         $topw configure -background \
  37                         [ttk::style lookup $ttk::currentTheme -background]
  38         bind tlc-delete-$topw <Destroy> [code itcl::delete object $this]
  39         bindtags $topw [concat [list tlc-delete-$topw] [bindtags $topw]]
  40         bind $topw <<ThemeChanged>> [code $this checkbackground]
  41
  42         itk_initialize {*}$args
  43 }
  44
  45 #>>>
  46 body tlc::Mytoplevel::destructor {} { #<<<
  47         if {[winfo exists $topw]} {
  48                 set bindtags    [bindtags $topw]
  49                 set idx         [lsearch $bindtags tlc-delete-$topw]
  50                 if {$idx != -1} {
  51                         bindtags $topw [lreplace $bindtags $idx $idx]
  52                 }
  53                 destroy $topw
  54         }
  55 }
  56
  57 #>>>
  58 body tlc::Mytoplevel::checkbackground {} { #<<<
  59         if {[winfo exists $topw]} {
  60                 set new [ttk::style lookup $ttk::currentTheme -background]
  61                 $topw configure -background $new
  62         }
  63 }
  64
  65 #>>>