extra/shell/shell.factor

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