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 gEntry {

    inherit Balloonwidget

    itk_option define -image image Image "" {

 if {$itk_option(-image) != ""} {

     $itk_component(icon) configure \

  -image $itk_option(-image) \

  -width [expr [image width $itk_option(-image)] + 4] \

  -height [expr [image height $itk_option(-image)] + 4]

 }

    }

    itk_option define -padxy padXY Pad 0 {

 $itk_component(padding) configure -borderwidth $itk_option(-padxy)

    }

    itk_option define -disabledbackground disabledBackground Background "#dcdcdc"

    itk_option define -disabledforeground disabledForeground DisabledForeground "#a9a9a9"

    itk_option define -foreground foreground Foreground "#000000" {

 if {$itk_option(-state) != "disabled"} {

     $itk_component(entry) configure -foreground $itk_option(-foreground)

 }

    }

    itk_option define -textbackground textBackground Background "#ffffff" {

 if {$itk_option(-state) != "disabled"} {

     $itk_component(entry) configure -background $itk_option(-textbackground)

     $itk_component(icon) configure -background $itk_option(-textbackground)

 }

 $itk_component(frame) configure -background $itk_option(-textbackground)

    }

    itk_option define -entryfont entryFont Font font_e {

 $itk_component(entry) configure -font $itk_option(-entryfont)

    }

    itk_option define -state state State "normal" {

 if {$itk_option(-state) == "disabled"} {

     $itk_component(entry) configure \

  -state disabled \

  -background $itk_option(-disabledbackground) \

  -foreground $itk_option(-disabledforeground)

     $itk_component(frame) configure \

  -background $itk_option(-disabledbackground)

     $itk_component(icon) configure \

  -background $itk_option(-disabledbackground)

 } else {

     $itk_component(entry) configure \

  -state normal \

  -background $itk_option(-textbackground) \

  -foreground $itk_option(-foreground)

     $itk_component(frame) configure \

  -background $itk_option(-textbackground)

     $itk_component(icon) configure \

  -background $itk_option(-textbackground)

 }

    }

    itk_option define -type type Type "string"

    itk_option define -defaultvalue defaultValue DefaultValue ""

    itk_option define -precision precision Precision "2"

    itk_option define -maximum maximum Maximum ""

    itk_option define -minimum minimum Minimum ""

    itk_option define -allowblank allowBlank AllowBlank "1"

    itk_option define -linkcommand linkCommand Command ""

    itk_option define -editcommand editCommand Command ""

    itk_option define -command command Command ""

    public method validate

    public method focusOut

    public method update

    public method query

    public method keystroke

    constructor { args } {

 

 itk_component add padding {

     frame $itk_interior.p \

  -relief flat \

     }

 pack $itk_component(padding) -fill x

 

 itk_component add frame {

     frame $itk_interior.p.f \

  -borderwidth 2 \

  -relief sunken

 } {

     usual

      keep -borderwidth

      keep -relief

 }

 pack $itk_component(frame) -fill x

 

 itk_component add icon {

     label $itk_interior.p.f.icon \

  -anchor c \

  -padx 0 \

  -pady 0 \

  -bd 0

 }

 pack $itk_component(icon) -side left

 itk_component add entry {

     entry $itk_interior.p.f.entry \

  -relief flat \

  -borderwidth 0 \

  -highlightthickness 0 \

  -selectborderwidth 0 \

  -validate all \

  -validatecommand [code $this validate %V %P]

     } {

  keep -insertbackground -insertborderwidth -insertwidth

  keep -insertontime -insertofftime

  keep -selectbackground -selectforeground

  keep -textvariable

  keep -width

  keep -justify

  keep -show

     }

 pack $itk_component(entry) -side right -fill x -expand true

 

 bind $itk_component(entry) <FocusOut> [code $this focusOut]

 bind $itk_component(entry) <Return> [code $this focusOut]

 bind $itk_component(entry) <KeyPress> [code $this keystroke]

 eval itk_initialize $args

    }

   

}

