src/lib/platform.slate

   1 define: #Platform &slots: {
   2   #name -> ''.
   3   #nodeName -> ''.
   4   #systemRelease -> ''.
   5   #systemVersion -> ''.
   6   #machine -> ''.
   7   #endianness -> #LittleEndian.
   8   #bytesPerWord -> 4
   9 }.
  10
  11 p@(Platform traits) update
  12 [
  13   p `>>
  14    [name := lobby systemPlatform as: String.
  15     nodeName := lobby systemName as: String.
  16     systemRelease := lobby systemRelease as: String.
  17     systemVersion := lobby systemVersion as: String.
  18     machine := lobby systemMachine as: String.
  19     endianness := lobby isLittleEndian ifTrue: [#LittleEndian] ifFalse: [#BigEndian].
  20     bytesPerWord := lobby bytesPerWord. ]
  21 ].
  22
  23 p@(Platform traits) current
  24 [p clone update].
  25
  26 Platform traits Current ::= Platform current.
  27
  28 Platform traits PosixNames ::= #{#Linux. #Darwin. #Cygwin. #FreeBSD. #NetBSD. #OpenBSD. #SunOS. #BeOS. #Haiku}.
  29
  30 Platform traits WindowsNames ::= #{#Win32. #Win64}.
  31
  32 p@(Platform traits) isPosix
  33 "Whether the underlying platform implements (enough of?) the POSIX API."
  34 [p PosixNames anySatisfy: [| :name | (name as: p name) = p name]].
  35
  36 p@(Platform traits) isWindows
  37 "Whether the underlying platform implements (enough of?) the POSIX API."
  38 [p WindowsNames anySatisfy: [| :name | (name as: p name) = p name]].
  39
  40 p@(Platform traits) lineEnding
  41 [
  42   p isPosix ifTrue: ['\n'] ifFalse: [p isWindows ifTrue: ['\r\n'] ifFalse: ['\r']]
  43 ].
  44
  45 s@(String traits) escapeForShell
  46 "Performs shell-escaping for POSIX-style command shells."
  47 [
  48   [| :result |
  49    s do: [| :char |
  50      (';<>*|`&$#!()[]{}: \\\'"' includes: char) ifTrue: [result nextPut: $\\].
  51      result nextPut: char
  52    ]] writingAs: s
  53 ].
  54
  55 p@(Platform traits) run: command
  56 [lobby systemExecute: command].
  57
  58 Image startupActions at: #Platform put:
  59 [
  60   Platform Current update
  61 ].
  62
  63 define: #Environment &parents: {Mapping. ExtensibleCollection} &slots: {
  64   #variables -> Dictionary new
  65 }.
  66
  67 p@(Platform traits) environment [Environment].
  68
  69 Image startupActions at: #Environment put:
  70 [Environment update].
  71
  72 e@(Environment traits) update
  73 [
  74   variables ::= lobby environmentVariables.
  75   e variables := e variables newSizeOf: variables.
  76   variables do:
  77     [| :each |
  78      eachString ::= each as: String.
  79      equalsIndex ::= eachString indexOf: $= ifAbsent: [eachString length].
  80      key ::= eachString first: equalsIndex.
  81      value ::= eachString allButFirst: equalsIndex + 1.
  82      e variables at: key := value].
  83 ].
  84
  85 e@(Environment traits) size
  86 [
  87   e variables size
  88 ].
  89
  90 e@(Environment traits) capacity
  91 [
  92   e variables capacity
  93 ].
  94
  95 _@(Environment traits) acceptsKey: _
  96 [False].
  97
  98 _@(Environment traits) acceptsKey: _@(String traits)
  99 [True].
 100
 101 _@(Environment traits) accepts: _
 102 [False].
 103
 104 _@(Environment traits) accepts: _@(String traits)
 105 [True].
 106
 107 _@(Environment traits) defaultElement
 108 [''].
 109
 110 e@(Environment traits) at: name ifAbsent: block
 111 [
 112   e variables at: name ifAbsent: block
 113 ].
 114
 115 e@(Environment traits) at: name put: value
 116 [
 117   lobby environmentAt: name put: value.
 118   e variables at: name put: value
 119 ].
 120
 121 e@(Environment traits) removeKey: name ifAbsent: block
 122 [
 123   (e variables includesKey: name) ifTrue: [lobby environmentRemoveKey: name].
 124   e variables removeKey: name ifAbsent: block
 125 ].
 126
 127 e@(Environment traits) keyAtValue: obj ifAbsent: block
 128 [
 129   e variables keyAtValue: obj ifAbsent: block
 130 ].
 131
 132 e@(Environment traits) keysAndValuesDo: block
 133 [
 134   e variables keysAndValuesDo: block
 135 ].
 136
 137 e@(Environment traits) allSatisfy: block
 138 [
 139   e variables allSatisfy: block
 140 ].
 141
 142 e@(Environment traits) printOn: s [s ; e printName].
 143
 144 e@(Environment traits) homePath [e at: 'HOME'].
 145 e@(Environment traits) currentPath [e at: 'PWD'].
 146 e@(Environment traits) temporaryPath [e at: 'TMPDIR'].
 147 e@(Environment traits) includedPaths
 148 "Where the shell expects to find binary executables."
 149 [(e at: 'PATH') ifNil: [#{}] ifNotNilDo: #(splitWith: $:) `er].
 150 e@(Environment traits) userName [e at: 'LOGNAME'].
 151 e@(Environment traits) terminalType [e at: 'TERM'].
 152
 153 e@(Environment traits) sourcePaths
 154 "Where Slate expects to find code."
 155 [(e at: 'SLATEPATH') ifNil: [#{}] ifNotNilDo: #(splitWith: $:) `er].
 156
 157 "Load defaultPaths addAll:
 158   (Environment sourcePaths collect: [| :each | each as: File Locator])."
 159
 160 p@(Platform traits) edit: m@(Method traits) &editor: editor &reload: reload
 161 [
 162   editor `defaultsTo:
 163     (p environment at: 'EDITOR' ifAbsent:
 164        [(query: 'Select an editor for files: ')
 165           ifNotNilDo:
 166             [| :editor | p environment at: 'EDITOR' put: editor. editor]]).
 167   reload `defaultsTo: False.
 168   m sourceTree
 169     ifNil:
 170       [warn: 'No source information available.'. False]
 171     ifNotNilDo:
 172       [| :src |
 173        src source resource locator
 174          ifNil:
 175            [warn: 'File-based source information unavailable.'. False]
 176          ifNotNilDo:
 177            [| :fileName |
 178             result ::= p run: editor
 179               ; (src lineNumber ifNil: [''] ifNotNilDo: [| :n | ' +' ; n printString])
 180               ; ' ' ; (fileName as: String).
 181             result /\ reload ifTrue: [m reload].
 182             result]]
 183 ].
 184
 185 p@(Platform traits) view: f@(File traits) &pager: pager
 186 [
 187   pager `defaultsTo:
 188     (p environment at: 'PAGER' ifAbsent:
 189        [(query: 'Select a viewer for files: ')
 190           ifNotNilDo:
 191             [| :pager | p environment at: 'PAGER' put: pager. pager]]).
 192   p run: pager ; ' ' ; (f locator as: String)
 193 ].
 194
 195 p@(Platform traits) browse: url &browser: browser
 196 [
 197   browser `defaultsTo:
 198     (p environment at: 'BROWSER' ifAbsent:
 199        [(query: 'Select a browser for URLs: ')
 200           ifNotNilDo:
 201             [| :browser | p environment at: 'BROWSER' put: browser. browser]]).
 202   p run: browser ; ' ' ; (s as: String)
 203 ].
 204
 205 shell ::= lobby newSubSpace.
 206
 207 _@shell didNotUnderstand: message at: position
 208 "Form a command string and execute it."
 209 [
 210   position > 0
 211     ifTrue: [resend]
 212     ifFalse:
 213       [([| :command |
 214          message selector isUnarySelector
 215            ifTrue:
 216              [command ; message selector.
 217               message optionals pairsDo:
 218                 [| :key :value |
 219                  command ; ' -' ; (key as: String) allButFirst allButLast ; ' ' ; (value as: String)]].
 220          message selector isKeywordSelector ifTrue:
 221            [keywords ::= message selector keywords.
 222             command ; keywords first.
 223             keywords size = 1 ifTrue: "Read a string or array of arguments."
 224               [args ::= message arguments second.
 225                `conditions: (
 226                  [args is: String] -> [command ; ' ' ; args].
 227                  [args is: Collection] -> [args do: [| :arg | command ; ' ' ; arg]]
 228            )]].
 229          message arguments allButFirst: message selector arity do:
 230            [| :arg | command ; ' ' ; (arg as: String)]] writingAs: String)
 231          ifNil: [resend] ifNotNilDo: [| :cmd | [Platform run: cmd]]]
 232 ].