;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; basic UI widget
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define gui-widget-debug-count 0)

;; debug
define box-debug-id(box)
  if {null? box}
    -1
    box[debug-id:]

define new-basic-widget()
  ;; basic box object
  define lay-box flexlay:new-box()
  ;; widget text
  define text ""
  ;; widget hotkey
  define hotkey ""
  ;; each widget need it, so why not
  define active-flag #f
  ;; default action (usually on-click)
  define action #nil
  ;; event handlers to be set from the properties (sink phase)
  define on-sink #nil ;; assoc list
  ;; event handlers to be set from the properties (bubble phase)
  define on-bubble #nil ;; assoc list
  ;; called by "initialize:"
  define on-init #nil
  ;; if positive, do not send notifications
  define bulk-operation 0
  ;; base style
  define style #nil
  ;; override style properties (dict)
  define over-style #nil
  ;; dict, filled with property names manually set from the layout.
  ;; required to stop stype defaults from overriding them.
  ;; this is because style defaults are applied after parsing the whole layout.
  ;; reset to #t in `%setup-style-defaults:`.
  ;; if #t, it means "don't remember property names anymore"
  define user-inited-props #nil
  ;;
  ;;TODO: remove old handlers!
  define add-handler-to(name value sinking)
    ;printf "on: %o\n" name
    assert {{null? value} or {procedure? value}} "invalid event handler"
    define hh cons(name value)
    if sinking
      {on-sink := cons(hh on-sink)}
      {on-bubble := cons(hh on-bubble)}
    #t
  ;;TODO: remove old handlers!
  define add-handler(name value)
    case name
      (on-key-down:)
        add-handler-to('KEY-DOWN value #t)
      (on-key-down-bubble:)
        add-handler-to('KEY-DOWN value #f)
      (on-key-up:)
        add-handler-to('KEY-UP value #t)
      (on-key-up-bubble:)
        add-handler-to('KEY-UP value #f)
      (on-mouse-down:)
        add-handler-to('MOUSE-DOWN value #t)
      (on-mouse-down-bubble:)
        add-handler-to('MOUSE-DOWN value #f)
      (on-mouse-up:)
        add-handler-to('MOUSE-UP value #t)
      (on-mouse-up-bubble:)
        add-handler-to('MOUSE-UP value #f)
      (on-mouse-motion:)
        add-handler-to('MOUSE-MOTION value #t)
      (on-mouse-motion-bubble:)
        add-handler-to('MOUSE-MOTION value #f)
      (on-mouse-wheel:)
        add-handler-to('MOUSE-WHEEL value #t)
      (on-mouse-wheel-bubble:)
        add-handler-to('MOUSE-WHEEL value #f)
      (on-text-input:)
        add-handler-to('TEXT-INPUT value #t)
      (on-text-input-bubble:)
        add-handler-to('TEXT-INPUT value #f)
      (on-broadcast:)
        add-handler-to('BROADCAST value #t)
      (on-broadcast-bubble:)
        add-handler-to('BROADCAST value #f)
      (on-event:)
        add-handler-to('ANY-EVENT value #t)
      (on-event-bubble:)
        add-handler-to('ANY-EVENT value #f)
      (on-window-focus:)
        add-handler-to('WINDOW-FOCUS value #t)
      (on-window-focus-bubble:)
        add-handler-to('WINDOW-FOCUS value #f)
      (on-window-blur:)
        add-handler-to('WINDOW-BLUR value #t)
      (on-window-blur-bubble:)
        add-handler-to('WINDOW-BLUR value #f)
      else
        ;printf "pass: %o\n" name
        #f
  ;;
  define call-handler(self evt sinking)
    if evt[alive?:]
      then
        define hproc lax-cdr(assq(evt[type:] (if sinking on-sink on-bubble)))
        if {procedure? hproc}
          if {evt[type:] eq? 'BROADCAST}
            then
              if {keyword? evt[broadcast-type:]}
                hproc self evt evt[broadcast-type:]
            else
              hproc self evt
  ;;
  define call-any-event-handler(self evt sinking)
    if evt[alive?:]
      then
        define hproc assq('ANY-EVENT (if sinking on-sink on-bubble))
        if {procedure? lax-cdr(hproc)}
          hproc self evt
  ;;
  gset! gui-widget-debug-count {gui-widget-debug-count + 1}
  define debug-id gui-widget-debug-count
  ;;
  define pass-mouse-event(cbox evt)
    if {not-null? cbox}
      then
        define ox evt[x:]
        define oy evt[y:]
        try-finally
          lambda ()
            {evt[x:] := cbox[gx->local: evt[gx:]]}
            {evt[y:] := cbox[gy->local: evt[gy:]]}
            cbox[handle-event: evt]
          lambda ()
            {evt[x:] := ox}
            {evt[y:] := oy}
  ;;
  ;define debug-dump(msg self evt)
  ;  printf "%s: %3d:[%s%o] active=%o; selectable=%o; udata=%o; src=%o\n"
  ;    msg
  ;    box-debug-id(self)
  ;    evt[broadcast-type:]
  ;    self[type:]
  ;    self[active-flag:]
  ;    self[selectable?:]
  ;    evt[user-data:]
  ;    evt[source:]
  ;;
  method-lambda basic-widget
    debug-id: (self)
      debug-id
    super: (self)
      lay-box
    type: (self)
      basic-widget:
    layout-box: (self)
      lay-box
    desktop: (self)
      define par self[parent:]
      if {null? par}
        #nil
        par[desktop:]
    desktop-set!: (self value)
      error "cannot set desktop for non-window widget"
    top-widget?: (self)
      #f
    parent: (self)
      if self[top-widget?:]
        #nil
        self[parent-box:]
    on-init: (self)
      on-init
    on-init-set!: (self value)
      assert {{null? value} or {procedure? value}} "on-init property should be proc or null"
      {on-init := value}
      self
    %call-on-init: (self)
      if {procedure? on-init}
        on-init self
      self
    initialize: (self)
      self[%call-on-init:]
      define cbox self[first-child:]
      while {not-null? cbox}
        cbox[initialize:]
        {cbox := cbox[next-sibling:]}
      self
    ;;
    text: (self)
      text
    text-set!: (self value)
      assert {string? value} "invalid text property"
      {text := value}
      self
    hotkey: (self)
      hotkey
    hotkey-set!: (self value)
      assert {string? value} "hotkey should be a string"
      {hotkey := value}
      self
    action: (self)
      action
    action-set!: (self value)
      assert {{null? value} or {procedure? value}} "action should be null or closure"
      {action := value}
      self
    has-action?: (self)
      {procedure? self[action:]}
    perform-action: (self)
      define act self[action:]
      if {procedure? act}
        act(self)
      self
    ;;
    activate-widget: (self cbox)
      if {{not-null? cbox} and cbox[selectable?:]}
        self[top-widget:][activate-widget: cbox]
    ;;
    activate-self!: (self)
      self[activate-widget: self]
    ;; should return boolean.
    ;; return #t if can be activated.
    selectable?: (self)
      #f
    want-text-input?: (self)
      #t
    ;; vertical scrollbar interface
    v-scrollbar-min: (self)
      0
    v-scrollbar-max: (self)
      0
    v-scrollbar-current: (self)
      0
    v-scrollbar-scroll-to: (self position)
      self
    ;; horizontal scrollbar interface
    h-scrollbar-min: (self)
      0
    h-scrollbar-max: (self)
      0
    h-scrollbar-current: (self)
      0
    h-scrollbar-scroll-to: (self position)
      self
    ;;
    active-flag: (self)
      active-flag
    active-flag-set!: (self value)
      assert {boolean? value} "invalid active flag value"
      if {self[want-text-input?:] and self[active-window?:]}
        if value
          self[%start-text-input:]
          self[%stop-text-input:]
      {active-flag := value}
      self
    active?: (self)
      ;; it was like that to draw widgets as inactive for inactive windows.
      ;; but now inactive windows are shaded anyway.
      ;{self[active-flag:] and self[active-window?:]}
      self[active-flag:]
    ;; this actually intersects it with the current clip
    update-clip-rect: (self lx ly wdt hgt)
      lgfx:intersect-clip-rect lx ly wdt hgt
      self
    ;; this actually intersects it with the current clip
    set-clip-rect: (self)
      self[update-clip-rect: 0 0 self[final-width:] self[final-height:]]
      self
    set-clip-rect-with-inset: (self)
      self[update-clip-rect:
        self[inset-left:]
        self[inset-top:]
        {self[final-width:] - self[inset-left:] - self[inset-right:]}
        {self[final-height:] - self[inset-top:] - self[inset-bottom:]}]
      self
    paint-with-clip: (self)
      lgfx:run-and-restore-clip
        lambda ()
          self[set-clip-rect:]
          self[paint:]
    ;; call "paint:" method for all children
    paint-children: (self)
      define cbox self[first-child:]
      define old-gofs-x lgfx:global-offset-x
      define old-gofs-y lgfx:global-offset-y
      while {not-null? cbox}
        if {not cbox[ignore?:]}
          then
            gset! lgfx:global-offset-x {old-gofs-x + cbox[final-x:]}
            gset! lgfx:global-offset-y {old-gofs-y + cbox[final-y:]}
            cbox[paint-with-clip:]
        {cbox := cbox[next-sibling:]}
      gset! lgfx:global-offset-x old-gofs-x
      gset! lgfx:global-offset-y old-gofs-y
      self
    ;; paint contents and children.
    ;; do not call this for ignored widgets!
    paint: (self)
      if {not self[ignore?:]}
        self[paint-children:]
      self
    ;;
    %pass-event-to-destination: (self evt)
      define cbox
      define dest evt[destination:]
      if (and evt[alive?:]
          {not-null? dest}
          {not {dest eq? self}})
        then
          {cbox := self[first-child:]}
          while {not-null? cbox}
            if {{cbox eq? dest} or cbox[my-child?: dest]}
              then
                case evt[type:]
                  (MOUSE-DOWN MOUSE-UP MOUSE-MOTION MOUSE-WHEEL)
                    pass-mouse-event cbox evt
                  else
                    cbox[handle-event: evt]
                {cbox := #nil}
              else
                {cbox := cbox[next-sibling:]}
          #t
        else
          #f
    ;; propagate event to children
    ;; return value doesn't matter.
    sink-event: (self evt)
      define cbox
      define dest evt[destination:]
      if {evt[alive?:] and {not self[%pass-event-to-destination: evt]}}
        case evt[type:]
          (KEY-DOWN KEY-UP)
            cond
              {evt[key-broadcast?:] or {not-null? dest}}
                {cbox := self[first-child:]}
                while {{not-null? cbox} and evt[alive?:]}
                  cbox[handle-event: evt]
                  {cbox := cbox[next-sibling:]}
              else
                {cbox := self[active-top-child:]}
                if {not-null? cbox}
                  cbox[handle-event: evt]
          (MOUSE-DOWN MOUSE-UP MOUSE-MOTION MOUSE-WHEEL)
            cond
              {not-null? dest}
                ;printf "***[%o] %o\n" evt[type:] dest[type:]
                {cbox := self[first-child:]}
                while {{not-null? cbox} and evt[alive?:]}
                  pass-mouse-event cbox evt
                  {cbox := cbox[next-sibling:]}
              else
                ;; route down to the child at the given coords
                pass-mouse-event self[find-base-child-at: evt[x:] evt[y:]] evt
          (BROADCAST)
            ;; broadcasts are sent even to ignored boxes
            self[%broadcast-event: evt first-child: next-sibling:]
          else
            {cbox := self[active-top-child:]}
            if {not-null? cbox}
              cbox[handle-event: evt]
      ;; keys with modifiers are broadcasted too (if not eaten/cancelled)
      ;; they are broadcasted even to ignored boxes
      ;if {evt[alive?:] and evt[any-mods?:]}
      ;; broadcast all keys. this is useful for hotkey handling.
      ;; do not broadcast key event if it has a destination, though
      if (and evt[alive?:]
              {null? evt[destination:]}
              self[top-widget?:]
              {not evt[key-broadcast?:]})
        then
          case evt[type:]
            (KEY-DOWN KEY-UP)
              evt[key-broadcast!:]
              {cbox := self[first-child:]}
              ;if {not-null? cbox}
              ;  printf "broadcasting keyboard event! %o\n" evt[keysym:]
              while {{not-null? cbox} and evt[alive?:]}
                cbox[handle-event: evt]
                {cbox := cbox[next-sibling:]}
            else #void
      #void
    ;; special
    desktop-broadcast: (self name value)
      define dd self[desktop:]
      if {null? dd}
        {dd := self[top-widget:]}
      if {not-null? dd}
        then
          define evt new-gui-event('BROADCAST)
          {evt[broadcast-type:] := name}
          {evt[source:] := self}
          {evt[user-data:] := value}
          dd[handle-event: evt]
      self
    window-broadcast: (self name value)
      define dd self[top-widget:]
      if {not-null? dd}
        then
          define evt new-gui-event('BROADCAST)
          {evt[broadcast-type:] := name}
          {evt[source:] := self}
          {evt[user-data:] := value}
          dd[handle-event: evt]
      self
    ;; widget or #nil
    radio-get-marked: (self group)
      define evt new-gui-event('BROADCAST)
      {evt[broadcast-type:] := radio-get-marked:}
      {evt[source:] := #nil}
      {evt[user-data:] := group}
      self[%send-event-from-top-widget: evt]
      if {null? evt}
        #nil
        evt[source:]
    ;; broadcasts are sent even to ignored boxes
    %broadcast-event: (self evt kw-first kw-next)
      define cbox call(kw-first)
      while {{not-null? cbox} and evt[alive?:]}
        cbox[handle-event: evt]
        {cbox := invoke(cbox kw-next)}
      self
    ;;
    %handle-widget-activation-event: (self evt)
      define set-udata-to-true {true? evt[user-data:]}
      {evt[user-data:] := #f}
      ;; if this widget is not active, and we already found the one to activate,
      ;; we can skip propagating messages to children.
      ;; this is because interally the whole chain from the child up to the
      ;; top-level widget is marked as active, so if this one is inactive,
      ;; then all its children are inactive too.
      ;; it doesn't help much, but hey, why not.
      if {{not set-udata-to-true} or self[active-flag:]}
        then
          define cbox self[first-child:]
          while {{not-null? cbox} and evt[alive?:]}
            cbox[handle-event: evt]
            if {true? evt[user-data:]}
              then
                {set-udata-to-true := #t}
                {evt[user-data:] := #f}
            {cbox := cbox[next-sibling:]}
      ;;
      {evt[user-data:] := #f}
      cond
        {evt[source:] eq? self}
          {self[active-flag:] := #t}
          {evt[user-data:] := #t}
        set-udata-to-true
          {self[active-flag:] := #t}
          if {not self[top-widget?:]}
            {evt[user-data:] := #t}
        else
          {self[active-flag:] := #f}
      self
    ;;
    %handle-next-prev-tab-event: (self evt kw-first kw-next)
      if {self[selectable?:] and self[active-flag:]}
        {evt[user-data:] := self}
      ;;
      define cbox call(kw-first)
      while {{not-null? cbox} and evt[alive?:]}
        cbox[handle-event: evt]
        {cbox := invoke(cbox kw-next)}
      ;;
      if (and evt[alive?:]
              self[selectable?:]
              {not self[active-flag:]}
              {not-null? evt[user-data:]})
        then
          {evt[user-data:] := self}
          evt[eat!:]
      self
    ;;
    %handle-next-tab-event: (self evt)
      self[%handle-next-prev-tab-event: evt first-child: next-sibling:]
    %handle-prev-tab-event: (self evt)
      self[%handle-next-prev-tab-event: evt last-child: prev-sibling:]
    ;;
    %handle-first-last-tab-event: (self evt kw-first kw-next)
      define cbox call(kw-first)
      while {{not-null? cbox} and evt[alive?:]}
        cbox[handle-event: evt]
        {cbox := invoke(cbox kw-next)}
      ;;
      if {evt[alive?:] and self[selectable?:]}
        then
          {evt[user-data:] := self}
          evt[eat!:]
      self
    ;;
    %handle-first-tab-event: (self evt)
      self[%handle-first-last-tab-event: evt first-child: next-sibling:]
    %handle-last-tab-event: (self evt)
      self[%handle-first-last-tab-event: evt last-child: prev-sibling:]
    ;;
    %start-text-input: (self)
      sdl:start-text-input()
      self
    %stop-text-input: (self)
      sdl:stop-text-input()
      self
    ;; event handler. should pass the event to the destination.
    ;; return value doesn't matter.
    handle-event: (self evt)
      ;printf "%o: %s\n" box-debug-id(self) evt[type:]
      if evt[alive?:]
        case evt[type:]
          (ACTIVATE-WIDGET)   self[%handle-widget-activation-event: evt]
          (NEXT-TAB-WIDGET)   self[%handle-next-tab-event: evt]
          (PREV-TAB-WIDGET)   self[%handle-prev-tab-event: evt]
          (FIRST-TAB-WIDGET)  self[%handle-first-tab-event: evt]
          (LAST-TAB-WIDGET)   self[%handle-last-tab-event: evt]
          (WINDOW-FOCUS WINDOW-BLUR)
            call-any-event-handler self evt #t
            call-handler self evt #t
            if self[want-text-input?:]
              case evt[type:]
                (WINDOW-BLUR)
                  if {self[want-text-input?:] and self[active?:]}
                    self[%stop-text-input:]
                (WINDOW-FOCUS)
                  if {self[want-text-input?:] and self[active?:]}
                    self[%start-text-input:]
                else #void
            self[%broadcast-event: evt first-child: next-sibling:]
            call-any-event-handler self evt #f
            call-handler self evt #f
          else
            define dest evt[destination:]
            ;if {not-null? dest}
            ;  printf "targeted(%s): self=%o(%s); dest=%o(%s); my-child: %o; self: %o\n"
            ;    evt[type:]
            ;    box-debug-id(self)
            ;    invoke(self type:)
            ;    box-debug-id(dest)
            ;    invoke(dest type:)
            ;    call(my-child?: dest)
            ;    {dest eq? self}
            if {{null? dest} or {dest eq? self} or self[my-child?: dest]}
              then
                ;if {not-null? dest} printf("TARGET!\n")
                call-any-event-handler self evt #t
                call-handler self evt #t
                if {not {dest eq? self}}
                  self[sink-event: evt]
                call-any-event-handler self evt #f
                call-handler self evt #f
    ;; for internal use only!
    ;; sends from the top widget
    %send-event-from-top-widget: (self evt)
      if evt[alive?:]
        self[top-widget:][handle-event: evt]
      evt
    ;;
    %send-widget-activation-event: (self cbox)
      define evt new-gui-event('ACTIVATE-WIDGET)
      {evt[source:] := cbox}
      self[%send-event-from-top-widget: evt]
    ;
    %send-navigation-event: (self event-type)
      define evt self[%send-event-from-top-widget: new-gui-event(event-type)]
      if evt[alive?:]
        #nil
        evt[user-data:]
    ;
    %send-next-tab-event: (self)
      self[%send-navigation-event: 'NEXT-TAB-WIDGET]
    %send-prev-tab-event: (self)
      self[%send-navigation-event: 'PREV-TAB-WIDGET]
    %send-first-tab-event: (self)
      self[%send-navigation-event: 'FIRST-TAB-WIDGET]
    %send-last-tab-event: (self)
      self[%send-navigation-event: 'LAST-TAB-WIDGET]
    ;;
    %send-window-focus-event: (self)
      self[%send-event-from-top-widget: new-gui-event('WINDOW-FOCUS)]
    %send-window-blur-event: (self)
      self[%send-event-from-top-widget: new-gui-event('WINDOW-BLUR)]
    ;;
    %send-broadcast-event:
      case-lambda send-bc
        (self bc-type)
          send-bc self bc-type #nil
        (self bc-type src)
          define evt new-gui-event('BROADCAST)
          {evt[broadcast-type:] := bc-type}
          {evt[source:] := src}
          self[%send-event-from-top-widget: evt]
    ;; box or #nil
    active-top-child: (self)
      define res #nil
      define cbox self[first-child:]
      while {{null? res} and {not-null? cbox}}
        if cbox[active-flag:]
          {res := cbox}
          {cbox := cbox[next-sibling:]}
      res
    active-child: (self)
      define res self[active-top-child:]
      if {not-null? res}
        then
          define cbox res[active-child:]
          if {not-null? cbox}
            {res := cbox}
      res
    ;; utilities
    top-widget: (self)
      define res self
      define par self
      while {not-null? par}
        {res := par}
        {par := par[parent:]}
      res
    x->global: (self lx)
      while {not-null? self}
        inc! lx self[final-x:]
        {self := self[parent:]}
      lx
    y->global: (self ly)
      while {not-null? self}
        inc! ly self[final-y:]
        {self := self[parent:]}
      ly
    gx->local: (self gx)
      dec! gx self[final-x:]
      if {not-null? self[parent:]}
        self[parent:][gx->local: gx]
        gx
    gy->local: (self gy)
      dec! gy self[final-y:]
      if {not-null? self[parent:]}
        self[parent:][gy->local: gy]
        gy
    xy-in-box?: (self lx ly)
      (and {not self[ignore?:]}
           within?(lx 0 self[final-width:])
           within?(ly 0 self[final-height:]))
    ;; deepest child
    find-child-at: (self lx ly)
      define res #nil
      define cbox #nil
      if self[xy-in-box?: lx ly]
        then
          {cbox := self[last-child:]}
          while {{not-null? cbox} and {null? res}}
            {res := cbox[find-child-at: {lx - cbox[final-x:]}
                                        {ly - cbox[final-y:]}]}
            if {null? res}
              {cbox := cbox[prev-sibling:]}
          if {null? res}
            {cbox := self}
            {cbox := res}
      cbox
    ;; first-level child
    find-base-child-at: (self lx ly)
      define cbox #nil
      if self[xy-in-box?: lx ly]
        then
          {cbox := self[last-child:]}
          while {{not-null? cbox} and
                 {not cbox[xy-in-box?: {lx - cbox[final-x:]}
                                       {ly - cbox[final-y:]}]}}
            {cbox := cbox[prev-sibling:]}
      cbox
    ;; close parent window
    close-window: (self)
      define desk self[desktop:]
      if {not-null? desk}
        desk[close-window: self[top-widget:]]
      self
    ;;
    active-window?: (self)
      self[parent:][active-window?:]
    ;;
    find-widget: (self id)
      flexlay:find-box-by-id self[top-widget:] id
    ;;
    find-child-widget: (self id)
      flexlay:find-box-by-id self id
    ;;
    style: (self) style
    %style-set!: (self value) {style := value}
    ;;
    over-style: (self) over-style
    ;;
    ;; use this to override various style properties
    style-prop-set!: (self name value)
      assert {keyword? name} "style property name should be a keyword"
      if void-object?(value)
        then
          ;; remove property
          if {dict? over-style}
            ::dict:remove! over-style name
        else
          if {null? over-style}
            {over-style := ::dict:new()}
          ::dict:put! over-style name value
    ;;
    %get-style: (self)
      define style #nil
      define cbox self
      while {{null? style} and {not-null? cbox}}
        {style := cbox[style:]}
        {cbox := cbox[parent:]}
      style
    ;;
    style-prop:
      case-lambda style-prop-mth
        (self name)
          define res #void
          define stl self[over-style:]
          if {dict? stl}
            {res := ::dict:find-nf(stl name #void)}
          if {void-object?(res) and {procedure? {stl := self[%get-style:]}}}
            {res := stl[get-widget-property: self[type:] name #void]}
          assert {not void-object?(res)}
            string-append("property \"" symbol->string(name) "\" not found for widget \""
                          symbol->string(self[type:]) "\"")
          res
        (self name default-value)
          define res #void
          define stl self[over-style:]
          if {dict? stl}
            {res := ::dict:find-nf(stl name #void)}
          if {void-object?(res) and {procedure? {stl := self[%get-style:]}}}
            {res := stl[get-widget-property: self[type:] name #void]}
          if void-object?(res)
            default-value
            res
    ;;
    style-color-prop: (self base-name)
      self[style-prop:
        (if self[active?:]
           string->symbol(string-append(base-name "-color:"))
           string->symbol(string-append(base-name "-color-inactive:")))]
    ;;
    ;; autoresets `user-inited-props`
    %get-user-inited-props: (self)
      define res user-inited-props
      {user-inited-props := #t}
      res
    ;;
    %remember-user-inited-prop: (self name)
      if {{symbol? name} and {not {true? user-inited-props}}}
        then
          if {null? user-inited-props}
            {user-inited-props := ::dict:new()}
          ::dict:put! user-inited-props name #t
    ;;
    %setup-style-defaults: (self)
      define style self[%get-style:]
      if {not-null? style}
        style[setup-widget-defaults: self self[type:] self[%get-user-inited-props:]]
      define cbox self[first-child:]
      while {not-null? cbox}
        cbox[%setup-style-defaults:]
        {cbox := cbox[next-sibling:]}
    ;;
    begin-bulk-operation: (self)
      inc! bulk-operation
      ;self
      bulk-operation
    end-bulk-operation: (self)
      assert {dec!(bulk-operation) >= 0} "inbalanced bulk operations"
      ;self
      bulk-operation
    %bulk-counter: (self)
      bulk-operation
    ;;
    send-desktop-notify:
      case-lambda
        (self name)
          assert {keyword? name} "invalid notification"
          if {zero? bulk-operation}
            ;post-broadcast-event name self
            self[desktop-broadcast: name #void]
          self
        (self name value)
          assert {keyword? name} "invalid notification"
          if {zero? bulk-operation}
            ;post-broadcast-event name self value
            self[desktop-broadcast: name value]
          self
    ;;
    send-window-notify:
      case-lambda
        (self name)
          assert {keyword? name} "invalid notification"
          if {zero? bulk-operation}
            ;post-broadcast-event name self
            self[window-broadcast: name #void]
          self
        (self name value)
          assert {keyword? name} "invalid notification"
          if {zero? bulk-operation}
            ;post-broadcast-event name self value
            self[window-broadcast: name value]
          self
    ;;
    property-changed: (self name value)
      if {keyword? name}
        then
          self[%remember-user-inited-prop: name]
          case name
            (h-inset:)
              self[%remember-user-inited-prop: inset-left:]
              self[%remember-user-inited-prop: inset-right:]
            (v-inset:)
              self[%remember-user-inited-prop: inset-top:]
              self[%remember-user-inited-prop: inset-bottom:]
            (inset:)
              self[%remember-user-inited-prop: inset-left:]
              self[%remember-user-inited-prop: inset-right:]
              self[%remember-user-inited-prop: inset-top:]
              self[%remember-user-inited-prop: inset-bottom:]
            (fixed-width:)
              self[%remember-user-inited-prop: min-width:]
              self[%remember-user-inited-prop: max-width:]
              self[%remember-user-inited-prop: pref-width:]
            (fixed-height:)
              self[%remember-user-inited-prop: min-height:]
              self[%remember-user-inited-prop: max-height:]
              self[%remember-user-inited-prop: pref-height:]
            (no-expand:)
              case value
                (x:)
                  self[%remember-user-inited-prop: max-width:]
                (y:)
                  self[%remember-user-inited-prop: max-height:]
                (both:)
                  self[%remember-user-inited-prop: max-width:]
                  self[%remember-user-inited-prop: max-height:]
                else error("invalid \"no-expand:\" value")
            else #void
    ;;
    handle-property: (self name value)
      ;printf "basic-hpp; self=%d; name=%o\n" box-debug-id(self) name
      ;printf "basic-prop: %o is %o\n" name value
      self[property-changed: name value]
      case name
        (text:)
          {self[text:] := value}
          #t
        (action:)
          {self[action:] := value}
          #t
        (style:)
          assert {symbol? value} "style name should be an object"
          ;printf "setting base style \"%o\" for \"%o\"\n" value self[type:]
          {style := ::dict:find(styles value)}
          assert {procedure? style} "style should be an object"
          #t
        (over-style:)
          ;printf "000: over-style: %o\n" value
          assert {{null? value} or {pair? value}} "invalid overlay style value"
          if {not {car(value) eq? properties:}}
            {value := cons(value #nil)}
            {value := cdr(value)}
          ;printf "001: over-style: %o\n" value
          while {not-null? value}
            ;printf "002: set %o to %o\n" caar(value) cadar(value)
            {self[style-prop: caar(value)] := cadar(value)}
            {value := cdr(value)}
          #t
        (hotkey:)
          {self[hotkey:] := value}
          #t
        (on-init:)
          {self[on-init:] := value}
          #t
        else
          if add-handler(name value)
            #t
            lay-box handle-property: self name value
    else
      lay-box
