--- gforth/utf-8.fs 2004/12/24 14:08:43 1.4 +++ gforth/utf-8.fs 2004/12/28 17:27:24 1.6 @@ -79,15 +79,16 @@ restore-cursor >r 2dup swap type r> ; : ( max span addr pos1 u8char -- max span addr pos2 ) - >r >string over r@ u8len + swap move 2dup chars + r@ swap u8!+ drop + >r 2over r@ u8len + u< IF rdrop bell EXIT THEN + >string over r@ u8len + swap move 2dup chars + r@ swap u8!+ drop r> u8len >r rot r@ chars + -rot r> chars + ; : (u8ins) ( max span addr pos1 u8char -- max span addr pos2 ) .all .rest ; : u8back ( max span addr pos1 -- max span addr pos2 f ) dup IF over + u8<< over - 0 max .all .rest - ELSE #bell emit THEN 0 ; + ELSE bell THEN 0 ; : u8forw ( max span addr pos1 -- max span addr pos2 f ) - 2 pick over <> IF over + u8@+ u8emit over - ELSE #bell emit THEN 0 ; + 2 pick over <> IF over + u8@+ u8emit over - ELSE bell THEN 0 ; : (u8del) ( max span addr pos1 -- max span addr pos2 ) over + dup u8<< tuck - >r over - >string over r@ + -rot move @@ -97,7 +98,7 @@ : ( max span addr pos1 -- max span addr pos2 0 ) 2 pick over <> IF u8forw drop (u8del) .all 2 spaces .rest - ELSE #bell emit THEN 0 ; + ELSE bell THEN 0 ; : u8eof 2 pick over or 0= IF bye ELSE THEN ; : u8first-pos ( max span addr pos1 -- max span addr 0 0 ) @@ -129,13 +130,13 @@ : u8tab-expand ( max span addr pos1 -- max span addr pos2 0 ) key? IF #tab (u8ins) 0 EXIT THEN u8kill-expand 2dup extract-word dup 0= IF nip EXIT THEN - search-prefix tib-full? - IF 7 emit 2drop 0 0 prefix-found 2! + search-prefix tib-full? + IF 7 emit 2drop prefix-off ELSE dup >r 2>r >string r@ + 2r> 2swap insert r@ + rot r> + -rot THEN - prefix-found @ IF bl (u8ins) THEN 0 ; + prefix-found @ IF bl (u8ins) ELSE .all .rest THEN 0 ; : utf-8-io ( -- ) ['] u8forw ctrl F bindkey @@ -150,6 +151,7 @@ ['] (u8enter) #cr bindkey ['] u8tab-expand #tab bindkey ['] (u8ins) IS insert-char + ['] kill-prefix IS everychar ['] save-cursor IS everyline ['] u8key IS key ['] u8emit IS emit ;