Paste: delegation problem

! This is an attempt at a UI monad for modal interfaces
! Example:
! "end" ui-m return [ "first stage" <btn ] >> [ "second stage" <btn> ] >> [ <label> ] bind
! For some reason, though, ui-triggers can't display themselves, even though they delegate to gadgets
! Why is that?

USING:   kernel monads sequences accessors deques dlists quotations vectors fry ui.gadgets delegate combinators.lib
         ui.gadgets.buttons ;
IN: monads.ui
DEFER: ui-v?
! The ui-trigger class + friends
TUPLE: ui-trigger view views value ;
CONSULT: gadget ui-trigger view>> ;
: <ui-trigger> ( gadget -- ui-trigger ) <dlist> f ui-trigger boa ;
M: ui-trigger quot>> drop [ dup
   [ parent>> ] [ unparent ] [ value>> ] [ views>> pop-back >quotation ]
   quad call
   dup ui-v?
      [ value>> >>value ]
      [ [ add-gadget ] keep >>view ]
   when ] ;
: <btn> ( gadget -- button ) [ ] <button> ;
TUPLE: ui-trigger* view pointer ;
CONSULT: ui-trigger ui-trigger* view>> ;
C: <ui-trigger*> ui-trigger*
TUPLE: ui-v value ;

! monad interface
SINGLETON: ui-m INSTANCE: ui-m monad
MIXIN: ui INSTANCE: ui-trigger ui INSTANCE: ui-v ui INSTANCE: gadget ui
INSTANCE: ui monad
M: ui monad-of drop ui-m ;
M: ui-m return drop ui-v boa ;
M: ui-m fail "Error" throw ;
M: ui-trigger >>= '[ >vector _ [ views>> push-front ] keep ] ;
M: ui-v >>= value>> '[ _ swap call ] ;
M: gadget >>= <ui-trigger> >>= ;

! adding gadgets
GENERIC# add 1 ( parent child-quot -- parent )
M: ui-trigger add dupd [ views>> peek-front ] dip '[ _ swap <ui-trigger*> add-gadget ] swap push-all ;
M: gadget add call add-gadget ;