XML attrs
parent
87b4633318
commit
d6e445df1f
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2005, 2006 Daniel Ehrenberg
|
! Copyright (C) 2005, 2006 Daniel Ehrenberg
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel sequences sequences.private assocs arrays ;
|
USING: kernel sequences sequences.private assocs arrays vectors ;
|
||||||
IN: xml.data
|
IN: xml.data
|
||||||
|
|
||||||
TUPLE: name space tag url ;
|
TUPLE: name space tag url ;
|
||||||
|
@ -60,7 +60,8 @@ M: attrs set-at
|
||||||
2dup attr@ nip [
|
2dup attr@ nip [
|
||||||
2nip set-second
|
2nip set-second
|
||||||
] [
|
] [
|
||||||
>r assure-name swap 2array r> push
|
[ >r assure-name swap 2array r> ?push ] keep
|
||||||
|
set-delegate
|
||||||
] if* ;
|
] if* ;
|
||||||
|
|
||||||
M: attrs assoc-size length ;
|
M: attrs assoc-size length ;
|
||||||
|
@ -68,14 +69,15 @@ M: attrs new-assoc drop V{ } new <attrs> ;
|
||||||
M: attrs >alist delegate >alist ;
|
M: attrs >alist delegate >alist ;
|
||||||
|
|
||||||
: >attrs ( assoc -- attrs )
|
: >attrs ( assoc -- attrs )
|
||||||
|
dup [
|
||||||
V{ } assoc-clone-like
|
V{ } assoc-clone-like
|
||||||
[ >r assure-name r> ] assoc-map
|
[ >r assure-name r> ] assoc-map
|
||||||
<attrs> ;
|
] when <attrs> ;
|
||||||
M: attrs assoc-like
|
M: attrs assoc-like
|
||||||
drop dup attrs? [ >attrs ] unless ;
|
drop dup attrs? [ >attrs ] unless ;
|
||||||
|
|
||||||
M: attrs clear-assoc
|
M: attrs clear-assoc
|
||||||
delete-all ;
|
f swap set-delegate ;
|
||||||
M: attrs delete-at
|
M: attrs delete-at
|
||||||
tuck attr@ drop [ swap delete-nth ] [ drop ] if* ;
|
tuck attr@ drop [ swap delete-nth ] [ drop ] if* ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue