Paste: Layout Protocol rough draft

Author: bogiebro
Mode: factor
Date: Fri, 7 Aug 2009 18:15:23
Plain Text |
! This hasn't been tested or anything
! it's just an idea

MIXIN: layout

! Get whatever extra layout info is used
GENERIC: (layout-info) ( gadget parent -- info )
M: layout (layout-info) 2drop f ;

: layout-info ( gadget -- info ) dup parent>> (layout-info) ;

<PRIVATE

: move-from ( child old-parent -- old-info )
    over parent>> [ class ] bi@ =
    [ dup layout-info ] [ f ] if
    [ unparent ] dip ;

:: with-layout ( parent child info quot -- parent )
    not-in-layout
    [let | info' [ info child parent move-from or ] |
        info' child parent
            [ >>parent drop ]
            [ quot call( info child parent -- ) ]
            [ graft-state>> second [ graft ] [ drop ] if ] 2tri
        parent dup relayout
    ] ;

PRIVATE>

! Add extra info (that might be f)
GENERIC: add-info ( info parent -- )
M: layout add-info 2drop ;

: add-gadget* ( parent child info -- parent )
    [ [ ?push ] change-children add-info ] with-layout ;

: add-gadget ( parent child -- parent ) f add-gadget* ;

! remove-gadget and unparent already exist and do what I want, so
! I'll leave them out here- still, they should be part of the protocol

GENERIC: add-info-at ( info parent index -- )
M: layout add-info-at 3drop ;

: add-gadget-at ( parent gadget index info -- parent ) rot roll
    [| info child parent index |
        child index parent children>> [ insert-nth ] change-children
        info swap index add-info-at
    ] curry with-layout ;

New Annotation

Summary:
Author:
Mode:
Body: