extra/xmode/keyword-map/keyword-map.factor

   1 USING: accessors kernel strings assocs sequences hashtables
   2 sorting unicode.case unicode.categories sets ;
   3 IN: xmode.keyword-map
   4
   5 ! Based on org.gjt.sp.jedit.syntax.KeywordMap
   6 TUPLE: keyword-map no-word-sep ignore-case? ;
   7
   8 : <keyword-map> ( ignore-case? -- map )
   9     H{ } clone { set-keyword-map-ignore-case? set-delegate }
  10     keyword-map construct ;
  11
  12 : invalid-no-word-sep ( keyword-map -- ) f >>no-word-sep drop ;
  13
  14 : handle-case ( key keyword-map -- key assoc )
  15     [ keyword-map-ignore-case? [ >upper ] when ] keep
  16     delegate ;
  17
  18 M: keyword-map at* handle-case at* ;
  19
  20 M: keyword-map set-at
  21     [ handle-case set-at ] keep invalid-no-word-sep ;
  22
  23 M: keyword-map clear-assoc
  24     [ delegate clear-assoc ] keep invalid-no-word-sep ;
  25
  26 M: keyword-map >alist delegate >alist ;
  27
  28 : (keyword-map-no-word-sep) ( assoc -- str )
  29     keys concat [ alpha? not ] filter prune natural-sort ;
  30
  31 : keyword-map-no-word-sep* ( keyword-map -- str )
  32     dup keyword-map-no-word-sep [ ] [
  33         dup (keyword-map-no-word-sep)
  34         dup rot set-keyword-map-no-word-sep
  35     ] ?if ;
  36
  37 INSTANCE: keyword-map assoc