From e988090f13b624a99e5b5b884e24608a59cb2fe1 Mon Sep 17 00:00:00 2001 From: "Brian T. Rice" Date: Tue, 1 Mar 2011 00:29:12 -0800 Subject: [PATCH] Moved "Shell" code into a "Glob" type/namespace, and removed FormatSpecification in favor of the newer standardized formatter. --- src/shell/matching.slate | 216 ++++++++++++++++++++++++----------------------- src/shell/shell.slate | 158 +++++++++++++--------------------- 2 files changed, 167 insertions(+), 207 deletions(-) rewrite src/shell/matching.slate (84%) rewrite src/shell/shell.slate (77%) diff --git a/src/shell/matching.slate b/src/shell/matching.slate dissimilarity index 84% index e1999b4..499bff7 100644 --- a/src/shell/matching.slate +++ b/src/shell/matching.slate @@ -1,106 +1,110 @@ -lobby ensureNamespace: #Shell. - -Shell define: #MaskPattern &parents: {Cloneable} &slots: {#components}. -Shell define: #MaskPatternMatcher &parents: {Cloneable} &slots: {#reader. #maskPattern}. - -Shell define: #MaskPatternFailure. - -Shell define: #MaskPatternComponent &parents: {Cloneable}. -Shell define: #MaskPatternLiteral &parents: {Shell MaskPatternComponent} &slots: {#string}. -Shell define: #MaskPatternRange &parents: {Shell MaskPatternComponent} &slots: {#ranges. #negate}. -Shell define: #MaskPatternAny &parents: {Shell MaskPatternComponent}. -Shell define: #MaskPatternAnyOne &parents: {Shell MaskPatternComponent}. - -mp@(Shell MaskPattern traits) newOn: s@(String traits) -[ - mp components := ExtensibleArray new. - mp readFrom: s reader. - mp -]. - -mp@(Shell MaskPattern traits) readFrom: s@(ReadStream traits) -[| prev matcher | - prev := '' writer. - matcher := mp components writer. - s do: - [| :token | ({$*. $?. $\[. } includes: token) /\ [prev contents isEmpty not] - ifTrue: [matcher nextPut: (Shell MaskPatternLiteral new `>> [string := prev contents. ]). - prev := '' writer]. - token caseOf: { - $* -> [matcher nextPut: Shell MaskPatternAny]. - $? -> [matcher nextPut: Shell MaskPatternAnyOne]. - $\[ -> [matcher nextPut: (mp readRange := (s upTo: $\]))]. - } otherwise: [prev nextPut: token]]. - - prev contents isEmpty ifFalse: [matcher nextPut: (Shell MaskPatternLiteral new `>> [string := prev contents. ])]. - mp components := matcher contents. -]. - -mp@(Shell MaskPattern traits) readRange: str@(String traits) -[| p char2 s | - s := str reader. - p := Shell MaskPatternRange new. - p ranges := ExtensibleArray new. - - p negate := '^!' includes: (char2 := s peek). - - s do: - [| :char | - (char2 := s peek) = $- - ifTrue: [s next. p ranges addLast: char -> s next] - ifFalse: [p ranges addLast: char]]. - p -]. - -mp@(Shell MaskPattern traits) match: str@(String traits) from: pos -[ - (Shell MaskPatternMatcher new `>> [maskPattern := mp. reader := mp components reader. ]) match: str from: pos -]. - -mp@(Shell MaskPatternMatcher traits) match: str@(String traits) from: pos -[ - "inform: 'match reader: ' ; mp reader printString ; ' pos: ' ; pos printString." - mp reader do: - [| :token | - (token isSameAs: Shell MaskPatternAny) - ifTrue: [str size downTo: pos do: - [|:start | ((mp new `>> [reader := mp reader clone. ]) match: str from: start) = str size - ifTrue: [^ str size]]] - ifFalse: [(pos := (token match: str from: pos)) - == Shell MaskPatternFailure ifTrue: [^ pos]]]. - pos -]. - -mp@(Shell MaskPattern traits) matches: str@(String traits) -[ | match | - match := mp match: str from: 0. - match ~== Shell MaskPatternFailure /\ [match = str size] -]. - -p@(Shell MaskPatternAny traits) match: str@(String traits) from: pos -[ - (pos to: str size - pos) -]. - -p@(Shell MaskPatternAnyOne traits) match: str@(String traits) from: pos -[ - pos >= str size ifTrue: [Shell MaskPatternFailure] ifFalse: [pos + 1] -]. - -p@(Shell MaskPatternRange traits) match: str@(String traits) from: pos -[ - pos >= str size \/ [p matches: (str at: pos)] ifTrue: [Shell MaskPatternFailure] ifFalse: [pos + 1] -]. - -p@(Shell MaskPatternLiteral traits) match: str@(String traits) from: pos -[ - pos + p string size > str size ifTrue: [^ Shell MaskPatternFailure]. - (str copyFrom: pos to: pos + p string size - 1) = p string ifTrue: [pos + p string size] ifFalse: [Shell MaskPatternFailure] -]. - -p@(Shell MaskPatternRange traits) matches: c@(String Character traits) -[ - p ranges detect: - [| :range | ((range isSameAs: c) /\ [range = c]) \/ - [c code between: range key code and: c code]] -]. +define: #Glob &parents: {Cloneable} &slots: {}. + +Glob traits define: #Pattern &parents: {Glob} &slots: {#components}. +Glob traits define: #PatternMatcher &parents: {Glob} &slots: {#reader. #maskPattern}. + +Glob traits define: #PatternFailure. + +Glob traits define: #PatternComponent &parents: {Glob}. +Glob traits define: #PatternLiteral &parents: {Glob PatternComponent} &slots: {#string -> ''}. +Glob traits define: #PatternRange &parents: {Glob PatternComponent} &slots: { + #ranges -> ExtensibleArray new. + #negate -> False +}. +Glob traits define: #PatternAny &parents: {Glob PatternComponent}. +Glob traits define: #PatternAnyOne &parents: {Glob PatternComponent}. + +glob@(Glob traits) newOn: s +[glob Pattern newOn: s]. + +glob@(Glob Pattern traits) newOn: s@(String traits) +[ + glob components := ExtensibleArray new. + glob readFrom: s reader. + glob +]. + +glob@(Glob Pattern traits) readFrom: s@(ReadStream traits) +[| prev | + prev := '' writer. + glob components := + [| :matcher | + s do: + [| :token | + (#{$*. $?. $\[. } includes: token) /\ [prev contents isEmpty not] + ifTrue: [matcher nextPut: (glob PatternLiteral new `>> [string := prev contents. ]). + prev := '' writer]. + token caseOf: { + $* -> [matcher nextPut: glob PatternAny]. + $? -> [matcher nextPut: glob PatternAnyOne]. + $\[ -> [matcher nextPut: (glob readRange := s upTo: $\])] + } otherwise: [prev nextPut: token]]. + prev contents isEmpty ifFalse: [matcher nextPut: (glob PatternLiteral new `>> [string := prev contents. ])]] writingAs: glob components. +]. + +glob@(Glob Pattern traits) readRange: str@(String traits) +[| p char2 s | + s := str reader. + p := glob PatternRange new `>> + [| :p | + ranges := p ranges new. + negate := '^!' includes: (char2 := s peek). ]. + s do: + [| :char | + (char2 := s peek) = $- + ifTrue: [s next. p ranges addLast: char -> s next] + ifFalse: [p ranges addLast: char]]. + p +]. + +glob@(Glob Pattern traits) match: str@(String traits) from: pos +[ + (glob PatternMatcher new `>> [maskPattern := glob. reader := glob components reader. ]) match: str from: pos +]. + +glob@(Glob PatternMatcher traits) match: str@(String traits) from: pos +[ + "inform: 'match reader: ' ; glob reader printString ; ' pos: ' ; pos printString." + glob reader do: + [| :token | + (token isSameAs: glob PatternAny) + ifTrue: [str size downTo: pos do: + [| :start | ((glob new `>> [reader := glob reader clone. ]) match: str from: start) = str size + ifTrue: [^ str size]]] + ifFalse: [(pos := (token match: str from: pos)) + == glob PatternFailure ifTrue: [^ pos]]]. + pos +]. + +glob@(Glob Pattern traits) matches: str@(String traits) +[ + (match ::= glob match: str from: 0) ~== glob PatternFailure /\ [match = str size] +]. + +glob@(Glob PatternAny traits) match: str@(String traits) from: pos +[ + (pos to: str size - pos) +]. + +glob@(Glob PatternAnyOne traits) match: str@(String traits) from: pos +[ + pos >= str size ifTrue: [glob PatternFailure] ifFalse: [pos + 1] +]. + +glob@(Glob PatternRange traits) match: str@(String traits) from: pos +[ + pos >= str size \/ [glob matches: (str at: pos)] ifTrue: [glob PatternFailure] ifFalse: [pos + 1] +]. + +glob@(Glob PatternLiteral traits) match: str@(String traits) from: pos +[ + pos + glob string size > str size ifTrue: [^ glob PatternFailure]. + (str copyFrom: pos to: pos + glob string size - 1) = glob string ifTrue: [pos + glob string size] ifFalse: [glob PatternFailure] +]. + +glob@(Glob PatternRange traits) matches: c@(String Character traits) +[ + glob ranges detect: + [| :range | ((range isSameAs: c) /\ [range = c]) \/ + [c code between: range key code and: c code]] +]. diff --git a/src/shell/shell.slate b/src/shell/shell.slate dissimilarity index 77% index 5a61506..811bff3 100644 --- a/src/shell/shell.slate +++ b/src/shell/shell.slate @@ -1,101 +1,57 @@ -lobby ensureNamespace: #Shell. - -Shell define: #FileCollection &parents: {Collection}. -Shell define: #FileArray &parents: {ExtensibleArray. Shell FileCollection}. -Shell define: #FileSet &parents: {Set. Shell FileCollection}. -Shell define: #FormatSpecification &parents: {Cloneable} &slots: {#spec}. - -Shell FormatSpecification traits define: #codes -> (Dictionary new*, - $p -> [|:l| l as: String], - $n -> #name `er, - $t -> #fileType `er, - $b -> #baseName `er, - $% -> [|:l| '%'], - $f -> [|:l| [|:s| l writeNameVersionTypeOn: s] writingAs: String]). - -ffs@(Shell FormatSpecification traits) newFrom: s@(String traits) -[| input writer | - writer := ExtensibleArray new writer. - input := s reader. - writer nextPut: (input upTo: $%). - input do: [| :each | - writer nextPut: (Shell FormatSpecification codes at: each ifAbsent: [error: 'bad code: ' ; each printString]). - writer nextPut: (input upTo: $%)]. - ffs new `>> [spec := writer contents reject: [| :each | (each is: String) /\ [each isEmpty]]. ] -]. - -ffs@(Shell FormatSpecification traits) format: f@(File Locator traits) -[ - [| :s | - ffs spec do: - [| :each | - (each is: String) - ifTrue: [s nextPutAll: each] - ifFalse: [s nextPutAll: (each applyWith: f)]]] writingAs: String -]. - -d@(File Locator traits) maskedEntries: mask@(String traits) do: block -[ - d maskedEntries: (Shell MaskPattern newOn: mask) do: block -]. - -l maskedEntries: mask@(Regex Regex traits) do: block -[ - l maskedEntries: (Regex Matcher newOn: mask) do: block -]. - -l@(File Locator traits) maskedEntries: mask do: block -[ - (Directory new `>> [locator := l. ]) maskedEntries: mask do: block -]. - -d@(Directory traits) collectMasked: mask -[ - [| :result | d maskedEntries: mask do: #(result nextPut: _) `er] - writingAs: Shell FileArray -]. - -d@(File Locator traits) /* mask -[d collectMasked: mask]. - -d@(Directory traits) /* mask -[d locator collectMasked: mask]. - -d@(Directory traits) maskedEntries: mask do: block -[ - d reader reset select: [| :each | mask matches: each] - (do: [block applyWith: (File Locator new `>> [readFilenameFrom: each. ])]). -]. - -a@(Shell FileCollection traits) format: formatString@(String traits) -[| fmtSpec | - fmtSpec := Shell FormatSpecification newFrom: formatString. - a collect: [| :each | fmtSpec format: each] -]. - -a@(Shell FileCollection traits) interpolate -[| *args fmtSpecs | - fmtSpecs := args collect: [|:each| Shell FormatSpecification newFrom: each]. - a collect: [|:each| fmtSpecs collect: [|:spec| spec format: each]] -]. - -d@(Directory traits) find: block &maxDepth: maxDepth -[| result | - maxDepth `defaultsTo: PositiveInfinity. - result := Shell FileSet new writer. - d select: block into: result depth: maxDepth. - result contents -]. - -d@(Directory traits) select: block into: result depth: maxDepth -[| entries reader | - maxDepth isZero ifTrue: [^ Nil]. - entries := d entries collect: [|:each| (File RelativeLocator newFrom: d) `>> [readPathElementsFrom: each reader. ]]. - reader := entries reader. - (reader select: block) >> result. - entries do: - [| :each info | - (info := each fileInfo) isNotNil /\ [info isDirectory] /\ [info isLink not] - /\ [each name ~= '..'] /\ [each name ~= '.'] - ifTrue: [(d childNamed: each name) select: block into: result depth: maxDepth - 1]]. -]. + +d@(File Locator traits) maskedEntries: mask@(String traits) do: block +[ + d maskedEntries: (Glob newOn: mask) do: block +]. + +l maskedEntries: mask@(Regex Regex traits) do: block +[ + l maskedEntries: (Regex Matcher newOn: mask) do: block +]. + +l@(File Locator traits) maskedEntries: mask do: block +[ + (Directory new `>> [locator := l. ]) maskedEntries: mask do: block +]. + +l@(File Locator traits) collectMasked: mask +[ + [| :result | l maskedEntries: mask do: #(result nextPut: _) `er] + writingAs: #{} +]. + +d@(File Locator traits) /* mask +[d collectMasked: mask]. + +d@(Directory traits) /* mask +[d locator collectMasked: mask]. + +d@(Directory traits) maskedEntries: mask do: block +[ + d sessionDo: + [| :d | + (d reader do: + [| :each | (mask matches: each) ifTrue: + [block applyWith: (File Locator new `>> [readFilenameFrom: each. ])]])]. +]. + +d@(Directory traits) find: block &maxDepth: maxDepth +[ + maxDepth `defaultsTo: PositiveInfinity. + result ::= Set new writer. + d select: block into: result depth: maxDepth. + result contents +]. + +d@(Directory traits) select: block into: result depth: maxDepth +[ + maxDepth isZero ifFalse: + [entries ::= d entries collect: + [| :each | (File RelativeLocator newFrom: d) `>> [readPathElementsFrom: each reader. ]]. + ((reader ::= entries reader) select: block) >> result. + entries do: + [| :each info | + (info := each fileInfo) isNotNil /\ [info isDirectory] /\ [info isLink not] + /\ [each name ~= '..'] /\ [each name ~= '.'] + ifTrue: [(d childNamed: each name) select: block into: result depth: maxDepth - 1]]] +]. -- 2.11.4.GIT