version 1.26, 2007/05/05 17:26:02
|
version 1.28, 2007/07/14 19:57:16
|
Line 71 $80 Value max-single-byte
|
Line 71 $80 Value max-single-byte
|
|
|
\ utf key and emit |
\ utf key and emit |
|
|
|
Defer check-xy ' noop IS check-xy |
|
|
: u8key ( -- u ) |
: u8key ( -- u ) |
defers key dup max-single-byte u< ?EXIT \ special case ASCII |
defers key dup max-single-byte u< ?EXIT \ special case ASCII |
|
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 |
Line 112 $80 Value max-single-byte
|
Line 115 $80 Value max-single-byte
|
>r u8!+ r> r> swap - true |
>r u8!+ r> r> swap - true |
then ; |
then ; |
|
|
: u8addrlen ( u8-addr -- u ) |
: u8addrlen ( u8-addr u -- u ) drop |
\ length of UTF-8 char starting at u8-addr (accesses only u8-addr) |
\ length of UTF-8 char starting at u8-addr (accesses only u8-addr) |
c@ |
c@ |
dup $80 u< if drop 1 exit endif |
dup $80 u< if drop 1 exit endif |
Line 126 $80 Value max-single-byte
|
Line 129 $80 Value max-single-byte
|
|
|
: -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 ) |
2dup dup u8addrlen + = if \ last character ok |
2dup dup over over - u8addrlen + = if \ last character ok |
2drop |
2drop |
else |
else |
nip nip over - |
nip nip over - |
Line 304 here wc-table - Constant #wc-table
|
Line 307 here wc-table - Constant #wc-table
|
[ [IFDEF] x-width ] |
[ [IFDEF] x-width ] |
['] u8width is x-width |
['] u8width is x-width |
[ [THEN] ] |
[ [THEN] ] |
|
[ [IFDEF] x-size ] |
|
['] u8addrlen is x-size |
|
[ [THEN] ] |
['] -u8trailing-garbage is -trailing-garbage |
['] -u8trailing-garbage is -trailing-garbage |
; |
; |
|
|