extra/readline-listener/readline-listener.factor

   1 ! Copyright (C) 2011 Erik Charlebois.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs colors.constants combinators fry io kernel
   4 listener readline sequences splitting threads tools.completion
   5 unicode.data vocabs vocabs.hierarchy ;
   6 IN: readline-listener
   7
   8 <PRIVATE
   9
  10 SYMBOL: completions
  11
  12 TUPLE: readline-reader { prompt initial: f } ;
  13 INSTANCE: readline-reader input-stream
  14
  15 M: readline-reader stream-readln
  16     flush
  17     [ dup [ " " append ] when readline f ] change-prompt
  18     drop ;
  19
  20 M: readline-reader prompt.
  21     >>prompt drop ;
  22
  23 : clear-completions ( -- )
  24     f completions tset ;
  25
  26 : prefixed ( prefix seq -- seq' )
  27     swap '[ _ head? ] filter ;
  28
  29 : prefixed-words ( prefix -- words )
  30     all-words [ name>> ] map! prefixed ;
  31
  32 : prefixed-vocabs ( prefix -- vocabs )
  33     all-disk-vocabs-recursive filter-vocabs [ name>> ] map! prefixed ;
  34
  35 : prefixed-vocab-words ( prefix vocab-name -- words )
  36     vocab-words [ name>> ] map! prefixed ;
  37
  38 : prefixed-colors ( prefix -- colors )
  39     named-colors prefixed ;
  40
  41 : prefixed-chars ( prefix -- chars )
  42     name-map keys prefixed ;
  43
  44 : get-completions ( prefix -- completions )
  45     completions tget [ nip ] [
  46         completion-line " \r\n" split {
  47             { [ dup complete-vocab? ] [ drop prefixed-vocabs ] }
  48             { [ dup complete-char? ] [ drop prefixed-chars ] }
  49             { [ dup complete-color? ] [ drop prefixed-colors ] }
  50             { [ dup complete-vocab-words? ] [ harvest second prefixed-vocab-words ] }
  51             [ drop prefixed-words ]
  52         } cond dup completions tset
  53     ] if* ;
  54
  55 PRIVATE>
  56
  57 : readline-listener ( -- )
  58     [
  59         swap get-completions ?nth
  60         [ clear-completions f ] unless*
  61     ] set-completion
  62     readline-reader new [ listener-main ] with-input-stream* ;
  63
  64 MAIN: readline-listener