parent::constructor $args without eval

class Balloonwidget {
    inherit itk::Widget

    itk_option define -balloonhelp balloonHelp BalloonHelp ""

    private variable balloon_queue ""
    private variable destroy_queue ""

    public method enter
    public method leave
    public method balloon

    constructor { args } { 
 bind $itk_component(hull) <Enter> [code $this enter]
 bind $itk_component(hull) <Leave> [code $this leave]
 eval itk_initialize $args }
}

body Balloonwidget::enter { } {
    if {$balloon_queue != ""} {
 after cancel $balloon_queue
    }
    if {$itk_option(-balloonhelp) != ""} {
 set balloon_queue [after 750 [code $this balloon]]
    }
}

body Balloonwidget::leave { } {
    if {$balloon_queue != ""} {
 after cancel $balloon_queue
    }
    set destroy_queue [after 100 {catch {destroy .balloon_help}}]
}

body Balloonwidget::balloon { } {
    set t .balloon_help
    catch {destroy $t}
    toplevel $t
    wm overrideredirect $t 1

    if {[tk windowingsystem] == "aqua"} {
 #unsupported1 style $itk_component(hull) floating sideTitlebar
 ::tk::unsupported::MacWindowStyle style $t help none
    }

    label $t.l \
    -text " $itk_option(-balloonhelp) " \
 -relief solid \
 -bd 2 \
 -bg gold \
 -fg #000000 \
 -font font_b
    pack $t.l -fill both
    set x [expr [winfo pointerx $itk_component(hull)] + 8]
    set y [expr [winfo pointery $itk_component(hull)] + 20]
    if {[expr $x + [winfo reqwidth $t.l]] > [winfo screenwidth $t.l]} {
    set x [expr [winfo screenwidth $t.l] - [winfo reqwidth $t.l] - 2]
    }
    if {[expr $y + [winfo reqheight $t.l]] > [winfo screenheight $t.l]} {
    set y [expr $y - 20 - [winfo reqheight $t.l] - 2]
    }
    wm geometry $t +$x\+$y
    #bind $t <Enter> [list [after cancel $destroy_queue]]
    #bind $t <Leave> "catch {destroy .balloon_help}"
}

class SettingWidget {
   
    # Common variables
    private common widgets ; # array 

    # Procedures
    public proc refresh { a_parameter }
    public proc refreshAll { }

    # Member variables
    protected variable parameter ""
    private variable old_value ""
 private variable canbeblank 0

   
    # Methods
    protected method getValue ; # virtual
    public method setValue ; # virtual
   
    public method downloadFromSession
    protected method uploadToSessionIfChanged

    constructor { a_parameter } { }

}

body SettingWidget::constructor { a_parameter } {
    set parameter $a_parameter
    lappend widgets($a_parameter) $this
}

body SettingWidget::refresh { a_parameter } {
    if {[info exists widgets($a_parameter)]} {
 foreach i_widget $widgets($a_parameter) {
     $i_widget downloadFromSession
 }
    }
}

body SettingWidget::refreshAll { } {
    foreach i_parameter [array names widgets] {
 refresh $i_parameter
    }
}
   
body SettingWidget::getValue { } { error "Virtual method SettingWidget::getValue not overridden" }

body SettingWidget::setValue { } { error "Virtual method SettingWidget::getValue not overridden" }

body SettingWidget::uploadToSessionIfChanged { } {

 #added by luke on 9 November 2007.
 # If one presses return in a setting entry while it is blank, the interpreter gave an error
 # See bug 42. The if statement below catches that case and leaves the old_value unchanged
 if {([getValue] == "") && ($canbeblank == 0)} {
 $::session updateSetting $parameter $old_value 1 1 
 }
 ####################################################### 
    # if the current value doesn't match the old value
    if {[getValue] != $old_value} {
 # update the session with the current value
 $::session updateSetting $parameter [getValue] 1 1
 # update the old value
 set old_value [getValue]

  #added by luke on 3 December 2007
  #A hack to send the detector and reversephi keywords. reversephi should only
  #be sent to ipmosflm if the detector manufacturer is already set.
  if {$parameter == "detector_manufacturer"} {
   $::mosflm sendCommand "detector $old_value"
  }
  if {$parameter == "reverse_phi"} {
   if {([$::session getReversePhi]) && ([$::session getDetectorManufacturer] != "")} {
    $::mosflm sendCommand "detector [$::session getDetectorManufacturer] reversephi"
   } else {
    $::mosflm sendCommand "detector [$::session getDetectorManufacturer]"
   }
  }
  ###################################################################
    } else {
    }
}

