basis/command-line/command-line.factor

   1 ! Copyright (C) 2003, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: init continuations hashtables io io.encodings.utf8
   4 io.files kernel kernel.private namespaces parser sequences
   5 strings system splitting vocabs.loader ;
   6 IN: command-line
   7
   8 SYMBOL: script
   9 SYMBOL: command-line
  10
  11 : (command-line) ( -- args ) 10 getenv sift ;
  12
  13 : rc-path ( name -- path )
  14     os windows? [ "." prepend ] unless
  15     home prepend-path ;
  16
  17 : run-bootstrap-init ( -- )
  18     "user-init" get [
  19         "factor-boot-rc" rc-path ?run-file
  20     ] when ;
  21
  22 : run-user-init ( -- )
  23     "user-init" get [
  24         "factor-rc" rc-path ?run-file
  25     ] when ;
  26
  27 : load-vocab-roots ( -- )
  28     "user-init" get [
  29         "factor-roots" rc-path dup exists? [
  30             utf8 file-lines [ add-vocab-root ] each
  31         ] [ drop ] if
  32     ] when ;
  33
  34 : var-param ( name value -- ) swap set-global ;
  35
  36 : bool-param ( name -- ) "no-" ?head not var-param ;
  37
  38 : param ( param -- )
  39     "=" split1 [ var-param ] [ bool-param ] if* ;
  40
  41 : run-script ( file -- )
  42     t "quiet" set-global run-file ;
  43
  44 : parse-command-line ( args -- )
  45     [ command-line off script off ] [
  46         unclip "-" ?head
  47         [ param parse-command-line ]
  48         [ script set command-line set ] if
  49     ] if-empty ;
  50
  51 SYMBOL: main-vocab-hook
  52
  53 : main-vocab ( -- vocab )
  54     embedded? [
  55         "alien.remote-control"
  56     ] [
  57         main-vocab-hook get [ call ] [ "listener" ] if*
  58     ] if ;
  59
  60 : default-cli-args ( -- )
  61     global [
  62         "quiet" off
  63         "script" off
  64         "e" off
  65         "user-init" on
  66         embedded? "quiet" set
  67         main-vocab "run" set
  68     ] bind ;
  69
  70 : ignore-cli-args? ( -- ? )
  71     os macosx? "run" get "ui" = and ;
  72
  73 : script-mode ( -- ) ;
  74
  75 [ default-cli-args ] "command-line" add-init-hook