extra/shell/shell.factor

   1 USING: accessors continuations debugger environment eval globs
   2 io io.directories io.encodings.utf8 io.launcher io.pathnames
   3 io.pipes kernel namespaces sequences sequences.deep shell.parser
   4 splitting words ;
   5 IN: shell
   6
   7 : cd ( args -- )
   8     [ home ] [ first ] if-empty set-current-directory ;
   9
  10 : pwd ( args -- )
  11     drop current-directory get print ;
  12
  13 CONSTANT: swords { "cd" "pwd" }
  14
  15 GENERIC: expand ( expr -- expr )
  16
  17 M: object expand ;
  18
  19 M: single-quoted-expr expand expr>> ;
  20
  21 M: double-quoted-expr expand expr>> ;
  22
  23 M: variable-expr expand expr>> os-env ;
  24
  25 M: glob-expr expand expr>> glob ;
  26
  27 M: factor-expr expand expr>> eval>string ;
  28
  29 DEFER: expansion
  30
  31 M: back-quoted-expr expand
  32   expr>> expr command>> expansion process-contents
  33   " \n" split harvest ;
  34
  35 : expansion ( command -- command ) [ expand ] map flatten ;
  36
  37 : run-sword ( basic-expr -- )
  38     command>> expansion unclip
  39     "shell" lookup-word execute( arguments -- ) ;
  40
  41 : run-foreground ( process -- )
  42     [ try-process ] [ print-error drop ] recover ;
  43
  44 : run-background ( process -- )
  45     run-detached drop ;
  46
  47 : run-basic-expr ( basic-expr -- )
  48     <process>
  49         over command>> expansion >>command
  50         over stdin>>             >>stdin
  51         over stdout>>            >>stdout
  52         swap background>>
  53         [ run-background ] [ run-foreground ] if ;
  54
  55 : basic-chant ( basic-expr -- )
  56     dup command>> first swords member?
  57     [ run-sword ] [ run-basic-expr ] if ;
  58
  59 : pipeline-chant ( pipeline-chant -- )
  60     commands>> run-pipeline drop ;
  61
  62 : chant ( obj -- )
  63     dup basic-expr? [ basic-chant ] [ pipeline-chant ] if ;
  64
  65 : prompt ( -- )
  66     current-directory get write " $ " write flush ;
  67
  68 DEFER: shell
  69
  70 : handle ( input -- )
  71     dup { f "exit" } member? [
  72         drop
  73     ] [
  74         [
  75             expr [ chant ] [ "ix: ignoring input" print ] if*
  76         ] unless-empty shell
  77     ] if ;
  78
  79 : shell ( -- )
  80     prompt readln handle ;
  81
  82 : ix ( -- ) shell ;
  83
  84 MAIN: ix