gui/implementation/Widget.tcl


@implementation Widget {

  + newWithPath: aPath {
      return [[$self alloc] initWithPath: $aPath]
    }

  - initWithPath: aPath {
      set path $aPath
      return [$self init]
    }

  - init {} {
      $super init
      if {![string length $path]} {
        set path .$self
      }
      frame $path
      set callbacks(index) [Sequence new]
    }

  - path {} {
      return $path
    }

  - show {} {
      pack $path -fill both -expand 1
    }

  - hide {} {
      catch {[winfo manager $path] forget $path}
    }

  - dealloc {} {
      catch {destroy $path}
      return [$super dealloc]
    }

  - cursor: name {
      $path configure -cursor $name
      update idletasks
    }

  - cursor {} {
      return [$path cget -cursor]
    }

  - addCallback:forEvent: {callback event} {
      #- adding access to instance variables if not already done for this event
      if {![llength [array names callbacks $event,*]]} {
        set index [$callbacks(index) next]
        set callbacks($event,$index) [@getAccessToInstanceVariables $self]
      }
      set index [$callbacks(index) next]
      set callbacks($event,$index) $callback
      return $index
    }

  - removeCallbackForEvent:atIndex: {event index} {
      catch {unset callbacks($event,$index)}
    }

  - on:do: {event callback} {
      return [$self addCallback: $callback forEvent: $event]
    }

  - do:with: {event eventData} {
      if [string length [set fields [array names callbacks $event,*]]] {
        foreach field [lsort $fields] {
          eval $callbacks($field)
        }
      }
    }

  - callbackIndexesForEvent: event {
      set indexes {}
      set fields [array names callbacks $event,*]
      foreach field $field {
        lappend indexes [join [lreplace [split $field ,] 0 0] ,]
      }
      return $indexes
    }

  - callbackForEvent:atIndex: {event index} {
      if [info exists callbacks($event,$index)] {
        return $callbacks($event,$index)
      }
      return
    }

  - enableEvent:on: {eventList pathList} {
      foreach w $pathList {
        foreach e $eventList {
          bind $w <$e> "$self do: $e with: [@eventData]"
          eval bind $w [@removeBindingsOnDestroyEvent]
        }
      }
    }

  - disableEvent:on: {eventList pathList} {
      foreach w $pathList {
        foreach e $eventList {
          bind $w <$e> ""
        }
      }
    }
}