body SettingWidget::downloadFromSession { } {
    set l_new_value [$::session getParameterValue $parameter]
    set old_value $l_new_value
    setValue $l_new_value
}

class Toolbutton {
    inherit Balloonwidget

    private common groups ; # array
    private proc releaseRadioGroup

    protected variable mode 0
    private variable tags {}

    private variable old_group ""

    private method enter
    private method leave
    protected method execute

    public method invoke
    public method cancel
    public method toggle
    public method query

    itk_option define -image image Image "" {
 if {$itk_option(-image) != ""} {
     $itk_component(button) configure \
  -image $itk_option(-image) \
  -width [expr [image width $itk_option(-image)] + 4] \
  -height [expr [image height $itk_option(-image)] + 4]
 }
    }
    itk_option define -group group Group "" {
 if {$itk_option(-group) != ""} {
     # remove from old group
     if {$old_group != ""} {
  set l_pos [lsearch $group($old_group) $this]
  set groups($old_group) [lreplace $groups($old_group) $l_pos $l_pos]
     }
     # set new group
     lappend groups($itk_option(-group)) $this
 }
    }

    itk_option define -disabledimage diabledImage Image ""
    itk_option define -activeimage activeImage Image ""
    itk_option define -type type Type "amodal"
    itk_option define -command command Command ""
    itk_option define -state state State "normal" {
 # If the toolbutton has been disabled
 if {$itk_option(-state) == "disabled"} {
     # Show the disabled imgage (if there is one)
     if {$itk_option(-disabledimage) != ""} {
  $itk_component(button) configure -image $itk_option(-disabledimage)
     }
     # Trigger "leave"
     leave
     # Turn the button off
     set mode 0
     # Remove mouse-over bindings
     bind $itk_component(button) <Enter> {}
     bind $itk_component(button) <Leave> {}
     # Remove 'Button' bindings
     set tags [bindtags $itk_component(button)]
     set tag_pos [lsearch $tags "Button"]
     if {$tag_pos > -1} {
  bindtags $itk_component(button) [lreplace $tags $tag_pos $tag_pos]
     }
 } else {
     # else it must be normal!
     if {$itk_option(-image) != ""} {
  $itk_component(button) configure -image $itk_option(-image)
     }
     # Don't fiddle with mode!
     #set mode 0
     # Set up mouse-over bindings
     bind $itk_component(button) <Enter> [code $this enter]
     bind $itk_component(button) <Leave> [code $this leave]
     # Restore 'Button' bindings
     set tags [bindtags $itk_component(button)]
     if {[lsearch $tags "Button"] == -1} {
  set tag_pos [lsearch $tags $itk_component(button)]
  incr tag_pos
  bindtags $itk_component(button) [linsert $tags $tag_pos "Button"]
     }
 } 
    }

    constructor { args } { }
}

body Toolbutton::constructor { args } {
    # Remove default enter/leave bindings
    bind $itk_component(hull) <Enter> {}
    bind $itk_component(hull) <Leave> {}
   
    itk_component add button {
 button $itk_interior.button \
     -relief flat \
     -command [code $this execute] \
     -takefocus 0 \
     -highlightthickness 0
    }
    pack $itk_component(button)

    eval itk_initialize $args

}

body Toolbutton::releaseRadioGroup { a_group a_toolbutton } {
    foreach i_toolbutton $groups($a_group) {
 if {$i_toolbutton != $a_toolbutton} {
     $i_toolbutton cancel
 }
    }
}

body Toolbutton::enter { } {
    Balloonwidget::enter
    if {($itk_option(-type) == "amodal") || ($mode == 0)} {
 $itk_component(button) configure -relief raised
    }
}

body Toolbutton::leave { } {
    Balloonwidget::leave
    if {($itk_option(-type) == "amodal") || ($mode == 0)} {
 $itk_component(button) configure -relief flat
    }
}

