fixed stack comments of read1, minor UI updates

cvs
Slava Pestov 2005-07-20 02:29:57 +00:00
parent 2bdd8d33c2
commit ce41c5d642
5 changed files with 19 additions and 7 deletions

View File

@ -18,7 +18,7 @@ M: c-stream stream-write1 ( char stream -- )
M: c-stream stream-write-attr ( str style stream -- )
nip c-stream-out fwrite ;
M: c-stream stream-read1 ( stream -- str )
M: c-stream stream-read1 ( stream -- char/f )
c-stream-in dup [ fgetc ] when ;
M: c-stream stream-flush ( stream -- )

View File

@ -5,7 +5,7 @@ USING: errors generic kernel lists namespaces strings styles ;
: flush ( -- ) stdio get stream-flush ;
: read-line ( -- string ) stdio get stream-readln ;
: read1 ( -- char ) stdio get stream-read1 ;
: read1 ( -- char/f ) stdio get stream-read1 ;
: read ( count -- string ) stdio get stream-read ;
: write ( string -- ) stdio get stream-write ;
: write1 ( char -- ) stdio get stream-write1 ;

View File

@ -66,8 +66,17 @@ M: pane focusable-child* ( pane -- editor )
: pane-clear ( pane -- )
dup pane-output clear-incremental pane-current clear-gadget ;
: pane-ignore? ( style text pane -- ? )
#! If we already have stuff in the current pack, and there
#! is no style information or text to write, ignore it.
#! Otherwise, we either have a fancy style (like an icon
#! or gadget being output), or we want the current pack to
#! have a minimal height so we put the empty label there.
pane-current gadget-children empty? not
rot not and swap empty? and ;
: pane-write-1 ( style text pane -- )
pick empty? pick empty? and [
3dup pane-ignore? [
3drop
] [
>r <presentation> r> pane-current add-gadget

View File

@ -27,7 +27,7 @@ M: viewport pref-dim gadget-child pref-dim ;
: viewport-origin* ( viewport -- point )
dup viewport-bottom? [
f over set-viewport-bottom?
dup viewport-dim { 0 -1 0 } v* over fix-scroll
dup viewport-dim { 0 -1 0 } v*
[ swap set-viewport-origin ] keep
] [
viewport-origin
@ -35,7 +35,8 @@ M: viewport pref-dim gadget-child pref-dim ;
M: viewport layout* ( viewport -- )
dup gadget-child dup prefer
>r viewport-origin* r> set-rectangle-loc ;
>r dup viewport-origin* swap fix-scroll r>
set-rectangle-loc ;
M: viewport focusable-child* ( viewport -- gadget )
gadget-child ;
@ -101,7 +102,9 @@ C: slider ( viewport vector -- slider )
: <y-slider> ( viewport -- slider ) { 0 1 0 } <slider> ;
: thumb-loc ( slider -- loc )
dup slider-viewport viewport-origin* vneg swap >thumb ;
dup slider-viewport
dup viewport-origin* swap fix-scroll
vneg swap >thumb ;
: slider-dim { 16 16 16 } ;

View File

@ -228,7 +228,7 @@ M: read-task task-container drop read-tasks get ;
M: port stream-read ( count stream -- string )
[ wait-to-read ] keep read-fin ;
M: port stream-read1 ( stream -- string )
M: port stream-read1 ( stream -- char/f )
1 over wait-to-read port-sbuf first ;
! Writers