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
  33   utf8 [ read-contents ] with-process-reader
  34   " \n" split harvest ;
  35
  36 : expansion ( command -- command ) [ expand ] map flatten ;
  37
  38 : run-sword ( basic-expr -- )
  39     command>> expansion unclip
  40     "shell" lookup-word execute( arguments -- ) ;
  41
  42 : run-foreground ( process -- )
  43     [ try-process ] [ print-error drop ] recover ;
  44
  45 : run-background ( process -- )
  46     run-detached drop ;
  47
  48 : run-basic-expr ( basic-expr -- )
  49     <process>
  50         over command>> expansion >>command
  51         over stdin>>             >>stdin
  52         over stdout>>            >>stdout
  53         swap background>>
  54         [ run-background ] [ run-foreground ] if ;
  55
  56 : basic-chant ( basic-expr -- )
  57     dup command>> first swords member?
  58     [ run-sword ] [ run-basic-expr ] if ;
  59
  60 : pipeline-chant ( pipeline-chant -- )
  61     commands>> run-pipeline drop ;
  62
  63 : chant ( obj -- )
  64     dup basic-expr? [ basic-chant ] [ pipeline-chant ] if ;
  65
  66 : prompt ( -- )
  67     current-directory get write " $ " write flush ;
  68
  69 DEFER: shell
  70
  71 : handle ( input -- )
  72     dup { f "exit" } member? [
  73         drop
  74     ] [
  75         [
  76             expr [ chant ] [ "ix: ignoring input" print ] if*
  77         ] unless-empty shell
  78     ] if ;
  79
  80 : shell ( -- )
  81     prompt readln handle ;
  82
  83 : ix ( -- ) shell ;
  84
  85 MAIN: ix