basis/xmode/keyword-map/keyword-map.factor

   1 ! Copyright (C) 2007, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel strings assocs sequences hashtables
   4 sorting unicode.case unicode.categories sets ;
   5 IN: xmode.keyword-map
   6
   7 ! Based on org.gjt.sp.jedit.syntax.KeywordMap
   8 TUPLE: keyword-map no-word-sep ignore-case? assoc ;
   9
  10 : <keyword-map> ( ignore-case? -- map )
  11     keyword-map new
  12         swap >>ignore-case?
  13         H{ } clone >>assoc ;
  14
  15 : invalid-no-word-sep ( keyword-map -- ) f >>no-word-sep drop ;
  16
  17 : handle-case ( key keyword-map -- key assoc )
  18     [ ignore-case?>> [ >upper ] when ] [ assoc>> ] bi ;
  19
  20 M: keyword-map assoc-size
  21     assoc>> assoc-size ;
  22
  23 M: keyword-map at* handle-case at* ;
  24
  25 M: keyword-map set-at
  26     [ handle-case set-at ] [ invalid-no-word-sep ] bi ;
  27
  28 M: keyword-map clear-assoc
  29     [ assoc>> clear-assoc ] [ invalid-no-word-sep ] bi ;
  30
  31 M: keyword-map >alist
  32     assoc>> >alist ;
  33
  34 : (keyword-map-no-word-sep) ( assoc -- str )
  35     keys concat [ alpha? not ] filter prune natural-sort ;
  36
  37 : keyword-map-no-word-sep* ( keyword-map -- str )
  38     dup no-word-sep>> [ ] [
  39         dup (keyword-map-no-word-sep) >>no-word-sep
  40         keyword-map-no-word-sep*
  41     ] ?if ;
  42
  43 INSTANCE: keyword-map assoc