src/lib/directory.slate

   1 "Directory traitsWindow _map delegates at: Directory traitsWindow _map delegates size - 2 put: ExternalResource traits."
   2 Directory traitsWindow _delegates: {Root traits. Derivable traits. Cloneable traits. ExternalResource traits. Directory traits}.
   3
   4 "Directory traitsWindow atSlotNamed: #traits1 put: ExternalResource traits."
   5 Directory addSlotsFrom: ExternalResource.
   6 Directory traits define: #Locator &parents: {File Locator}.
   7 Directory traits define: #RelativeLocator &parents: {File RelativeLocator}.
   8 Directory traits define: #AbsoluteLocator &parents: {File AbsoluteLocator}.
   9
  10 Directory locator := Directory Locator.
  11
  12 l@(Directory Locator traits) type
  13 "So a Locator knows it's for a Directory and not a File."
  14 [Directory].
  15
  16 l@(Directory Locator traits) readPathElementsFrom: s &pathSeparator: pathSeparator
  17 [
  18   pathSeparator `defaultsTo: l pathSeparator.
  19   l path := ((s upToEnd splitWith: pathSeparator) as: l path).
  20   l
  21 ].
  22
  23 l@(Directory Locator traits) readFrom: s &pathSeparator: pathSeparator
  24 "Handle a missing path separator at the end."
  25 [
  26   resend `>>
  27    [| :newL |
  28     name ifNotNilDo:
  29       [| :name |
  30        newL path addLast: name.
  31        newL name := Nil].
  32     version ifNotNilDo:
  33       [| :version |
  34        newL path at: newL path indexLast put:
  35          newL path last ; '.' ; version.
  36        newL version := Nil].
  37     fileType ifNotNilDo:
  38       [| :type |
  39        newL path at: newL path indexLast put:
  40          newL path last ; '.' ; type.
  41        newL fileType := Nil]. ]
  42 ].
  43
  44 dir1@(Directory traits) = dir2@(Directory traits)
  45 [dir1 locator = dir2 locator].
  46
  47 dir@(Directory traits) newNamed: dirname
  48 "Answer a new Directory with the given name."
  49 [
  50   (dir clone `setting: #{#handle. #locator} to: {Nil. dir Locator readFrom: (dirname as: String)}) `>> [resetStreams. ]
  51 ].
  52
  53 dir@(Directory traits) childNamed: name
  54 "Answers a new Directory object with its locator and the given name
  55 concatenated."
  56 [dir newNamed: (dir locator as: String) ; name].
  57
  58 dir@(Directory traits) isParentOf: subdir@(Directory traits)
  59 [dir locator path isPrefixOf: subdir locator path].
  60
  61 subdir@(Directory traits) isChildOf: dir@(Directory traits)
  62 [dir isParentOf: subdir].
  63
  64 dir@(Directory traits) enable
  65 "Reset the directory."
  66 [
  67   [dir close] on: dir Closed do: #return `er.
  68   dirname ::= dir locator as: String.
  69   (result ::= dir primitiveOpen: dirname) isNegative
  70     ifTrue: [error: result negated printString]
  71     ifFalse: [dir handle := result].
  72 ].
  73
  74 dir@(Directory traits) disable
  75 "Call the close primitive."
  76 [
  77   dir handle ifNotNilDo: [| :handle |
  78     (dir primitiveClose: handle)
  79       ifNil: []
  80       ifNotNilDo: [| :result | result isZero ifFalse: [error: result negated printString]]].
  81 ].
  82
  83 dir@(Directory traits) exists
  84 [
  85   dir locator fileInfo ifNil: [False] ifNotNilDo: #isDirectory `er
  86 ].
  87
  88 dir@(Directory traits) delete
  89 [
  90   dir ensureClosed.
  91   (dir deleteDirectoryNamed: (dir locator as: String))
  92     ifFalse: [error: 'Unable to delete directory']
  93 ].
  94
  95 dir@(Directory traits) ensureExists
  96 [
  97   dir exists
  98     ifFalse: [dir parent ensureExists. dir create].
  99   dir
 100 ].
 101
 102 dir@(Directory traits) create
 103 [
 104   dir exists
 105     ifFalse: [dir createDirectoryNamed: (dir locator as: String)].
 106   dir
 107 ].
 108
 109 dir@(Directory traits) renameTo: newName
 110 [
 111   dir ensureClosed.
 112   (dir renameDirectoryNamed: (dir locator as: String) to: (newName as: String))
 113     ifTrue: [dir locator := newName as: dir locator]
 114     ifFalse: [error: 'Unable to delete directory.']
 115 ].
 116
 117 dir@(Directory traits) nextDirEntry
 118 "Answers the next file entry name. This is stateful and should only be used
 119 by Directory Streams."
 120 [
 121   dir handle ifNil: [error: 'Directory not open'].
 122   buffer ::= String new &capacity: 256.
 123   (len ::= dir primitiveRead: dir handle into: buffer) isNegative
 124     ifTrue: [error: len negated printString. Nil]
 125     ifFalse: [len isZero ifTrue: [Nil] "End-marker."
 126                          ifFalse: [buffer copyFrom: 0 to: len - 1]]
 127 ].
 128
 129 dir@(Directory traits) isRoot
 130 "Whether the given Directory is the root of its local filesystem."
 131 [dir locator isNotNil /\ [dir locator isRoot]].
 132
 133 dir@(Directory traits) root
 134 "Answer the root of the given directory's filesystem."
 135 [
 136   dir isRoot
 137     ifTrue: [dir]
 138     ifFalse: [dir newNamed: dir locator copy `>> [path := dir locator path new. ]]
 139 ].
 140
 141 dir@(Directory traits) parent
 142 "Answer the Directory immediately above the current one."
 143 [
 144   dir locator path isEmpty
 145     ifTrue: [dir]
 146     ifFalse: [dir newNamed: dir locator copy `>> [path removeLast. ]]
 147 ].
 148
 149 f@(File traits) parent
 150 "Answer the Directory containing the file (as given by the path)."
 151 [Directory newNamed: f locator copy `>> [name := Nil. ]].
 152
 153 f@(File traits) directory
 154 [f parent].
 155
 156 dir@(Directory traits) withOpenNamed: dirname do: block
 157 "Calls sessionDo: on a Directory made for the given dirname."
 158 [
 159   (dir newNamed: dirname) sessionDo: block
 160 ].
 161
 162 loc@(File Locator traits) openDirectory
 163 "Opens and answers the Directory for the given Locator."
 164 [
 165   (Directory newNamed: loc) open
 166 ].
 167
 168 dir@(Directory traits) current
 169 "Get the current Directory used by Slate. This uses a ByteArray to pass the String
 170 name and the return value tells how long the actual contents are."
 171 [
 172   buffer ::= ByteArray newSize: 256.
 173   dirLength ::= dir primitiveGetCurrentDirectory: buffer.
 174   dir newNamed: ((buffer first: dirLength) as: String)
 175 ].
 176
 177 dir@(Directory traits) enter
 178 "Sets the Directory to be the current Slate directory."
 179 [
 180   dir exists ifFalse: [error: 'You cannot enter a directory that does not exist.'].
 181   (returnCode ::= dir primitiveSetCurrentDirectory: ((dir locator as: String) as: ByteArray))
 182     isZero ifFalse: [error: 'Couldn\'t set the directory']
 183 ].
 184
 185 dir@(Directory traits) current: someDirName
 186 [dir current: (dir newNamed: someDirName). dir current].
 187
 188 dir@(Directory traits) current: someDir@(Directory traits)
 189 "Set the current Slate Directory, using the enter method."
 190 [someDir enter].
 191
 192 define: #LogicalDirectory &parents: {Directory}
 193   &slots: {#resolver -> [] "A block which resolves to the concrete Directory."}.
 194 "A LogicalDirectory is one whose definition is not concrete but based on
 195 a relationship that needs to be resolved at the last possible moment to avoid
 196 static platform/installation dependency."
 197
 198 dir@(LogicalDirectory traits) newResolving: block
 199 [(dir clone `setting: #{#locator. #resolver} to: {Nil. block})
 200    `>> [registerStartupHandler. ]].
 201
 202 x@(LogicalDirectory traits) = y@(LogicalDirectory traits)
 203 [x == y].
 204
 205 dir@(LogicalDirectory traits) as: concrete@(Directory traits)
 206 "This wraps the resolver block."
 207 [dir resolver do].
 208
 209 concrete@(Directory traits) as: dir@(LogicalDirectory traits)
 210 "This isn't very useful..."
 211 [dir newResolving: [concrete]].
 212
 213 LogicalDirectory addAccessor:
 214 "This refreshes the locator slot contents and returns them if it is Nil."
 215 [| :dir |
 216   (dir atSlotNamed: #locator)
 217     ifNil: [dir atSlotNamed: #locator put: dir resolver do locator]
 218     ifNotNilDo: [| :locator | locator]
 219 ] for: #locator.
 220
 221 dir@(Directory traits) home
 222 "Ask the current platform object for the home-directory string."
 223 [dir newNamed: Environment homePath].
 224
 225 dir@(Directory traits) walk: block
 226 "Calls the block on each pathname below the current Directory, recursively."
 227 [| eachDir |
 228   dir sessionDo:
 229     [| :each |
 230      (eachDir := dir newNamed: each) exists
 231        ifTrue: [eachDir walk: block]
 232        ifFalse: [block sendWith: eachDir locator]].
 233 ].
 234
 235 dir@(Directory traits) / path
 236 "Answers a new Directory or File that is specified by the relative location
 237 given as argument."
 238 [
 239   newPath ::= dir locator / path.
 240   newType ::= newPath fileInfo
 241     ifNil: [File]
 242     ifNotNilDo:
 243       [| :info | info isFile ifTrue: [File] ifFalse: [info isDirectory ifTrue: [Directory]]].
 244   newType newNamed: path
 245 ].
 246
 247 file@(File traits) / path
 248 [
 249   file exists not \/ [file fileInfo isDirectory]
 250     ifTrue: [(Directory newNamed: file locator) / path]
 251     ifFalse: [error: 'This is an existing file.']
 252 ].
 253
 254 Directory traits define: #Stream
 255             &parents: {ExternalResource ReadStream. PeekableStream}
 256             &slots: {#cache -> Nil}.
 257 "A Stream of the pathnames that are entries in the Directory."
 258
 259 Directory traits define: #ReadStream &parents: {Directory Stream}.
 260 "Directory traits removeSlot: #WriteStream.
 261 Directory traits removeSlot: #ReadWriteStream."
 262
 263 ds@(Directory Stream traits) on: dir@(Directory traits)
 264 "Open a Directory ReadStream on the path (could be a String)."
 265 [
 266   #on: sendTo: {ds. dir} through: {ExternalResource Stream. Nil}
 267 ].
 268
 269 ds@(Directory Stream traits) elementType
 270 [String].
 271
 272 ds@(Directory Stream traits) collectionType
 273 [Array].
 274
 275 ds@(Directory Stream traits) isAtEnd
 276 [
 277   ds peek.
 278   ds cache == ds
 279 ].
 280
 281 ds@(Directory Stream traits) next
 282 [
 283   result ::= ds peek.
 284   ds cache := Nil.
 285   result
 286 ].
 287
 288 ds@(Directory Stream traits) peek
 289 "Fills the cache slot with the next entry. The stream itself as used as the
 290 end-marker when reached (Nil marks an empty cache, a separate condition)."
 291 [| buffer |
 292   ds cache ifNil:
 293     [buffer := String new &capacity: 256.
 294      ds cache := ds resource nextDirEntry ifNil: [ds]]
 295 ].
 296
 297 ds@(Directory Stream traits) reset
 298 "Moves the stream position back to zero by closing and re-opening."
 299 [
 300   ds cache := Nil.
 301   ds resource enable.
 302   ds
 303 ].
 304
 305 dir@(Directory traits) entries
 306 "Answer all the entries in one Collection."
 307 [
 308   dir sessionDo: [| :d | d reader reset upToEnd]
 309 ].
 310
 311 dir@(Directory traits) children
 312 "Answer all the entries in one Collection of File and Directory objects."
 313 [
 314   [| :result |
 315    dir sessionDo:
 316      [| :d | (d reader do:
 317        [| :each | result nextPut: (File newNamed: (dir locator newChildNamed: each))])]]
 318     writingAs: Set
 319 ].
 320
 321 Directory traits define: #Proxy &parents: {Directory}
 322   &slots: {#children -> Dictionary new}.
 323 "This holds a Dictionary which responds to accesses that name its sub-
 324 elements, returning further objects which are similarly-usable."
 325
 326 p@(Directory Proxy traits) newNamed: dirname
 327 [resend `>> [children: p children new. ]].
 328
 329 dir@(Directory traits) proxy
 330 [dir Proxy newNamed: dir locator].
 331
 332 f@(File traits) proxy
 333 [f].
 334
 335 p@(Directory Proxy traits) proxy
 336 [p].
 337
 338 p@(Directory Proxy traits) / childName
 339 [p children at: childName ifAbsentPut:
 340   [p newOn: (p childNamed: childName)]].