 
 : smash-pane ( pane -- gadget ) pane-output smash-line ;
 
-: pane-nl ( pane -- )
+: pane-nl ( pane -- pane )
     dup pane-current dup unparent smash-line
     over pane-output add-incremental
     prepare-line ;
 
 : pane-write ( pane seq -- )
-    [ dup pane-nl ]
+    [ pane-nl ]
     [ over pane-current stream-write ]
     interleave drop ;
 
 : pane-format ( style pane seq -- )
-    [ dup pane-nl ]
+    [ pane-nl ]
     [ 2over pane-current stream-format ]
     interleave 2drop ;
 
 GENERIC: write-gadget ( gadget stream -- )
 
-M: pane-stream write-gadget
-    pane-stream-pane pane-current swap add-gadget drop ;
+M: pane-stream write-gadget ( gadget pane-stream -- )
+   pane>> current>> swap add-gadget drop ;
 
 M: style-stream write-gadget
     stream>> write-gadget ;

! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays ui.gadgets ui.gadgets.borders ui.gadgets.buttons
ui.gadgets.labels ui.gadgets.scrollers
ui.gadgets.paragraphs ui.gadgets.incremental ui.gadgets.packs
ui.gadgets.theme ui.clipboards ui.gestures ui.traverse ui.render
hashtables io kernel namespaces sequences io.styles strings
quotations math opengl combinators math.vectors
sorting splitting io.streams.nested assocs
ui.gadgets.presentations ui.gadgets.slots ui.gadgets.grids
ui.gadgets.grid-lines classes.tuple models continuations
destructors accessors math.geometry.rect ;
IN: ui.gadgets.panes

TUPLE: pane < pack
output current prototype scrolls?
selection-color caret mark selecting? ;

: clear-selection ( pane -- )
    f >>caret
    f >>mark
    drop ;

: add-output ( current pane -- )
    [ set-pane-output ] [ swap add-gadget drop ] 2bi ;

: add-current ( current pane -- )
    [ set-pane-current ] [ swap add-gadget drop ] 2bi ;

: prepare-line ( pane -- )
    [ clear-selection ]
    [ [ pane-prototype clone ] keep add-current ] bi ;

: pane-caret&mark ( pane -- caret mark )
    [ caret>> ] [ mark>> ] bi ;

: selected-children ( pane -- seq )
    [ pane-caret&mark sort-pair ] keep gadget-subtree ;

M: pane gadget-selection? pane-caret&mark and ;

M: pane gadget-selection
    selected-children gadget-text ;

: pane-clear ( pane -- )
    [ clear-selection ]
    [ pane-output clear-incremental ]
    [ pane-current clear-gadget ]
    tri ;

: pane-theme ( pane -- pane )
    selection-color >>selection-color ; inline

: new-pane ( class -- pane )
    new-gadget
        { 0 1 } >>orientation
        <shelf> >>prototype
        <incremental> over add-output
        dup prepare-line
        pane-theme ;

: <pane> ( -- pane )
    pane new-pane ;

GENERIC: draw-selection ( loc obj -- )


    [ 3drop { } ]
    if ;

: move-caret ( pane -- pane )
  dup hand-rel
  over sloppy-pick-up
  over set-pane-caret
  dup relayout-1 ;

: begin-selection ( pane -- )
    move-caret f swap set-pane-mark ;

: extend-selection ( pane -- )
    hand-moved? [
        dup selecting?>> [
            move-caret
        ] [
            dup hand-clicked get child? [
                t >>selecting?
                dup hand-clicked set-global
                move-caret
                caret>mark
            ] when
        ] if
        dup dup pane-caret gadget-at-path scroll>gadget