body gEntry::query { } {

    return [$itk_component(entry) get]

}

body gEntry::update { a_value } {

    if {[validate "focusout" $a_value]} {

 $itk_component(entry) configure -state normal

 $itk_component(entry) delete 0 end

 $itk_component(entry) insert 0 $a_value

 $itk_component(entry) configure -state $itk_option(-state) 

 focusOut -nolink

    }

}

body gEntry::validate { reason new_string } {

    switch -- $reason {

 key {

     switch -- $itk_option(-type) {

  real {

      if {[regexp -- {^-?\d*\.?\d*$} $new_string]} {

   return 1

      } else {

   bell

   return 0

      }

  }

  int {

      if {[regexp -- {^-?\d*$} $new_string]} {

   return 1

      } else {

   bell

   return 0

      }

  }

  default {

      return 1

  }

     }

 }

 forced {

     # Trust myself to only force it to accept well-formed values

     return 1

 }

 focusout {

     switch -- $itk_option(-type) {

  real {

      if {[regexp -- {^-?\.?$} $new_string]} {set new_string ""}

      if {$new_string == ""} {

   if {$itk_option(-allowblank)} {

       return 1

   } elseif {$itk_option(-defaultvalue) != ""} {

       set new_string $itk_option(-defaultvalue)

   } else {

       set new_string 0

   }

      }

      if {$itk_option(-maximum) != ""} {

   if {$new_string > $itk_option(-maximum)} {

       set new_string $itk_option(-maximum)

   }

      }

      if {$itk_option(-minimum) != ""} {

   if {$new_string < $itk_option(-minimum)} {

       set new_string $itk_option(-minimum)

   }

      }

      $itk_component(entry) delete 0 end

      $itk_component(entry) insert 0 [format %.$itk_option(-precision)f $new_string]

      # Need to turn valistaion back on, as setting the entry content

      #  here will have turned it off.

      after idle [list $itk_component(entry) configure -validate all]

      return 1

  }

  int {

      if {[regexp -- {^-?$} $new_string]} {set new_string ""}

      if {$new_string == ""} {

   if {$itk_option(-allowblank)} {

       return 1

   } elseif {$itk_option(-defaultvalue) != ""} {

       set new_string $itk_option(-defaultvalue)

   } else {

       set new_string 0

   }

      }

      if {$itk_option(-maximum) != ""} {

   if {$new_string > $itk_option(-maximum)} {

       set new_string $itk_option(-maximum)

   }

      }

      if {$itk_option(-minimum) != ""} {

   if {$new_string < $itk_option(-minimum)} {

       set new_string $itk_option(-minimum)

   }

      }

      $itk_component(entry) delete 0 end

      $itk_component(entry) insert 0 $new_string

      # Need to turn validation back on, as setting the entry content

      #  here will have turned it off.

      after idle [list $itk_component(entry) configure -validate all]

      return 1

  }

  default {

      return 1

  }

     }

 }

 default {

     return 1

 }

    }

}

body gEntry::focusOut { { a_link "-link" } } {

    $itk_component(entry) selection clear

    if {$itk_option(-command) != ""} {

 uplevel #0 [list $itk_option(-command) "[$itk_component(entry) get]"]

    }

    if { $a_link != "-nolink" } {

 if {$itk_option(-linkcommand) != ""} {

     uplevel #0 $itk_option(-linkcommand)

 }

    }

}

body gEntry::keystroke { } {

    if  {$itk_option(-editcommand) != ""} {

 uplevel #0 $itk_option(-editcommand)

    }

}

usual gEntry {

   #rename -disabledbackground -background background Background

   keep -textbackground -background

   keep -selectforeground -selectbackground

   keep -disabledbackground -disabledforeground

   keep -entryfont

   keep -padxy

}

# ###############################################################################

# FILEENTRY

# ###############################################################################

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 SettingEntry {

    inherit gEntry SettingWidget

#     itk_option define -parameter parameter Parameter "" {

#  set parameter $itk_option(-parameter)

#     }

    public method update

    public method getValue

    public method setValue

 public method publicUploadToSessionIfChanged

    constructor { a_parameter args } {

 eval gEntry::constructor $args

 SettingWidget::constructor $a_parameter

    } {

 bind $itk_component(entry) <FocusOut> +[code $this uploadToSessionIfChanged]

 bind $itk_component(entry) <Return> +[code $this uploadToSessionIfChanged]

    }

}

body SettingEntry::update { a_value } {

    gEntry::update $a_value

    uploadToSessionIfChanged

}

body SettingEntry::getValue { } {

    return [$itk_component(entry) get]

}

body SettingEntry::setValue { a_value } {

    $itk_component(entry) configure -state normal

    $itk_component(entry) delete 0 end

    $itk_component(entry) insert end $a_value

    $itk_component(entry) configure -state $itk_option(-state)

}

usual SettingEntry {

    usual gEntry

}

body SettingEntry::publicUploadToSessionIfChanged {} {

 uploadToSessionIfChanged

# puts "did it"

}

class Indexwizard {

    inherit itk::Widget

    constructor {args} { }

}

body Indexwizard::constructor { args } {

   

    # Toolbars ###############################################

    itk_component add spotfinding_toolbar {

 frame .c.spot

    }

    # Divider

    itk_component add spotfinding_divider1 {

 frame $itk_component(spotfinding_toolbar).div1 \

     -width 2 \

     -relief sunken \

     -bd 1

    }

    itk_component add beam_x_e {

 SettingEntry $itk_component(spotfinding_toolbar).bxe beam_x \

     -image ::img::beam_x16x16 \

     -balloonhelp "Beam x position" \

     -type real \

     -precision 2 \

     -width 6 \

     -justify right

    }

    itk_component add beam_y_e {

 SettingEntry $itk_component(spotfinding_toolbar).bye beam_y \

     -image ::img::beam_y16x16 \

     -balloonhelp "Beam y position" \

     -type real \

     -precision 2 \

     -width 6 \

     -justify right

    }

    itk_component add distance_e {

 SettingEntry $itk_component(spotfinding_toolbar).de distance \

     -image ::img::distance16x16 \

     -balloonhelp "Crystal to detector distance" \

     -type real \

     -precision 2 \

     -width 6 \

     -justify right

    }

    itk_component add spotfinding_divider2 {

 frame $itk_component(spotfinding_toolbar).div2 \

     -width 2 \

     -relief sunken \

     -bd 1

    }

    # Frames

#    pack $itk_component(spotfinding_toolbar) -side top -fill both

    # Spot finding panel

    ###############################################################

    grid $itk_component(spotfinding_toolbar) -row 0 -column 0  -sticky nswe

    pack $itk_component(spotfinding_divider1) -side top -fill both

    pack $itk_component(beam_x_e) -side top -fill both

    pack $itk_component(beam_y_e) -side top -fill both

    pack $itk_component(distance_e) -side top -fill both

 

    eval itk_initialize $args

}

# Launch and completion methods #####################################

usual Indexwizard {

}

#Indexwizard .c

#pack .c

class test {

 inherit itk::Widget

 constructor { args } {

  itk_option add hull.width hull.height

  

  $itk_component(hull) configure -width 1050 -height 768 

  wm minsize [winfo toplevel $itk_component(hull)] 1050 768

  pack propagate $itk_interior 0

  

  itk_component add spot {

         frame .c.spott

  }

  

  itk_component add index {

      Indexwizard $itk_component(spot).kk

  }

  

  itk_component add indexing {

      label $itk_component(spot).ttt \

   -text "aaaa"

  }

  

  pack $itk_component(spot) -side top -fill both

  grid $itk_component(spot) -row 1 -column 0  -sticky nswe

  pack $itk_component(indexing) -side top -fill both

#  pack $itk_component(index) -side top -fill both

  

 }

}

test .c

pack .c