version 1.35, 2008/02/12 16:44:58
|
version 1.38, 2009/01/17 16:55:54
|
Line 1
|
Line 1
|
\ UTF-8 handling 12dec04py |
\ UTF-8 handling 12dec04py |
|
|
\ Copyright (C) 2004,2005,2006,2007 Free Software Foundation, Inc. |
\ Copyright (C) 2004,2005,2006,2007,2008 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 73 $80 Value max-single-byte
|
Line 73 $80 Value max-single-byte
|
Defer check-xy ' noop IS check-xy |
Defer check-xy ' noop IS check-xy |
|
|
: u8key ( -- u ) |
: u8key ( -- u ) |
defers key dup max-single-byte u< ?EXIT \ special case ASCII |
key dup max-single-byte u< ?EXIT \ special case ASCII |
dup $FF = ?EXIT \ special resize character |
dup $FF = ?EXIT \ special resize character |
dup $C2 u< IF UTF-8-err throw THEN \ malformed character |
dup $C2 u< IF UTF-8-err throw THEN \ malformed character |
$7F and $40 >r |
$7F and $40 >r |
BEGIN dup r@ and WHILE r@ xor |
BEGIN dup r@ and WHILE r@ xor |
6 lshift r> 5 lshift >r >r defers key |
6 lshift r> 5 lshift >r >r key |
dup $C0 and $80 <> IF UTF-8-err throw THEN |
dup $C0 and $80 <> IF UTF-8-err throw THEN |
$3F and r> or |
$3F and r> or |
REPEAT rdrop ; |
REPEAT rdrop ; |
|
|
: u8emit ( u -- ) |
: u8emit ( u -- ) |
dup max-single-byte u< IF defers emit EXIT THEN \ special case ASCII |
dup max-single-byte u< IF emit EXIT THEN \ special case ASCII |
0 swap $3F |
0 swap $3F |
BEGIN 2dup u> WHILE |
BEGIN 2dup u> WHILE |
2/ >r dup $3F and $80 or swap 6 rshift r> |
2/ >r dup $3F and $80 or swap 6 rshift r> |
REPEAT $7F xor 2* or |
REPEAT $7F xor 2* or |
BEGIN dup $80 u>= WHILE defers emit REPEAT drop ; |
BEGIN dup $80 u>= WHILE emit REPEAT drop ; |
|
|
\ utf-8 stuff for xchars |
\ utf-8 stuff for xchars |
|
|
Line 119 Defer check-xy ' noop IS check-xy
|
Line 119 Defer check-xy ' noop IS check-xy
|
dup $f8 u< if drop 4 exit endif |
dup $f8 u< if drop 4 exit endif |
dup $fc u< if drop 5 exit endif |
dup $fc u< if drop 5 exit endif |
dup $fe u< if drop 6 exit endif |
dup $fe u< if drop 6 exit endif |
UTF-8-err throw ; |
dup $ff u< if drop 7 exit endif |
|
drop 8 ; |
|
|
: -u8trailing-garbage ( addr u1 -- addr u2 ) |
: -u8trailing-garbage ( addr u1 -- addr u2 ) |
2dup + dup u8<< ( addr u1 end1 end2 ) |
2dup + dup u8<< ( addr u1 end1 end2 ) |