extra/shell/shell.factor

   1
   2 USING: kernel parser words continuations namespaces debugger
   3        sequences combinators splitting prettyprint
   4        system io io.files io.launcher io.encodings.utf8 io.pipes sequences.deep
   5        accessors multi-methods newfx shell.parser
   6        combinators.short-circuit eval environment ;
   7
   8 IN: shell
   9
  10 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  11
  12 : cd ( args -- )
  13   dup empty?
  14     [ drop home set-current-directory ]
  15     [ first     set-current-directory ]
  16   if ;
  17
  18 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  19
  20 : pwd ( args -- )
  21   drop
  22   current-directory get
  23   print ;
  24
  25 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  26
  27 : swords ( -- seq ) { "cd" "pwd" } ;
  28
  29 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  30
  31 GENERIC: expand ( expr -- expr )
  32
  33 METHOD: expand { single-quoted-expr } expr>> ;
  34
  35 METHOD: expand { double-quoted-expr } expr>> ;
  36
  37 METHOD: expand { variable-expr } expr>> os-env ;
  38
  39 METHOD: expand { glob-expr }
  40   expr>>
  41   dup "*" =
  42     [ drop current-directory get directory-files ]
  43     [ ]
  44   if ;
  45
  46 METHOD: expand { factor-expr } expr>> eval unparse ;
  47
  48 DEFER: expansion
  49
  50 METHOD: expand { back-quoted-expr }
  51   expr>>
  52   expr
  53   command>>
  54   expansion
  55   utf8 <process-stream>
  56   contents
  57   " \n" split
  58   "" remove ;
  59
  60 METHOD: expand { object } ;
  61
  62 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  63
  64 : expansion ( command -- command ) [ expand ] map flatten ;
  65
  66 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  67
  68 : run-sword ( basic-expr -- )
  69   command>> expansion unclip "shell" lookup execute ;
  70
  71 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  72
  73 : run-foreground ( process -- )
  74   [ try-process ] [ print-error drop ] recover ;
  75
  76 : run-background ( process -- ) run-detached drop ;
  77
  78 : run-basic-expr ( basic-expr -- )
  79   <process>
  80     over command>> expansion >>command
  81     over stdin>>             >>stdin
  82     over stdout>>            >>stdout
  83   swap background>>
  84     [ run-background ]
  85     [ run-foreground ]
  86   if ;
  87
  88 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  89
  90 : basic-chant ( basic-expr -- )
  91   dup command>> first swords member-of?
  92     [ run-sword ]
  93     [ run-basic-expr ]
  94   if ;
  95
  96 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  97
  98 : pipeline-chant ( pipeline-chant -- ) commands>> run-pipeline drop ;
  99
 100 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 101
 102 : chant ( obj -- )
 103   dup basic-expr?
 104     [ basic-chant    ]
 105     [ pipeline-chant ]
 106   if ;
 107
 108 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 109
 110 : prompt ( -- )
 111   current-directory get write
 112   " $ " write
 113   flush ;
 114
 115 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 116
 117 DEFER: shell
 118
 119 : handle ( input -- )
 120   {
 121     { [ dup f = ]      [ drop ] }
 122     { [ dup "exit" = ] [ drop ] }
 123     { [ dup "" = ]     [ drop shell ] }
 124     { [ dup expr ]     [ expr chant shell ] }
 125     { [ t ]            [ drop "ix: ignoring input" print shell ] }
 126   }
 127     cond ;
 128
 129 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 130
 131 : shell ( -- )
 132   prompt
 133   readln
 134   handle ;
 135
 136 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 137
 138 : ix ( -- ) shell ;
 139
 140 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 141
 142 MAIN: ix