Fix xmode.keyword-map to not use delegation
parent
300921a026
commit
a119bea53a
|
@ -1,37 +1,43 @@
|
|||
! Copyright (C) 2007, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel strings assocs sequences hashtables
|
||||
sorting unicode.case unicode.categories sets ;
|
||||
IN: xmode.keyword-map
|
||||
|
||||
! Based on org.gjt.sp.jedit.syntax.KeywordMap
|
||||
TUPLE: keyword-map no-word-sep ignore-case? ;
|
||||
TUPLE: keyword-map no-word-sep ignore-case? assoc ;
|
||||
|
||||
: <keyword-map> ( ignore-case? -- map )
|
||||
H{ } clone { set-keyword-map-ignore-case? set-delegate }
|
||||
keyword-map construct ;
|
||||
keyword-map new
|
||||
swap >>ignore-case?
|
||||
H{ } clone >>assoc ;
|
||||
|
||||
: invalid-no-word-sep ( keyword-map -- ) f >>no-word-sep drop ;
|
||||
|
||||
: handle-case ( key keyword-map -- key assoc )
|
||||
[ keyword-map-ignore-case? [ >upper ] when ] keep
|
||||
delegate ;
|
||||
[ ignore-case?>> [ >upper ] when ] [ assoc>> ] bi ;
|
||||
|
||||
M: keyword-map assoc-size
|
||||
assoc>> assoc-size ;
|
||||
|
||||
M: keyword-map at* handle-case at* ;
|
||||
|
||||
M: keyword-map set-at
|
||||
[ handle-case set-at ] keep invalid-no-word-sep ;
|
||||
[ handle-case set-at ] [ invalid-no-word-sep ] bi ;
|
||||
|
||||
M: keyword-map clear-assoc
|
||||
[ delegate clear-assoc ] keep invalid-no-word-sep ;
|
||||
[ assoc>> clear-assoc ] [ invalid-no-word-sep ] bi ;
|
||||
|
||||
M: keyword-map >alist delegate >alist ;
|
||||
M: keyword-map >alist
|
||||
assoc>> >alist ;
|
||||
|
||||
: (keyword-map-no-word-sep) ( assoc -- str )
|
||||
keys concat [ alpha? not ] filter prune natural-sort ;
|
||||
|
||||
: keyword-map-no-word-sep* ( keyword-map -- str )
|
||||
dup keyword-map-no-word-sep [ ] [
|
||||
dup (keyword-map-no-word-sep)
|
||||
dup rot set-keyword-map-no-word-sep
|
||||
dup no-word-sep>> [ ] [
|
||||
dup (keyword-map-no-word-sep) >>no-word-sep
|
||||
keyword-map-no-word-sep*
|
||||
] ?if ;
|
||||
|
||||
INSTANCE: keyword-map assoc
|
||||
|
|
Loading…
Reference in New Issue