steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix xmode.keyword-map to not use delegation

db4
Slava Pestov 2008-07-11 00:46:06 -05:00
parent 300921a026
commit a119bea53a
1 changed files with 17 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
extra/xmode/keyword-map/keyword-map.factor
View File

@ -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 USING: accessors kernel strings assocs sequences hashtables
sorting unicode.case unicode.categories sets ; sorting unicode.case unicode.categories sets ;
IN: xmode.keyword-map IN: xmode.keyword-map
! Based on org.gjt.sp.jedit.syntax.KeywordMap ! 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 ) : <keyword-map> ( ignore-case? -- map )
H{ } clone { set-keyword-map-ignore-case? set-delegate } keyword-map new
keyword-map construct ; swap >>ignore-case?
H{ } clone >>assoc ;
: invalid-no-word-sep ( keyword-map -- ) f >>no-word-sep drop ; : invalid-no-word-sep ( keyword-map -- ) f >>no-word-sep drop ;
: handle-case ( key keyword-map -- key assoc ) : handle-case ( key keyword-map -- key assoc )
[ keyword-map-ignore-case? [ >upper ] when ] keep [ ignore-case?>> [ >upper ] when ] [ assoc>> ] bi ;
delegate ;
M: keyword-map assoc-size
assoc>> assoc-size ;
M: keyword-map at* handle-case at* ; M: keyword-map at* handle-case at* ;
M: keyword-map set-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 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 ) : (keyword-map-no-word-sep) ( assoc -- str )
keys concat [ alpha? not ] filter prune natural-sort ; keys concat [ alpha? not ] filter prune natural-sort ;
: keyword-map-no-word-sep* ( keyword-map -- str ) : keyword-map-no-word-sep* ( keyword-map -- str )
dup keyword-map-no-word-sep [ ] [ dup no-word-sep>> [ ] [
dup (keyword-map-no-word-sep) dup (keyword-map-no-word-sep) >>no-word-sep
dup rot set-keyword-map-no-word-sep keyword-map-no-word-sep*
] ?if ; ] ?if ;
INSTANCE: keyword-map assoc INSTANCE: keyword-map assoc