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 assocs kernel sequences sets sorting unicode ;
   4 IN: xmode.keyword-map
   5
   6 ! Based on org.gjt.sp.jedit.syntax.KeywordMap
   7 TUPLE: keyword-map no-word-sep ignore-case? assoc ;
   8
   9 : <keyword-map> ( ignore-case? -- map )
  10     keyword-map new
  11         swap >>ignore-case?
  12         H{ } clone >>assoc ;
  13
  14 : invalid-no-word-sep ( keyword-map -- ) f >>no-word-sep drop ;
  15
  16 : handle-case ( key keyword-map -- key assoc )
  17     [ ignore-case?>> [ >upper ] when ] [ assoc>> ] bi ;
  18
  19 M: keyword-map assoc-size
  20     assoc>> assoc-size ;
  21
  22 M: keyword-map at* handle-case at* ;
  23
  24 M: keyword-map set-at
  25     [ handle-case set-at ] [ invalid-no-word-sep ] bi ;
  26
  27 M: keyword-map clear-assoc
  28     [ assoc>> clear-assoc ] [ invalid-no-word-sep ] bi ;
  29
  30 M: keyword-map >alist
  31     assoc>> >alist ;
  32
  33 : (keyword-map-no-word-sep) ( assoc -- str )
  34     keys union-all [ alpha? ] reject natural-sort ;
  35
  36 : keyword-map-no-word-sep* ( keyword-map -- str )
  37     dup no-word-sep>> [ ] [
  38         dup (keyword-map-no-word-sep) >>no-word-sep
  39         keyword-map-no-word-sep*
  40     ] ?if ;
  41
  42 INSTANCE: keyword-map assoc