Fix problem where listener would scroll to the top sometimes

db4
Slava Pestov 2009-03-05 16:33:09 -06:00
parent ebb5adfdb7
commit 4e8280be63
1 changed files with 30 additions and 15 deletions

View File

@ -21,16 +21,18 @@ selection-color caret mark selecting? ;
f >>caret f >>mark ; inline f >>caret f >>mark ; inline
: prepare-last-line ( pane -- ) : prepare-last-line ( pane -- )
clear-selection [ last-line>> ] keep
[ last-line>> unparent ]
[
[ horizontal <track> ] dip
dup prototype>> clone >>current
[ current>> f track-add ] [ current>> f track-add ]
[ input>> [ 1 track-add ] when* ] [ input>> [ 1 track-add ] when* ] bi
[ swap [ >>last-line ] [ 1 track-add ] bi drop ] drop ; inline
tri
] : init-current ( pane -- pane )
dup prototype>> clone >>current ; inline
: next-line ( pane -- )
clear-selection
[ input>> unparent ]
[ init-current prepare-last-line ]
[ input>> [ request-focus ] when* ] tri ; [ input>> [ request-focus ] when* ] tri ;
: pane-caret&mark ( pane -- caret mark ) : pane-caret&mark ( pane -- caret mark )
@ -50,14 +52,27 @@ M: pane gadget-selection ( pane -- string/f )
[ current>> clear-gadget ] [ current>> clear-gadget ]
bi ; bi ;
: init-prototype ( pane -- pane )
<shelf> +baseline+ >>align >>prototype ; inline
: init-output ( pane -- pane )
<incremental> [ >>output ] [ f track-add ] bi ; inline
: pane-theme ( pane -- pane )
1 >>fill
selection-color >>selection-color ; inline
: init-last-line ( pane -- pane )
horizontal <track> [ >>last-line ] [ 1 track-add ] bi ; inline
: new-pane ( input class -- pane ) : new-pane ( input class -- pane )
[ vertical ] dip new-track [ vertical ] dip new-track
swap >>input swap >>input
1 >>fill pane-theme
<shelf> +baseline+ >>align >>prototype init-prototype
<incremental> [ >>output ] [ f track-add ] bi init-output
dup prepare-last-line init-current
selection-color >>selection-color ; inline init-last-line ; inline
: <pane> ( -- pane ) f pane new-pane ; : <pane> ( -- pane ) f pane new-pane ;
@ -109,7 +124,7 @@ C: <pane-stream> pane-stream
[ [
[ current>> [ unparent ] [ smash-line ] bi ] [ output>> ] bi [ current>> [ unparent ] [ smash-line ] bi ] [ output>> ] bi
add-incremental add-incremental
] [ prepare-last-line ] bi ; ] [ next-line ] bi ;
: pane-write ( seq pane -- ) : pane-write ( seq pane -- )
[ pane-nl ] [ current>> stream-write ] [ pane-nl ] [ current>> stream-write ]