body Toolbutton::execute { } {
    # Take focus to force setting updates
    focus $itk_component(button)
    if {$itk_option(-type) == "modal"} {
 if {$mode == 0} {
     set mode 1
     $itk_component(button) configure -relief sunk -bg "\#eeeeee" -activebackground "\#eeeeee"
     if {[tk windowingsystem] == "aqua"} {
  if {$itk_option(-activeimage) != ""} {
      $itk_component(button) configure -image $itk_option(-activeimage)
  }
     }
 } else {
     set mode 0
     $itk_component(button) configure -relief raised -bg "\#dcdcdc" -activebackground "\#dcdcdc"
     if {[tk windowingsystem] == "aqua"} {
  if {$itk_option(-image) != ""} {
      $itk_component(button) configure -image $itk_option(-image)
  }
     }
 }
 if {$itk_option(-command) != ""} {
     uplevel \#0 $itk_option(-command) $mode
 }
    } elseif  {$itk_option(-type) == "radio"} {
 if {$mode == 0} {
     set mode 1
     # deselect other radios in group
     releaseRadioGroup $itk_option(-group) $this
     $itk_component(button) configure -relief sunk -bg "\#eeeeee" -activebackground "\#eeeeee"
     if {[tk windowingsystem] == "aqua"} {
  if {$itk_option(-activeimage) != ""} {
      $itk_component(button) configure -image $itk_option(-activeimage)
  }
     }
     if {$itk_option(-command) != ""} {
  uplevel \#0 $itk_option(-command) $mode
     }
 } 
    } else {
 if {$itk_option(-command) != ""} {
     uplevel \#0 $itk_option(-command)
 }
    }
}

body Toolbutton::invoke { { execute "execute" } } {
    if {($itk_option(-type) != "amodal")} {
 if {$mode == 0} {
     set mode 1
     $itk_component(button) configure -relief sunk -bg "\#eeeeee" -activebackground "\#eeeeee"
     if {[tk windowingsystem] == "aqua"} {
  if {$itk_option(-activeimage) != ""} {
      $itk_component(button) configure -image $itk_option(-activeimage)
  }
     }
 }
 if {$execute == "execute"} {
     if {$itk_option(-command) != ""} {
  uplevel \#0 $itk_option(-command) $mode
     }
 }
    } else {
 if {$execute == "execute"} {
     if {$itk_option(-command) != ""} {
  uplevel \#0 $itk_option(-command)
     }
 }
    }
}

body Toolbutton::toggle { { execute "execute" } } {
    $itk_component(button) invoke $execute
}

body Toolbutton::cancel { { execute "execute" } } {
    if {(($itk_option(-type) != "amodal") && ($mode == 1))} {
 set mode 0
 $itk_component(button) configure -relief flat -bg "\#dcdcdc" -activebackground "\#dcdcdc"
 if {[tk windowingsystem] == "aqua"} {
     if {$itk_option(-image) != ""} {
  $itk_component(button) configure -image $itk_option(-image)
     }
 }
 if {$execute == "execute"} {
     if {$itk_option(-command) != ""} {
  uplevel \#0 $itk_option(-command) $mode
     }
 }
    }
}

body Toolbutton::query { } {
    if {$itk_option(-type) != "amodal"} {
 return $mode
    } else {
 return ""
    }
}

usual Toolbutton {}

class SettingToolbutton {
    inherit Toolbutton SettingWidget

    public method execute
    public method invoke
    public method cancel
    private method getValue
    private method setValue

    constructor { a_parameter args } {
        Toolbutton::constructor -type "model"
        SettingWidget::constructor $a_parameter
    } {
 eval itk_initialize $args
    }
}

body SettingToolbutton::execute { } {
    Toolbutton::execute
    uploadToSessionIfChanged   
}

body SettingToolbutton::invoke { } {
    Toolbutton::invoke
    uploadToSessionIfChanged
}

body SettingToolbutton::cancel { } {
    Toolbutton::cancel
    uploadToSessionIfChanged
}

body SettingToolbutton::getValue { } {
    return $mode
}

body SettingToolbutton::setValue { a_value } {
    if {$a_value == 0} {
 Toolbutton::cancel
    } else {
 Toolbutton::invoke
    }
}

usual SettingToolbutton {
    usual Toolbutton
}

SettingToolbutton .c "fix_cell_indexing" \
 -image ::img::fix_cell16x16 \
 -activeimage ::img::fix_cell_on16x16 \
 -balloonhelp "Fix cell during indexing"

pack .c