From 344ee0aa5de7bfdf73b0362325c2fb6cdbf981c3 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 16 Jul 2008 00:12:47 -0500 Subject: [PATCH] ui.gadgets.panes: rewrite a few words --- extra/ui/gadgets/panes/panes.factor | 110 +++++++++++++--------------- 1 file changed, 50 insertions(+), 60 deletions(-) diff --git a/extra/ui/gadgets/panes/panes.factor b/extra/ui/gadgets/panes/panes.factor index 9b547ce544..31a7249a79 100755 --- a/extra/ui/gadgets/panes/panes.factor +++ b/extra/ui/gadgets/panes/panes.factor @@ -1,66 +1,55 @@ ! 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 ; + 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? ; + output current prototype scrolls? + selection-color caret mark selecting? ; -: clear-selection ( pane -- ) - f >>caret - f >>mark - drop ; +: clear-selection ( pane -- pane ) f >>caret f >>mark ; -: add-output ( current pane -- ) - [ set-pane-output ] [ swap add-gadget drop ] 2bi ; +: add-output ( pane current -- pane ) [ >>output ] [ add-gadget ] bi ; +: add-current ( pane current -- pane ) [ >>current ] [ add-gadget ] bi ; -: add-current ( current pane -- ) - [ set-pane-current ] [ swap add-gadget drop ] 2bi ; +: prepare-line ( pane -- pane ) + clear-selection + dup prototype>> clone add-current ; -: prepare-line ( pane -- ) - [ clear-selection ] - [ [ pane-prototype clone ] keep add-current ] bi ; - -: pane-caret&mark ( pane -- caret mark ) - [ caret>> ] [ mark>> ] 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 ; +M: pane gadget-selection ( pane -- string/f ) 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 + clear-selection + [ pane-output clear-incremental ] + [ pane-current clear-gadget ] + bi ; : new-pane ( class -- pane ) new-gadget { 0 1 } >>orientation >>prototype - over add-output - dup prepare-line - pane-theme ; + add-output + prepare-line + selection-color >>selection-color ; -: ( -- pane ) - pane new-pane ; +: ( -- pane ) pane new-pane ; GENERIC: draw-selection ( loc obj -- ) @@ -102,25 +91,25 @@ C: pane-stream : 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 ; @@ -148,8 +137,8 @@ M: style-stream write-gadget TUPLE: pane-control < pane quot ; -M: pane-control model-changed - swap model-value swap dup pane-control-quot with-pane ; +M: pane-control model-changed ( model pane-control -- ) + [ value>> ] [ dup quot>> ] bi* with-pane ; : ( model quot -- pane ) pane-control new-pane @@ -160,7 +149,7 @@ M: pane-control model-changed >r pane-stream-pane r> keep scroll-pane ; inline M: pane-stream stream-nl - [ pane-nl ] do-pane-stream ; + [ pane-nl drop ] do-pane-stream ; M: pane-stream stream-write1 [ pane-current stream-write1 ] do-pane-stream ; @@ -337,8 +326,9 @@ M: paragraph stream-format 2drop ] if ; -: caret>mark ( pane -- ) - dup pane-caret over set-pane-mark relayout-1 ; +: caret>mark ( pane -- pane ) + dup caret>> >>mark + dup relayout-1 ; GENERIC: sloppy-pick-up* ( loc gadget -- n ) @@ -362,25 +352,25 @@ M: f sloppy-pick-up* [ 3drop { } ] if ; -: move-caret ( pane -- ) - dup hand-rel - over sloppy-pick-up - over set-pane-caret - relayout-1 ; +: move-caret ( pane -- pane ) + dup hand-rel + over sloppy-pick-up + over set-pane-caret + dup relayout-1 ; : begin-selection ( pane -- ) - dup move-caret f swap set-pane-mark ; + move-caret f swap set-pane-mark ; : extend-selection ( pane -- ) hand-moved? [ dup selecting?>> [ - dup move-caret + move-caret ] [ dup hand-clicked get child? [ t >>selecting? dup hand-clicked set-global - dup move-caret - dup caret>mark + move-caret + caret>mark ] when ] if dup dup pane-caret gadget-at-path scroll>gadget @@ -395,8 +385,8 @@ M: f sloppy-pick-up* ] if ; : select-to-caret ( pane -- ) - dup pane-mark [ dup caret>mark ] unless - dup move-caret + dup pane-mark [ caret>mark ] unless + move-caret dup request-focus com-copy-selection ;