--- gforth/utf-8.fs 2004/12/28 17:27:24 1.6 +++ gforth/utf-8.fs 2005/01/04 22:09:04 1.10 @@ -20,49 +20,66 @@ \ short: u8 means utf-8 encoded address +s" malformed UTF-8 character" exception Constant UTF-8-err + +$80 Value maxascii + : u8len ( u8 -- n ) - dup $80 u< IF drop 1 EXIT THEN \ special case ASCII + dup maxascii u< IF drop 1 EXIT THEN \ special case ASCII $800 2 >r BEGIN 2dup u>= WHILE 5 lshift r> 1+ >r REPEAT 2drop r> ; : u8@+ ( u8addr -- u8addr' u ) - count dup $80 and 0= ?EXIT \ special case ASCII + count dup maxascii u< ?EXIT \ special case ASCII $7F and $40 >r BEGIN dup r@ and WHILE r@ xor 6 lshift r> 5 lshift >r >r count -\ dup $C0 and $80 <> abort" malformed character" + dup $C0 and $80 <> IF UTF-8-err throw THEN $3F and r> or REPEAT rdrop ; : u8!+ ( u u8addr -- u8addr' ) - over $80 < IF tuck c! 1+ EXIT THEN \ special case ASCII + over maxascii u< IF tuck c! 1+ EXIT THEN \ special case ASCII >r 0 swap $3F BEGIN 2dup u> WHILE 2/ >r dup $3F and $80 or swap 6 rshift r> REPEAT $7F xor 2* or r> BEGIN over $80 u>= WHILE tuck c! 1+ REPEAT nip ; +\ plug-in so that char and ' work for UTF-8 + +[ifundef] char@ \ !! bootstrapping help + Defer char@ ( addr u -- char addr' u' ) + :noname over c@ -rot 1 /string ; IS char@ +[then] + +:noname ( addr u -- char addr' u' ) + \ !! the if here seems to work around some breakage, but not + \ entirely; e.g., try 'ç' with LANG=C. + dup 1 u<= IF defers char@ EXIT THEN + over + >r u8@+ swap r> over - ; IS char@ + \ scan to next/previous character : u8>> ( u8addr -- u8addr' ) - BEGIN count $C0 and $80 <> UNTIL ; + BEGIN count $C0 and maxascii <> UNTIL ; : u8<< ( u8addr -- u8addr' ) - BEGIN 1- dup c@ $C0 and $80 <> UNTIL ; + BEGIN 1- dup c@ $C0 and maxascii <> UNTIL ; \ utf key and emit : u8key ( -- u ) - defers key dup $80 and 0= ?EXIT \ special case ASCII + defers key dup maxascii u< ?EXIT \ special case ASCII $7F and $40 >r BEGIN dup r@ and WHILE r@ xor 6 lshift r> 5 lshift >r >r defers key -\ dup $C0 and $80 <> abort" malformed character" + dup $C0 and $80 <> IF UTF-8-err throw THEN $3F and r> or REPEAT rdrop ; : u8emit ( u -- ) - dup $80 < IF defers emit EXIT THEN \ special case ASCII + dup maxascii u< IF defers emit EXIT THEN \ special case ASCII 0 swap $3F BEGIN 2dup u> WHILE 2/ >r dup $3F and $80 or swap 6 rshift r> @@ -71,8 +88,10 @@ \ input editor -: save-cursor ( -- ) 27 emit '7 emit ; -: restore-cursor ( -- ) 27 emit '8 emit ; +[IFUNDEF] #esc 27 Constant #esc [THEN] + +: save-cursor ( -- ) #esc emit '7 emit ; +: restore-cursor ( -- ) #esc emit '8 emit ; : .rest ( addr pos1 -- addr pos1 ) restore-cursor 2dup type ; : .all ( span addr pos1 -- span addr pos1 )