--- a/Bag.st Wed Aug 28 10:49:29 2013 +0100
+++ b/Bag.st Wed Sep 04 09:43:51 2013 +0100
@@ -142,10 +142,22 @@
to the bags elements."
^ contents
+
+ "
+ Bag new
+ add:'abc';
+ add:'def';
+ add:'ghi';
+ add:'abc';
+ add:'def';
+ add:'abc';
+ add:'abc';
+ contents
+ "
!
sortedCounts
- "Answer with a collection of counts with elements, sorted by decreasing count."
+ "Answer with a collection of counts associated to elements, sorted by decreasing count."
"Suggested by l. Uzonyi"
^ (Array new:contents size
@@ -154,6 +166,18 @@
])
sort:[:x :y | x >= y ];
yourself
+
+ "
+ Bag new
+ add:'abc';
+ add:'def';
+ add:'ghi';
+ add:'abc';
+ add:'def';
+ add:'abc';
+ add:'abc';
+ sortedCounts
+ "
! !
!Bag methodsFor:'adding & removing'!
@@ -486,10 +510,10 @@
!Bag class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Bag.st,v 1.47 2013-08-23 00:21:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Bag.st,v 1.49 2013-08-31 13:17:33 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Bag.st,v 1.47 2013-08-23 00:21:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Bag.st,v 1.49 2013-08-31 13:17:33 cg Exp $'
! !
--- a/Behavior.st Wed Aug 28 10:49:29 2013 +0100
+++ b/Behavior.st Wed Sep 04 09:43:51 2013 +0100
@@ -3882,6 +3882,20 @@
"Created: / 24-07-2007 / 06:12:27 / cg"
!
+anySubInstance
+ "return any of my or derived instances; raise an error, if there is none"
+
+ "Read the documentation on why there seem to be no
+ instances of SmallInteger and UndefinedObject"
+
+ self allSubInstancesDo:[:anObject | ^ anObject].
+ self errorNotFound
+
+ "
+ View anySubInstance
+ "
+!
+
derivedInstanceCount
"return the number of instances of myself and of subclasses"
@@ -5011,10 +5025,10 @@
!Behavior class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.346 2013-08-22 08:42:13 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.348 2013-09-03 21:49:56 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.346 2013-08-22 08:42:13 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.348 2013-09-03 21:49:56 cg Exp $'
! !
--- a/CharacterArray.st Wed Aug 28 10:49:29 2013 +0100
+++ b/CharacterArray.st Wed Sep 04 09:43:51 2013 +0100
@@ -335,7 +335,7 @@
^ $\
!
-matchScan:matchScanArray from:matchStart to:matchStop with:aString from:start to:stop ignoreCase:ignoreCase
+matchScan:matchScanArray from:matchStart to:matchStop with:aString from:start to:stop caseSensitive:caseSensitive
"helper for match; return true if the characters from start to stop in
aString are matching the scan in matchScan from matchStart to matchStop.
The matchScan is as created by asMatchScanArray.
@@ -364,160 +364,160 @@
"/ Transcript showCR:('match: ''' , (aString copyFrom:sStart to:sStop) ,
"/ ''' against:' , (matchScanArray copyFrom:mStart to:mStop) printString).
- mSize := mStop - mStart + 1.
- sSize := sStop - sStart + 1.
-
- "empty strings match"
- (mSize == 0) ifTrue:[^ (sSize == 0)].
-
- matchEntry := matchScanArray at:mStart.
-
- "/ the most common case first:
- (sSize ~~ 0
- and:[(checkChar := (aString at:sStart)) = matchEntry]) ifTrue:[
- "advance by one and continue"
- mStart := mStart + 1.
- sStart := sStart + 1
- ] ifFalse:[
- (matchEntry == #any) ifTrue:[
- "restString empty -> no match"
- (sSize == 0) ifTrue:[^ false].
- "# matches single character"
- ((sSize == 1) and:[mSize == 1]) ifTrue:[^ true].
- "advance by one and continue"
- mStart := mStart + 1.
- sStart := sStart + 1
- ] ifFalse:[
- (matchEntry == #anyString) ifTrue:[
- "* alone matches anything"
- (mSize == 1) ifTrue:[^ true].
- "restString empty & matchString not empty -> no match"
- (sSize == 0) ifTrue:[^ false].
-
- "
- try to avoid some of the recursion by checking last
- character and continue with shortened strings if possible
- "
- quickCheck := false.
- (mStop >= mStart) ifTrue:[
- matchLast := matchScanArray at:mStop.
- (matchLast ~~ #anyString) ifTrue:[
- (matchLast == #any) ifTrue:[
- quickCheck := true
- ] ifFalse:[
- matchLast == (aString at:sStop) ifTrue:[
- quickCheck := true
- ] ifFalse:[
- matchLast isString ifTrue:[
- quickCheck := matchLast includes:(aString at:sStop)
- ]
- ]
- ]
- ]
- ].
- quickCheck ifTrue:[
- "
- quickCheck ok, advance from the right
- "
- mStop := mStop - 1.
- sStop := sStop - 1
- ] ifFalse:[
- "/ no quick check;
- "/ look for the next character(s)
- "/ and try matching there
- "/ (to avoid recursion)
-
- mStart < mStop ifTrue:[
- nextMatchEntry := matchScanArray at:mStart+1.
- nextMatchEntry isCharacter ifTrue:[
- sStart <= sStop ifTrue:[
- [true] whileTrue:[
- ignoreCase ifFalse:[
- index := aString indexOf:nextMatchEntry startingAt:sStart
- ] ifTrue:[
- index := aString findFirst:[:c | c asLowercase = nextMatchEntry asLowercase]
- startingAt:sStart.
- ].
- (index == 0 or:[index > sStop]) ifTrue:[
- ^ false
- ].
- (self matchScan:matchScanArray
- from:(mStart + 1)
- to:mStop
- with:aString
- from:index
- to:sStop
- ignoreCase:ignoreCase
- ) ifTrue:[
- ^ true
- ].
- sStart := index + 1.
- ]
- ]
- ]
- ].
-
- "
- no quick check possible;
- loop over all possible substrings
- "
- index := sStart.
- [index <= sStop] whileTrue:[
- (self matchScan:matchScanArray
- from:(mStart + 1)
- to:mStop
- with:aString
- from:index
- to:sStop
- ignoreCase:ignoreCase
- ) ifTrue:[
- ^ true
- ].
- index := index + 1
- ].
- ^ false
- ].
- ] ifFalse:[
- (matchEntry isString) ifTrue:[
- "testString empty -> no match"
- (sSize == 0) ifTrue:[^ false].
-
- included := false.
- "/ checkChar := aString at:sStart.
- included := matchEntry includes:checkChar.
- included ifFalse:[
- ignoreCase ifTrue:[
- checkChar isUppercase ifTrue:[
- included := matchEntry includes:checkChar asLowercase.
- ] ifFalse:[
- included := matchEntry includes:checkChar asUppercase.
- ]
- ].
- ].
- mStart := mStart + 1.
- mSize := mSize - 1.
- included ifFalse:[^ false].
-
- ((sSize == 1) and:[mSize == 0]) ifTrue:[^ true].
- ] ifFalse:[
- "/ must be single character
-
- "testString empty ?"
- (sSize == 0) ifTrue:[^ false].
-
- "first characters equal ?"
- "/ checkChar := aString at:sStart.
- ignoreCase ifFalse:[^ false].
- (checkChar asUppercase ~= matchEntry asUppercase) ifTrue:[^ false].
-
- "advance and continue"
- mStart := mStart + 1.
- ].
- "cut off 1st char and continue"
- sStart := sStart + 1
- ]
- ]
- ]
+ mSize := mStop - mStart + 1.
+ sSize := sStop - sStart + 1.
+
+ "empty strings match"
+ (mSize == 0) ifTrue:[^ (sSize == 0)].
+
+ matchEntry := matchScanArray at:mStart.
+
+ "/ the most common case first:
+ (sSize ~~ 0
+ and:[(checkChar := (aString at:sStart)) = matchEntry]) ifTrue:[
+ "advance by one and continue"
+ mStart := mStart + 1.
+ sStart := sStart + 1
+ ] ifFalse:[
+ (matchEntry == #any) ifTrue:[
+ "restString empty -> no match"
+ (sSize == 0) ifTrue:[^ false].
+ "# matches single character"
+ ((sSize == 1) and:[mSize == 1]) ifTrue:[^ true].
+ "advance by one and continue"
+ mStart := mStart + 1.
+ sStart := sStart + 1
+ ] ifFalse:[
+ (matchEntry == #anyString) ifTrue:[
+ "* alone matches anything"
+ (mSize == 1) ifTrue:[^ true].
+ "restString empty & matchString not empty -> no match"
+ (sSize == 0) ifTrue:[^ false].
+
+ "
+ try to avoid some of the recursion by checking last
+ character and continue with shortened strings if possible
+ "
+ quickCheck := false.
+ (mStop >= mStart) ifTrue:[
+ matchLast := matchScanArray at:mStop.
+ (matchLast ~~ #anyString) ifTrue:[
+ (matchLast == #any) ifTrue:[
+ quickCheck := true
+ ] ifFalse:[
+ matchLast == (aString at:sStop) ifTrue:[
+ quickCheck := true
+ ] ifFalse:[
+ matchLast isString ifTrue:[
+ quickCheck := matchLast includes:(aString at:sStop)
+ ]
+ ]
+ ]
+ ]
+ ].
+ quickCheck ifTrue:[
+ "
+ quickCheck ok, advance from the right
+ "
+ mStop := mStop - 1.
+ sStop := sStop - 1
+ ] ifFalse:[
+ "/ no quick check;
+ "/ look for the next character(s)
+ "/ and try matching there
+ "/ (to avoid recursion)
+
+ mStart < mStop ifTrue:[
+ nextMatchEntry := matchScanArray at:mStart+1.
+ nextMatchEntry isCharacter ifTrue:[
+ sStart <= sStop ifTrue:[
+ [true] whileTrue:[
+ caseSensitive ifTrue:[
+ index := aString indexOf:nextMatchEntry startingAt:sStart
+ ] ifFalse:[
+ index := aString findFirst:[:c | c asLowercase = nextMatchEntry asLowercase]
+ startingAt:sStart.
+ ].
+ (index == 0 or:[index > sStop]) ifTrue:[
+ ^ false
+ ].
+ (self matchScan:matchScanArray
+ from:(mStart + 1)
+ to:mStop
+ with:aString
+ from:index
+ to:sStop
+ caseSensitive:caseSensitive
+ ) ifTrue:[
+ ^ true
+ ].
+ sStart := index + 1.
+ ]
+ ]
+ ]
+ ].
+
+ "
+ no quick check possible;
+ loop over all possible substrings
+ "
+ index := sStart.
+ [index <= sStop] whileTrue:[
+ (self matchScan:matchScanArray
+ from:(mStart + 1)
+ to:mStop
+ with:aString
+ from:index
+ to:sStop
+ caseSensitive:caseSensitive
+ ) ifTrue:[
+ ^ true
+ ].
+ index := index + 1
+ ].
+ ^ false
+ ].
+ ] ifFalse:[
+ (matchEntry isString) ifTrue:[
+ "testString empty -> no match"
+ (sSize == 0) ifTrue:[^ false].
+
+ included := false.
+ "/ checkChar := aString at:sStart.
+ included := matchEntry includes:checkChar.
+ included ifFalse:[
+ caseSensitive ifFalse:[
+ checkChar isUppercase ifTrue:[
+ included := matchEntry includes:checkChar asLowercase.
+ ] ifFalse:[
+ included := matchEntry includes:checkChar asUppercase.
+ ]
+ ].
+ ].
+ mStart := mStart + 1.
+ mSize := mSize - 1.
+ included ifFalse:[^ false].
+
+ ((sSize == 1) and:[mSize == 0]) ifTrue:[^ true].
+ ] ifFalse:[
+ "/ must be single character
+
+ "testString empty ?"
+ (sSize == 0) ifTrue:[^ false].
+
+ "first characters equal ?"
+ "/ checkChar := aString at:sStart.
+ caseSensitive ifTrue:[^ false].
+ (checkChar asUppercase ~= matchEntry asUppercase) ifTrue:[^ false].
+
+ "advance and continue"
+ mStart := mStart + 1.
+ ].
+ "cut off 1st char and continue"
+ sStart := sStart + 1
+ ]
+ ]
+ ]
].
"
@@ -526,13 +526,13 @@
scanArray := self matchScanArrayFrom:'*hello'.
s := 'foo bar hello world'.
CharacterArray
- matchScan:scanArray
- from:1
- to:scanArray size
- with:s
- from:1
- to:s size
- ignoreCase:false
+ matchScan:scanArray
+ from:1
+ to:scanArray size
+ with:s
+ from:1
+ to:s size
+ caseSensitive:true
"
"
|scanArray s|
@@ -540,13 +540,59 @@
scanArray := self matchScanArrayFrom:'*hello*'.
s := 'foo bar hello world'.
CharacterArray
- matchScan:scanArray
- from:1
- to:scanArray size
- with:s
- from:1
- to:s size
- ignoreCase:false
+ matchScan:scanArray
+ from:1
+ to:scanArray size
+ with:s
+ from:1
+ to:s size
+ caseSensitive:true
+ "
+
+ "Modified: / 24-07-2011 / 07:17:03 / cg"
+ "Modified (comment): / 24-07-2011 / 08:55:14 / cg"
+!
+
+matchScan:matchScanArray from:matchStart to:matchStop with:aString from:start to:stop ignoreCase:ignoreCase
+ <resource: #obsolete>
+ "helper for match; return true if the characters from start to stop in
+ aString are matching the scan in matchScan from matchStart to matchStop.
+ The matchScan is as created by asMatchScanArray.
+
+ This algorithm is not at all the most efficient;
+ for heavy duty pattern matching, an interface (primitive) to the regex
+ pattern matching package should be added."
+
+ ^ self
+ matchScan:matchScanArray from:matchStart to:matchStop with:aString from:start to:stop caseSensitive:ignoreCase not
+
+ "
+ |scanArray s|
+
+ scanArray := self matchScanArrayFrom:'*hello'.
+ s := 'foo bar hello world'.
+ CharacterArray
+ matchScan:scanArray
+ from:1
+ to:scanArray size
+ with:s
+ from:1
+ to:s size
+ ignoreCase:false
+ "
+ "
+ |scanArray s|
+
+ scanArray := self matchScanArrayFrom:'*hello*'.
+ s := 'foo bar hello world'.
+ CharacterArray
+ matchScan:scanArray
+ from:1
+ to:scanArray size
+ with:s
+ from:1
+ to:s size
+ ignoreCase:false
"
"Modified: / 24-07-2011 / 07:17:03 / cg"
@@ -2214,7 +2260,24 @@
"Modified: 22.4.1996 / 15:56:17 / cg"
!
+sameAs:aString caseSensitive:caseSensitive
+ "Compare the receiver with the argument.
+ If caseSensitive is false, this is the same as #sameAs:,
+ if false, this is the same as #=."
+
+ caseSensitive ifFalse:[
+ ^ self sameAs:aString
+ ].
+ ^ self = aString
+
+ "
+ 'foo' sameAs:'Foo' caseSensitive:false
+ 'foo' sameAs:'foo' caseSensitive:true
+ "
+!
+
sameAs:aString ignoreCase:ignoreCase
+ <resource: #obsolete>
"Compare the receiver with the argument.
If ignoreCase is true, this is the same as #sameAs:,
if false, this is the same as #=."
@@ -2494,23 +2557,26 @@
!
asCollectionOfSubstringsSeparatedBy:aCharacter
- "return a collection containing the lines (separated by aCharacter)
- of the receiver. If aCharacter occurs multiple times in a row,
- the result will contain empty strings."
+ "return a collection containing substrings (separated by aCharacter)
+ of the receiver.
+ If aCharacter occurs multiple times in a row, the result will contain empty strings.
+ If the receiver ends with aCharacter, an empty string with be the last result element."
^ self asCollectionOfSubCollectionsSeparatedBy:aCharacter
"
- '1 one:2 two:3 three:4 four:5 five' withCRs asCollectionOfSubstringsSeparatedBy:$:
- '1 one 2 two 3 three 4 four 5 five' withCRs asCollectionOfSubstringsSeparatedBy:Character space
+ '1 one:2 two:3 three:4 four:5 five' asCollectionOfSubstringsSeparatedBy:$:
+ '1 one:2 two:3 three:4 four:5 five:' asCollectionOfSubstringsSeparatedBy:$:
+ '1 one 2 two 3 three 4 four 5 five' asCollectionOfSubstringsSeparatedBy:Character space
"
!
asCollectionOfSubstringsSeparatedBy:aCharacter exceptIn:ch
- "return a collection containing the lines (separated by aCharacter)
+ "return a collection containing the substrings (separated by aCharacter)
of the receiver. If aCharacter occurs multiple times in a row,
- the result will contain empty strings. The separation is not done,
- inside a matching pair of ch-substrings. Can be used to tokenize csv-like strings."
+ the result will contain empty strings.
+ The separation is not done, inside a matching pair of ch-substrings.
+ Can be used to tokenize csv-like strings, which may or may not be enclosed in quotes."
|lines myClass except i c
startIndex "{ Class:SmallInteger }"
@@ -3969,11 +4035,11 @@
This is usable with fileName pattern fields.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
- ^self compoundMatch:aString ignoreCase:false
+ ^self compoundMatch:aString caseSensitive:true
"
'f*' match:'foo'
@@ -3988,27 +4054,54 @@
"Modified: / 16.12.1999 / 01:22:08 / cg"
!
-compoundMatch:aString ignoreCase:ignoreCase
+compoundMatch:aString caseSensitive:caseSensitive
"like match, but the receiver may be a compound match pattern,
consisting of multiple simple GLOB patterns, separated by semicolons.
This is usable with fileName pattern fields.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
|matchers|
matchers := self asCollectionOfSubstringsSeparatedBy:$;.
- ^ matchers contains:[:aPattern |
- aPattern match:aString ignoreCase:ignoreCase escapeCharacter:nil
- ].
-
-"/ matchers do:[:aPattern |
-"/ (aPattern match:aString ignoreCase:ignoreCase) ifTrue:[^ true].
-"/ ].
-"/ ^ false.
+ ^ matchers
+ contains:[:aPattern |
+ aPattern match:aString ignoreCase:caseSensitive not escapeCharacter:nil
+ ].
+
+ "
+ 'f*' match:'foo'
+ 'b*' match:'foo'
+ 'f*;b*' match:'foo'
+ 'f*;b*' match:'bar'
+ 'f*;b*' compoundMatch:'foo'
+ 'f*;b*' compoundMatch:'bar'
+ 'f*;b*' compoundMatch:'Foo' caseSensitive:false
+ 'f*;b*' compoundMatch:'Bar' caseSensitive:false
+ 'f*;b*' compoundMatch:'ccc' caseSensitive:false
+ "
+
+ "Modified: / 15.4.1997 / 15:50:33 / cg"
+ "Modified: / 30.1.1998 / 11:40:18 / stefan"
+ "Created: / 16.12.1999 / 01:21:35 / cg"
+!
+
+compoundMatch:aString ignoreCase:ignoreCase
+ <resource: #obsolete>
+
+ "like match, but the receiver may be a compound match pattern,
+ consisting of multiple simple GLOB patterns, separated by semicolons.
+ This is usable with fileName pattern fields.
+
+ NOTICE: match-meta character interpretation is like in unix-matching (glob),
+ NOT the ST-80 meaning.
+ NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
+ NOTICE: the receiver is the match pattern"
+
+ ^ self compoundMatch:aString caseSensitive:ignoreCase not
"
'f*' match:'foo'
@@ -4053,7 +4146,7 @@
^ self findMatchString:matchString startingAt:index ignoreCase:false ifAbsent:0
!
-findMatchString:matchString startingAt:index ignoreCase:ignoreCase ifAbsent:exceptionBlock
+findMatchString:matchString startingAt:index caseSensitive:caseSensitive ifAbsent:exceptionBlock
"like findString, but allowing GLOB match patterns.
find matchstring, starting at index. if found, return the index;
if not found, return the result of evaluating exceptionBlock.
@@ -4087,7 +4180,7 @@
firstChar asString includesMatchCharacters ifTrue:[
index to:mySize do:[:col |
- (realMatchString match:self from:col to:mySize ignoreCase:ignoreCase)
+ (realMatchString match:self from:col to:mySize caseSensitive:caseSensitive)
ifTrue:[^ col]
].
^ exceptionBlock value.
@@ -4095,14 +4188,14 @@
lcChar := firstChar asLowercase.
ucChar := firstChar asUppercase.
- (ignoreCase and:[ lcChar ~= ucChar]) ifTrue:[
+ (caseSensitive not and:[ lcChar ~= ucChar ]) ifTrue:[
firstSet := Array with:ucChar with:lcChar.
startIndex := self indexOfAny:firstSet startingAt:index.
] ifFalse:[
startIndex := self indexOf:firstChar startingAt:index.
].
[startIndex == 0] whileFalse:[
- (realMatchString match:self from:startIndex to:mySize ignoreCase:ignoreCase)
+ (realMatchString match:self from:startIndex to:mySize caseSensitive:caseSensitive)
ifTrue:[^ startIndex].
firstSet notNil ifTrue:[
@@ -4116,6 +4209,34 @@
"
'one two three four' findMatchString:'o[nu]'
'one two three four' findMatchString:'o[nu]' startingAt:3
+ 'one two three four one' findMatchString:'ONE' startingAt:3 caseSensitive:false ifAbsent:0
+ 'one two three four one' findMatchString:'ONE' startingAt:3 caseSensitive:true ifAbsent:0
+ 'one two three four ONE' findMatchString:'O#E' startingAt:1 caseSensitive:false ifAbsent:0
+ 'one two three four ONE' findMatchString:'O#E' startingAt:1 caseSensitive:true ifAbsent:0
+ 12345678901234567890
+ "
+
+ "Modified: 13.9.1997 / 06:31:22 / cg"
+!
+
+findMatchString:matchString startingAt:index ignoreCase:ignoreCase ifAbsent:exceptionBlock
+ <resource: #obsolete>
+ "like findString, but allowing GLOB match patterns.
+ find matchstring, starting at index. if found, return the index;
+ if not found, return the result of evaluating exceptionBlock.
+ This is a q&d hack - not very efficient.
+
+ NOTICE: match-meta character interpretation is like in unix-matching (glob),
+ NOT the ST-80 meaning.
+ NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
+ NOTICE: the argument is the match pattern"
+
+ ^ self
+ findMatchString:matchString startingAt:index caseSensitive:ignoreCase not ifAbsent:exceptionBlock
+
+ "
+ 'one two three four' findMatchString:'o[nu]'
+ 'one two three four' findMatchString:'o[nu]' startingAt:3
'one two three four one' findMatchString:'ONE' startingAt:3 ignoreCase:true ifAbsent:0
"
@@ -4177,11 +4298,11 @@
The escape character is the backQuote.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
- ^ self match:aString from:1 to:aString size ignoreCase:false
+ ^ self match:aString from:1 to:aString size caseSensitive:true
"
'\*f*' match:'f'
@@ -4202,6 +4323,87 @@
"Modified: / 9.6.1998 / 18:50:00 / cg"
!
+match:aString caseSensitive:caseSensitive
+ "return true if aString matches self, where self may contain GLOB meta-match
+ characters $* (to match any string) or $# (to match any character)
+ or [...] to match a set of characters.
+ If caseSensitive is false, lower/uppercase are considered the same.
+ The escape character is the backQuote.
+
+ NOTICE: match-meta character interpretation is like in unix-matching (glob),
+ NOT the ST-80 meaning.
+ NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
+ NOTICE: the receiver is the match pattern"
+
+ ^ self match:aString from:1 to:aString size caseSensitive:caseSensitive
+
+ "
+ '*ute*' match:'COMPUTER' caseSensitive:false
+ '*uter' match:'COMPUTER' caseSensitive:true
+ '[abcd]*' match:'computer' caseSensitive:true
+ '[abcd]*' match:'Computer' caseSensitive:true
+ '[a-k]*' match:'komputer' caseSensitive:true
+ '[a-k]*' match:'zomputer' caseSensitive:true
+ '[a-k]*' match:'Komputer' caseSensitive:true
+ '[a-k]*' match:'Komputer' caseSensitive:false
+ '*some*compl*ern*' match:'this is some more complicated pattern match' caseSensitive:false
+ '*some*compl*ern*' match:'this is another complicated pattern match' caseSensitive:false
+
+ Time millisecondsToRun:[
+ Symbol allInstancesDo:[:sym |
+ '[ab]*' match:sym caseSensitive:true
+ ]
+ ].
+ Time millisecondsToRun:[
+ Symbol allInstancesDo:[:sym |
+ '*at:*' match:sym caseSensitive:true
+ ]
+ ].
+ "
+
+ "Modified: 2.4.1997 / 17:28:58 / cg"
+!
+
+match:aString caseSensitive:caseSensitive escapeCharacter:escape
+ "return true if aString matches self, where self may contain GLOB meta-match
+ characters $* (to match any string) or $# (to match any character)
+ or [...] to match a set of characters.
+ If caseSensitive is false, lower/uppercase are considered the same.
+
+ NOTICE: match-meta character interpretation is like in unix-matching (glob),
+ NOT the ST-80 meaning.
+ NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
+ NOTICE: the receiver is the match pattern"
+
+ ^ self match:aString from:1 to:aString size caseSensitive:caseSensitive escapeCharacter:escape
+
+ "
+ '*ute*' match:'COMPUTER' caseSensitive:false
+ '*uter' match:'COMPUTER' caseSensitive:true
+ '[abcd]*' match:'computer' caseSensitive:true
+ '[abcd]*' match:'Computer' caseSensitive:true
+ '[a-k]*' match:'komputer' caseSensitive:true
+ '[a-k]*' match:'zomputer' caseSensitive:true
+ '[a-k]*' match:'Komputer' caseSensitive:true
+ '[a-k]*' match:'Komputer' caseSensitive:false
+ '*some*compl*ern*' match:'this is some more complicated pattern match' caseSensitive:false
+ '*some*compl*ern*' match:'this is another complicated pattern match' caseSensitive:false
+
+ Time millisecondsToRun:[
+ Symbol allInstancesDo:[:sym |
+ '[ab]*' match:sym caseSensitive:true
+ ]
+ ].
+ Time millisecondsToRun:[
+ Symbol allInstancesDo:[:sym |
+ '*at:*' match:sym caseSensitive:true
+ ]
+ ].
+ "
+
+ "Modified: 2.4.1997 / 17:28:58 / cg"
+!
+
match:aString escapeCharacter:escape
"return true if aString matches self, where self may contain GLOB meta-match
characters $* (to match any string) or $# (to match any character).
@@ -4221,7 +4423,80 @@
"
!
+match:aString from:start to:stop caseSensitive:caseSensitive
+ "return true if part of aString matches myself,
+ where self may contain GLOB meta-match
+ characters $* (to match any string) or $# (to match any character)
+ or [...] to match a set of characters.
+ If caseSensitive is false, lower/uppercase are considered the same.
+ The escape character is the backQuote.
+
+ NOTICE: match-meta character interpretation is like in unix-matching (glob),
+ NOT the ST-80 meaning.
+ NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
+ NOTICE: the receiver is the match pattern"
+
+ ^ self
+ match:aString from:start to:stop caseSensitive:caseSensitive
+ escapeCharacter:(self class matchEscapeCharacter)
+
+ "
+ '*ute*' match:'12345COMPUTER' from:1 to:5 caseSensitive:false
+ '*ute*' match:'12345COMPUTER' from:6 to:13 caseSensitive:false
+ "
+
+ "Modified: / 10.11.1998 / 21:43:46 / cg"
+!
+
+match:aString from:start to:stop caseSensitive:caseSensitive escapeCharacter:escape
+ "return true if part of aString matches myself,
+ where self may contain GLOB meta-match
+ characters $* (to match any string) or $# (to match any character)
+ or [...] to match a set of characters.
+ If caseSensitive is false, lower/uppercase are considered the same.
+
+ NOTICE: match-meta character interpretation is like in unix-matching (glob),
+ NOT the ST-80 meaning.
+ NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
+ NOTICE: the receiver is the match pattern"
+
+ |matchScanArray|
+
+ "
+ keep the matchScanArray from the most recent match -
+ avoids parsing the pattern over-and over if multiple searches
+ are done with the same pattern.
+ "
+ (PreviousMatch notNil
+ and:[PreviousMatch key = self]) ifTrue:[
+ matchScanArray := PreviousMatch value
+ ] ifFalse:[
+ matchScanArray := self class matchScanArrayFrom:self escapeCharacter:escape.
+ matchScanArray isNil ifTrue:[
+ 'CharacterArray [info]: invalid matchpattern:''' infoPrint. self infoPrint. ''' comparing for equality.' infoPrintCR.
+ ^ self = aString
+"/ ^ false
+ ].
+ PreviousMatch := self -> matchScanArray.
+ ].
+
+ ^ self class
+ matchScan:matchScanArray
+ from:1 to:matchScanArray size
+ with:aString
+ from:start to:stop
+ caseSensitive:caseSensitive
+
+ "
+ '*ute*' match:'12345COMPUTER' from:1 to:5 caseSensitive:false
+ '*ute*' match:'12345COMPUTER' from:6 to:13 caseSensitive:false
+ "
+
+ "Modified: / 10.11.1998 / 21:43:46 / cg"
+!
+
match:aString from:start to:stop ignoreCase:ignoreCase
+ <resource: #obsolete>
"return true if part of aString matches myself,
where self may contain GLOB meta-match
characters $* (to match any string) or $# (to match any character)
@@ -4247,6 +4522,7 @@
!
match:aString from:start to:stop ignoreCase:ignoreCase escapeCharacter:escape
+ <resource: #obsolete>
"return true if part of aString matches myself,
where self may contain GLOB meta-match
characters $* (to match any string) or $# (to match any character)
@@ -4254,36 +4530,14 @@
If ignoreCase is true, lower/uppercase are considered the same.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
- |matchScanArray|
-
- "
- keep the matchScanArray from the most recent match -
- avoids parsing the pattern over-and over if multiple searches
- are done with the same pattern.
- "
- (PreviousMatch notNil
- and:[PreviousMatch key = self]) ifTrue:[
- matchScanArray := PreviousMatch value
- ] ifFalse:[
- matchScanArray := self class matchScanArrayFrom:self escapeCharacter:escape.
- matchScanArray isNil ifTrue:[
- 'CharacterArray [info]: invalid matchpattern:''' infoPrint. self infoPrint. ''' comparing for equality.' infoPrintCR.
- ^ self = aString
-"/ ^ false
- ].
- PreviousMatch := self -> matchScanArray.
- ].
-
- ^ self class
- matchScan:matchScanArray
- from:1 to:matchScanArray size
- with:aString
- from:start to:stop
- ignoreCase:ignoreCase
+ ^ self
+ match:aString from:start to:stop
+ caseSensitive:ignoreCase not
+ escapeCharacter:escape
"
'*ute*' match:'12345COMPUTER' from:1 to:5 ignoreCase:true
@@ -4294,6 +4548,7 @@
!
match:aString ignoreCase:ignoreCase
+ <resource: #obsolete>
"return true if aString matches self, where self may contain GLOB meta-match
characters $* (to match any string) or $# (to match any character)
or [...] to match a set of characters.
@@ -4301,10 +4556,11 @@
The escape character is the backQuote.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
+ "/ leave it this way, in case a customer has redefined it for performance (for a while)
^ self match:aString from:1 to:aString size ignoreCase:ignoreCase
"
@@ -4320,14 +4576,14 @@
'*some*compl*ern*' match:'this is another complicated pattern match' ignoreCase:true
Time millisecondsToRun:[
- Symbol allInstancesDo:[:sym |
- '[ab]*' match:sym ignoreCase:false
- ]
+ Symbol allInstancesDo:[:sym |
+ '[ab]*' match:sym ignoreCase:false
+ ]
].
Time millisecondsToRun:[
- Symbol allInstancesDo:[:sym |
- '*at:*' match:sym ignoreCase:false
- ]
+ Symbol allInstancesDo:[:sym |
+ '*at:*' match:sym ignoreCase:false
+ ]
].
"
@@ -4335,6 +4591,7 @@
!
match:aString ignoreCase:ignoreCase escapeCharacter:escape
+ <resource: #obsolete>
"return true if aString matches self, where self may contain GLOB meta-match
characters $* (to match any string) or $# (to match any character)
or [...] to match a set of characters.
@@ -4388,7 +4645,21 @@
^ aPatternString match:self
!
+matches:aPatternString caseSensitive:caseSensitive
+ "return true if the receiver matches aString, where aPatternString may contain GLOB meta-match
+ characters $* (to match any string) or $# (to match any character).
+ or [...] to match a set of characters.
+
+ NOTICE: match-meta character interpretation is like in unix-matching (glob),
+ NOT the ST-80 meaning.
+ NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
+ NOTICE: the receiver is the match pattern"
+
+ ^ aPatternString match:self caseSensitive:caseSensitive
+!
+
matches:aPatternString ignoreCase:ignoreCase
+ <resource: #obsolete>
"return true if the receiver matches aString, where aPatternString may contain GLOB meta-match
characters $* (to match any string) or $# (to match any character).
or [...] to match a set of characters.
@@ -4399,7 +4670,7 @@
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
- ^ aPatternString match:self ignoreCase:ignoreCase
+ ^ aPatternString match:self caseSensitive:ignoreCase not
"Created: / 08-03-2012 / 03:11:11 / cg"
! !
@@ -4555,6 +4826,7 @@
"
'foo' paddedTo:10
123 printString paddedTo:10
+ '12345678901234' paddedTo:10
"
! !
@@ -5905,6 +6177,18 @@
"
!
+findString:subString caseSensitive:caseSensitive
+ "find a substring. if found, return the index;
+ if not found, return 0."
+
+ ^ self indexOfSubCollection:subString startingAt:1 ifAbsent:0 caseSensitive:caseSensitive
+
+ "
+ 'hello world' findString:'LLo' caseSensitive:true
+ 'hello world' findString:'LLo' caseSensitive:false
+ "
+!
+
findString:subString ifAbsent:exceptionBlock
"find a substring. If found, return the index;
if not found, return the result of evaluating exceptionBlock."
@@ -5913,6 +6197,7 @@
!
findString:subString ignoreCase:ignoreCase
+ <resource: #obsolete>
"find a substring. if found, return the index;
if not found, return 0."
@@ -6429,11 +6714,11 @@
!CharacterArray class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.512 2013-08-27 07:30:41 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.514 2013-09-02 15:06:20 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.512 2013-08-27 07:30:41 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.514 2013-09-02 15:06:20 cg Exp $'
!
version_HG
--- a/Class.st Wed Aug 28 10:49:29 2013 +0100
+++ b/Class.st Wed Sep 04 09:43:51 2013 +0100
@@ -21,7 +21,7 @@
category:'Kernel-Classes'
!
-Array variableSubclass:#ArrayWithSequenceNumberValidation
+Array subclass:#ArrayWithSequenceNumberValidation
instanceVariableNames:'sequenceNumber'
classVariableNames:''
poolDictionaries:''
@@ -455,9 +455,6 @@
"Modified: 23.4.1996 / 15:56:58 / cg"
! !
-
-
-
!Class methodsFor:'Compatibility-Dolphin'!
defaultCategoryForDolphinClasses
@@ -653,7 +650,6 @@
"Created: / 18.6.1998 / 22:08:45 / cg"
! !
-
!Class methodsFor:'accessing'!
addClassVarName:aString
@@ -1881,7 +1877,6 @@
"Created: / 18-07-2011 / 09:14:38 / cg"
! !
-
!Class methodsFor:'adding & removing'!
removeFromSystem
@@ -1969,7 +1964,6 @@
"Modified: 4.6.1997 / 14:48:02 / cg"
! !
-
!Class methodsFor:'changes management'!
addChangeRecordForChangeCategory
@@ -2800,13 +2794,14 @@
|encoder any16Bit|
any16Bit := self withAllPrivateClasses contains:[:cls |
- cls instAndClassMethods contains:
- [:m |
- |src|
-
- src := m source.
- src notNil and:[src isWideString]
- ]].
+ cls instAndClassMethods contains:[:m |
+ (methodFilter isNil or:[ (methodFilter value:m) ])
+ and:[
+ |src|
+
+ src := m source.
+ src notNil and:[src isWideString]
+ ]]].
any16Bit ifTrue:[
encoder := CharacterEncoder encoderForUTF8.
@@ -3348,7 +3343,6 @@
"
! !
-
!Class methodsFor:'printOut'!
htmlDocumentation
@@ -5649,11 +5643,11 @@
!Class class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.629 2013-08-10 11:14:10 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.630 2013-09-03 23:29:36 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.629 2013-08-10 11:14:10 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.630 2013-09-03 23:29:36 cg Exp $'
!
version_HG
--- a/Collection.st Wed Aug 28 10:49:29 2013 +0100
+++ b/Collection.st Wed Sep 04 09:43:51 2013 +0100
@@ -259,7 +259,6 @@
^ self withSize:n
! !
-
!Collection class methodsFor:'Signal constants'!
emptyCollectionSignal
@@ -531,7 +530,6 @@
].
! !
-
!Collection methodsFor:'accessing'!
anElement
@@ -1339,7 +1337,8 @@
!Collection methodsFor:'bulk operations'!
abs
- "absolute value of all elements in the collection"
+ "absolute value of all elements in the collection.
+ Elements are supposed to be numeric"
^ self collect:[:a | a abs]
@@ -1351,7 +1350,8 @@
!
negated
- "negated value of all elements in the collection"
+ "negated value of all elements in the collection.
+ Elements are supposed to be numeric"
^ self collect:[:a | a negated]
@@ -1363,7 +1363,8 @@
!
product
- "multiply up all elements."
+ "return the product of all elements which are supposed to be numeric.
+ Raises an error for an empty receiver."
^ self
fold:[:accum :each | accum * each].
@@ -1378,7 +1379,8 @@
!
sum
- "sum up all elements; return 0 for an empty collection."
+ "return the sum of all elements which are supposed to be numeric.
+ Returns 0 for an empty receiver."
self isEmpty ifTrue:[^ 0].
@@ -2219,6 +2221,34 @@
"
!
+collect:collectBlock thenSelect:selectBlock as:aCollectionClass
+ "first apply collectBlock to each element, then pass the result to
+ selectBlock.
+ Return a new collection with all elements from the receiver,
+ for which the selectBlock evaluates to true.
+ Returns the same as if three separate collect+select+as messages were sent,
+ but avoids the creation of intermediate collections, so this is nicer for
+ big collections."
+
+ |newCollection|
+
+ newCollection := aCollectionClass new.
+ self do:[:each |
+ |rslt|
+
+ rslt := collectBlock value:each.
+ (selectBlock value:rslt) ifTrue:[newCollection add:rslt].
+ ].
+ ^ newCollection
+
+ "
+ #(1 2 3 4) select:[:e | e odd] thenCollect:[:e| e*e] as:OrderedCollection
+ (1 to:10) select:[:e | e even] thenCollect:[:e| e*e] as:IdentitySet
+ "
+
+ "Created: / 29-08-2013 / 09:56:20 / cg"
+!
+
collectAll:aBlock
"for each element in the receiver, evaluate the argument, aBlock.
The block is supposed to return a collection, whose elements are collected.
@@ -2247,6 +2277,32 @@
"
!
+collectAll:aBlock as:collectionClass
+ "for each element in the receiver, evaluate the argument, aBlock.
+ The block is supposed to return a collection, whose elements are collected.
+ The returned collection will be an instance of collectionClass"
+
+ |result|
+
+ result := collectionClass new.
+ self do:[:element |
+ |individualResult|
+
+ individualResult := aBlock value:element.
+ result addAll:individualResult.
+ ].
+
+ ^ result
+
+ "
+ #(1 2 3 4) collectAll:[:n | Array new:n withAll:n ] as:OrderedCollection
+ #(1 2 3 4) collectAll:[:n | Array new:n withAll:n ] as:Bag
+ #(1 2 3 4) collectAll:[:n | Array with:n with:n squared ] as: OrderedCollection
+ #(1 2 3 4) collectAll:[:n | 1 to:n ] as: Set
+ (Array with:Point with:Rectangle) collectAll:[:c | c instVarNames ] as:StringCollection
+ "
+!
+
count:aBlock
"count elements, for which aBlock returns true.
Return the sum."
@@ -3048,7 +3104,10 @@
select:selectBlock thenCollect:collectBlock as:aCollectionClass
"return a new collection with all elements from the receiver, for which
the argument selectBlock evaluates to true.
- Process the elements throgh collectBlock before adding."
+ Process the elements throgh collectBlock before adding.
+ Returns the same as if three separate collect+select+as: messages were sent,
+ but avoids the creation of intermediate collections, so this is nicer for
+ big collections."
|newCollection|
@@ -3941,7 +4000,7 @@
"return the longest common prefix of my elements.
Typically used with string collections."
- ^ self longestCommonPrefixIgnoreCase:false
+ ^ self longestCommonPrefixCaseSensitive:true
"
#('Array' 'ArrayedCollection' 'ArrayOfFoo') longestCommonPrefix
@@ -3953,8 +4012,8 @@
"Modified: 2.3.1997 / 00:21:41 / cg"
!
-longestCommonPrefixIgnoreCase:ignoreCase
- "return the longest common prefix of my elements (which must be sequenceableCollections).
+longestCommonPrefixCaseSensitive:caseSensitive
+ "return the longest common prefix of all of my elements (which must be sequenceable collections).
Typically used with string collections,
especially with completion of selectors or filenames."
@@ -3964,42 +4023,27 @@
longest isNil ifTrue:[
longest := eachCollection
] ifFalse:[
- longest := longest commonPrefixWith:eachCollection ignoreCase:ignoreCase
+ longest := longest commonPrefixWith:eachCollection caseSensitive:caseSensitive
]
].
^ longest.
-"/ |longest try allMatching matchLen|
-"/
-"/ "
-"/ find the longest common prefix
-"/ "
-"/ matchLen := 0.
-"/ self do:[:aName |
-"/ aName size > matchLen ifTrue:[
-"/ matchLen := aName size.
-"/ try := aName
-"/ ]
-"/ ].
-"/
-"/ allMatching := true.
-"/
-"/ [true] whileTrue:[
-"/ allMatching := true.
-"/ self do:[:aName |
-"/ ((ignoreCase not and:[aName startsWith:try])
-"/ or:[ignoreCase and:[aName asLowercase startsWith:try asLowercase]]) ifFalse:[
-"/ allMatching := false
-"/ ]
-"/ ].
-"/ allMatching ifTrue:[
-"/ ^ try
-"/ ].
-"/ matchLen := matchLen - 1.
-"/ matchLen == 0 ifTrue:[^ ''].
-"/ try := try copyTo:matchLen.
-"/ ].
-"/ ^ try
+ "
+ #('Array' 'arrayedCollection' 'ARRAYOfFoo') longestCommonPrefixCaseSensitive:false
+ #('Array' 'arrayedCollection' 'ARRAYOfFoo') longestCommonPrefixCaseSensitive:true
+ #('Array' 'ArayedCollection' 'ARRAYOfFoo') longestCommonPrefixCaseSensitive:true
+ #('AAA' 'A11' 'AA2') longestCommonPrefixCaseSensitive:true
+ #('AAA' 'BBB' 'CCC') longestCommonPrefixCaseSensitive:true
+ "
+!
+
+longestCommonPrefixIgnoreCase:ignoreCase
+ <resource: #obsolete>
+ "return the longest common prefix of my elements (which must be sequenceableCollections).
+ Typically used with string collections,
+ especially with completion of selectors or filenames."
+
+ ^ self longestCommonPrefixCaseSensitive:ignoreCase not
"
#('Array' 'arrayedCollection' 'ARRAYOfFoo') longestCommonPrefixIgnoreCase:true
@@ -4014,7 +4058,7 @@
"return the longest common suffix (tail) of my elements.
Typically used with string collections."
- ^ self longestCommonSuffixIgnoreCase:false
+ ^ self longestCommonSuffixCaseSensitive:true
"
#('abcdefg' '1234cdefg' 'aaaaaadefg') longestCommonSuffix
@@ -4023,7 +4067,7 @@
"Modified (comment): / 24-07-2011 / 10:32:15 / cg"
!
-longestCommonSuffixIgnoreCase:ignoreCase
+longestCommonSuffixCaseSensitive:caseSensitive
"return the longest common suffix (tail) of my elements
(which must be sequenceableCollections)."
@@ -4033,12 +4077,26 @@
longest isNil ifTrue:[
longest := eachCollection
] ifFalse:[
- longest := longest commonSuffixWith:eachCollection ignoreCase:ignoreCase
+ longest := longest commonSuffixWith:eachCollection caseSensitive:caseSensitive
]
].
^ longest.
"
+ #('Array' 'ByteArray' 'BigArray') longestCommonSuffixCaseSensitive:false
+ #('AAA' 'BBBAA' 'CCCAAAA') longestCommonSuffixCaseSensitive:true
+ #('AAA' 'BBB' 'CCC') longestCommonSuffixCaseSensitive:true
+ "
+!
+
+longestCommonSuffixIgnoreCase:ignoreCase
+ <resource: #obsolete>
+ "return the longest common suffix (tail) of my elements
+ (which must be sequenceableCollections)."
+
+ ^ self longestCommonSuffixCaseSensitive:ignoreCase not
+
+ "
#('Array' 'ByteArray' 'BigArray') longestCommonSuffixIgnoreCase:true
#('AAA' 'BBBAA' 'CCCAAAA') longestCommonSuffixIgnoreCase:false
#('AAA' 'BBB' 'CCC') longestCommonSuffixIgnoreCase:false
@@ -4842,11 +4900,11 @@
!Collection class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.309 2013-08-10 11:14:45 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.314 2013-09-03 12:53:22 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.309 2013-08-10 11:14:45 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.314 2013-09-03 12:53:22 cg Exp $'
! !
--- a/Filename.st Wed Aug 28 10:49:29 2013 +0100
+++ b/Filename.st Wed Sep 04 09:43:51 2013 +0100
@@ -4114,13 +4114,13 @@
The pattern may be a simple matchPattern, or a set of
multiple patterns separated by semicolons."
- |matchers notCaseSensitive|
+ |matchers caseSensitive|
matchers := aPattern asCollectionOfSubstringsSeparatedBy:$;.
- notCaseSensitive := self class isCaseSensitive not.
+ caseSensitive := self class isCaseSensitive.
^ self directoryContents
select:[:name |
- (matchers detect:[:p | p match:name ignoreCase:notCaseSensitive] ifNone:0) ~~ 0
+ (matchers detect:[:p | p match:name caseSensitive:caseSensitive] ifNone:0) ~~ 0
]
"
@@ -4138,16 +4138,16 @@
The pattern may be a simple matchPattern, or a set of
multiple patterns separated by semicolons."
- |matchers notCaseSensitive|
+ |matchers caseSensitive|
matchers := aPattern asCollectionOfSubstringsSeparatedBy:$;.
- notCaseSensitive := self class isCaseSensitive not.
+ caseSensitive := self class isCaseSensitive.
^ self directoryContents
select:[:name |
name ~= '.'
and:[name ~= '..'
- and:[(matchers detect:[:p | p match:name ignoreCase:notCaseSensitive] ifNone:0) ~~ 0]]
+ and:[(matchers detect:[:p | p match:name caseSensitive:caseSensitive] ifNone:0) ~~ 0]]
]
"
@@ -6050,11 +6050,11 @@
!Filename class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.402 2013-07-29 13:38:50 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.403 2013-08-31 19:30:24 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.402 2013-07-29 13:38:50 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.403 2013-08-31 19:30:24 cg Exp $'
! !
--- a/Geometric.st Wed Aug 28 10:49:29 2013 +0100
+++ b/Geometric.st Wed Sep 04 09:43:51 2013 +0100
@@ -504,6 +504,133 @@
!Geometric methodsFor:'transformations'!
+align:offset with:someCoordinate
+ self subclassResponsibility
+!
+
+alignBottomLeftWith:someCoordinate
+ "return a copy of myself where its bottomLeft is aligned with someCoordinate"
+
+ ^ self align:(self bounds bottomLeft) with:someCoordinate
+
+ "
+ |r1 r2 r3 v|
+
+ r1 := 0@0 corner:10@10.
+ r2 := 100@100 corner:200@200.
+ r3 := r1 copy alignBottomLeftWith:r2 corner.
+ v := (View extent:300@300) openAndWait.
+ r2 displayOn:v.
+ r3 displayOn:v.
+ "
+!
+
+alignBottomRightWith:someCoordinate
+ "return a copy of myself where its bottomRight is aligned with someCoordinate.
+ Same as alignCorner"
+
+ ^ self align:(self bounds corner) with:someCoordinate
+
+ "
+ |r1 r2 r3 v|
+
+ r1 := 0@0 corner:10@10.
+ r2 := 100@100 corner:200@200.
+ r3 := r1 copy alignBottomRightWith:r2 corner.
+ v := (View extent:300@300) openAndWait.
+ r2 displayOn:v.
+ r3 displayOn:v.
+ "
+!
+
+alignCenterWith:someCoordinate
+ "return a copy of myself where its center is aligned with someCoordinate.
+ Same as alignOrigin"
+
+ ^ self align:(self bounds center) with:someCoordinate
+
+ "
+ |r1 r2 r3 v|
+
+ r1 := 0@0 corner:10@10.
+ r2 := 100@100 corner:200@200.
+ r3 := r1 copy alignCenterWith:r2 corner.
+ v := (View extent:300@300) openAndWait.
+ r2 displayOn:v.
+ r3 displayOn:v.
+ "
+!
+
+alignCornerWith:someCoordinate
+ "return a copy of myself where its corner is aligned with someCoordinate"
+
+ ^ self align:(self bounds corner) with:someCoordinate
+
+ "
+ |r1 r2 r3 v|
+
+ r1 := 0@0 corner:10@10.
+ r2 := 100@100 corner:200@200.
+ r3 := r1 copy alignCornerWith:r2 corner.
+ v := (View extent:300@300) openAndWait.
+ r2 displayOn:v.
+ r3 displayOn:v.
+ "
+!
+
+alignOriginWith:someCoordinate
+ "return a copy of myself where its origin is aligned with someCoordinate"
+
+ ^ self align:(self bounds origin) with:someCoordinate
+
+ "
+ |r1 r2 r3 v|
+
+ r1 := 0@0 corner:10@10.
+ r2 := 100@100 corner:200@200.
+ r3 := r1 copy alignOriginWith:r2 corner.
+ v := (View extent:300@300) openAndWait.
+ r2 displayOn:v.
+ r3 displayOn:v.
+ "
+!
+
+alignTopLeftWith:someCoordinate
+ "return a copy of myself where its topLeft is aligned with someCoordinate.
+ Same as alignOrigin"
+
+ ^ self align:(self bounds origin) with:someCoordinate
+
+ "
+ |r1 r2 r3 v|
+
+ r1 := 0@0 corner:10@10.
+ r2 := 100@100 corner:200@200.
+ r3 := r1 copy alignTopLeftWith:r2 corner.
+ v := (View extent:300@300) openAndWait.
+ r2 displayOn:v.
+ r3 displayOn:v.
+ "
+!
+
+alignTopRightWith:someCoordinate
+ "return a copy of myself where its topRight is aligned with someCoordinate.
+ Same as alignOrigin"
+
+ ^ self align:(self bounds topRight) with:someCoordinate
+
+ "
+ |r1 r2 r3 v|
+
+ r1 := 0@0 corner:10@10.
+ r2 := 100@100 corner:200@200.
+ r3 := r1 copy alignTopRightWith:r2 corner.
+ v := (View extent:300@300) openAndWait.
+ r2 displayOn:v.
+ r3 displayOn:v.
+ "
+!
+
scaledBy:scaleAmount
"return a copy of the receiver, which is scaled by the argument,
a point or number"
@@ -525,14 +652,12 @@
!Geometric class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Geometric.st,v 1.31 2009/06/06 10:12:25 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Geometric.st,v 1.32 2013-08-31 11:46:29 cg Exp $'
!
version_SVN
^ '$Id: Geometric.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
Geometric initialize!
-
-
-
--- a/Method.st Wed Aug 28 10:49:29 2013 +0100
+++ b/Method.st Wed Sep 04 09:43:51 2013 +0100
@@ -2818,7 +2818,7 @@
!
methodArgAndVarNamesInContext: context
- "return a collection with the methods argument and variable names.
+ "return a collection with the method's argument and variable names.
Uses Parser to parse methods source and extract the names.
Returns nil if the source is not available, or some other
syntax/parse error occurred. For methods with no args and no vars,
@@ -3851,11 +3851,11 @@
!Method class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.423 2013-08-20 07:21:58 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.424 2013-08-30 22:24:50 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.423 2013-08-20 07:21:58 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.424 2013-08-30 22:24:50 cg Exp $'
!
version_HG
--- a/MethodWithBreakpoints.st Wed Aug 28 10:49:29 2013 +0100
+++ b/MethodWithBreakpoints.st Wed Sep 04 09:43:51 2013 +0100
@@ -70,10 +70,12 @@
(cls := self mclass) notNil ifTrue:[
(selector := self selector) notNil ifTrue:[
- self halt.
+ self breakPoint:#cg.
cls basicAddSelector:selector withMethod:originalMethod
]
]
+
+ "Modified: / 29-08-2013 / 01:17:05 / cg"
! !
!MethodWithBreakpoints methodsFor:'queries'!
@@ -87,10 +89,10 @@
!MethodWithBreakpoints class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/MethodWithBreakpoints.st,v 1.2 2013-07-09 20:22:44 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MethodWithBreakpoints.st,v 1.3 2013-08-28 23:18:23 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/MethodWithBreakpoints.st,v 1.2 2013-07-09 20:22:44 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MethodWithBreakpoints.st,v 1.3 2013-08-28 23:18:23 cg Exp $'
! !
--- a/MiniDebugger.st Wed Aug 28 10:49:29 2013 +0100
+++ b/MiniDebugger.st Wed Sep 04 09:43:51 2013 +0100
@@ -868,7 +868,7 @@
[:sel :cls |
|mthd|
- ((match includesMatchCharacters and:[ sel matches:match ignoreCase:true])
+ ((match includesMatchCharacters and:[ sel matches:match caseSensitive:false])
or:[ sel asLowercase startsWith:match asLowercase ]) ifTrue:[
mthd := cls compiledMethodAt:sel.
mthd category ~= 'documentation' ifTrue:[
@@ -1021,10 +1021,10 @@
!MiniDebugger class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.88 2013-08-26 09:45:54 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.89 2013-08-31 19:31:47 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.88 2013-08-26 09:45:54 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.89 2013-08-31 19:31:47 cg Exp $'
! !
--- a/NonPositionableExternalStream.st Wed Aug 28 10:49:29 2013 +0100
+++ b/NonPositionableExternalStream.st Wed Sep 04 09:43:51 2013 +0100
@@ -488,16 +488,6 @@
^ super atEnd.
!
-current
- "for compatibility with Transcript - allow Transcript current,
- even if redirected to the standardError"
-
- self == Transcript ifTrue:[
- ^ self
- ].
- ^ super current
-!
-
isPositionable
"return true, if the stream supports positioning (this one is not)"
@@ -578,10 +568,10 @@
!NonPositionableExternalStream class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/NonPositionableExternalStream.st,v 1.62 2013-02-06 14:47:34 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/NonPositionableExternalStream.st,v 1.63 2013-08-29 09:51:47 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/NonPositionableExternalStream.st,v 1.62 2013-02-06 14:47:34 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/NonPositionableExternalStream.st,v 1.63 2013-08-29 09:51:47 cg Exp $'
! !
--- a/Object.st Wed Aug 28 10:49:29 2013 +0100
+++ b/Object.st Wed Sep 04 09:43:51 2013 +0100
@@ -3216,7 +3216,9 @@
'------> ' infoPrint. message infoPrintCR
].
- self halt:'Please fix this now!!'
+ UserPreferences current haltInObsoleteMethod ifTrue:[
+ self halt:(message , ' - please fix this now!!')
+ ].
"
Object obsoleteMethodWarning:'foo' from:thisContext sender sender
@@ -3274,7 +3276,7 @@
"Example: nil tracePoint:#stefan"
(self isBreakPointEnabled:someKey) ifTrue:[
- ^ Transcript showCR:('Trace (at %1 for %3 from %2)'
+ ^ Transcript showCR:('Tracepoint (at %1 for %3 from %2)'
bindWith:(Timestamp now printString)
with:(thisContext sender printString)
with:someKey)
@@ -3286,6 +3288,8 @@
Smalltalk enableBreakPoint:#stefan.
Smalltalk disableBreakPoint:#stefan.
"
+
+ "Modified: / 28-08-2013 / 21:41:54 / cg"
!
tracePoint:someKey message:message
@@ -3299,7 +3303,7 @@
"Example: nil tracePoint:#stefan"
(self isBreakPointEnabled:someKey) ifTrue:[
- ^ Transcript showCR:('%4 (at %1 for %3 from %2)'
+ ^ Transcript showCR:('Tracepoint: %4 (at %1 for %3 from %2)'
bindWith:(Timestamp now printString)
with:(thisContext sender printString)
with:someKey
@@ -3312,6 +3316,8 @@
Smalltalk enableBreakPoint:#stefan.
Smalltalk disableBreakPoint:#stefan.
"
+
+ "Modified: / 28-08-2013 / 21:41:47 / cg"
! !
!Object methodsFor:'dependents access'!
@@ -9829,11 +9835,11 @@
!Object class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.734 2013-08-22 18:19:18 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.736 2013-08-29 10:33:35 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.734 2013-08-22 18:19:18 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.736 2013-08-29 10:33:35 cg Exp $'
!
version_HG
--- a/Rectangle.st Wed Aug 28 10:49:29 2013 +0100
+++ b/Rectangle.st Wed Sep 04 09:43:51 2013 +0100
@@ -1081,6 +1081,7 @@
"Modified: 8.5.1996 / 14:40:53 / cg"
! !
+
!Rectangle methodsFor:'printing & storing'!
printOn:aStream
@@ -1438,20 +1439,6 @@
"Created: 25.1.1997 / 17:30:21 / cg"
!
-align:offset with:someCoordinate
- "return a new rectangle which is translated (i.e. moved)
- such that the point offset in mySelf is placed on someCoordinate."
-
- ^ Rectangle origin:(someCoordinate - offset + self origin)
- extent:(self extent)
- "
- |r|
-
- r := Rectangle origin:10@10 corner:50@50.
- r align:(r center) with:100@100.
- "
-!
-
areasOutside: aRectangle
"Answer an Array of Rectangles comprising the parts of the receiver not
intersecting aRectangle."
@@ -1779,6 +1766,22 @@
^ true
! !
+!Rectangle methodsFor:'transformations'!
+
+align:offset with:someCoordinate
+ "return a new rectangle which is translated (i.e. moved)
+ such that the point offset in mySelf is placed on someCoordinate."
+
+ ^ Rectangle origin:(someCoordinate - offset + self origin)
+ extent:(self extent)
+ "
+ |r|
+
+ r := Rectangle origin:10@10 corner:50@50.
+ r align:(r center) with:100@100.
+ "
+! !
+
!Rectangle methodsFor:'truncation & rounding'!
rounded
@@ -1817,9 +1820,10 @@
!Rectangle class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Rectangle.st,v 1.84 2010-07-16 14:59:40 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Rectangle.st,v 1.85 2013-08-31 11:46:55 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Rectangle.st,v 1.84 2010-07-16 14:59:40 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Rectangle.st,v 1.85 2013-08-31 11:46:55 cg Exp $'
! !
+
--- a/SequenceableCollection.st Wed Aug 28 10:49:29 2013 +0100
+++ b/SequenceableCollection.st Wed Sep 04 09:43:51 2013 +0100
@@ -1763,7 +1763,7 @@
"
!
-commonPrefixWith:aCollection ignoreCase:ignoreCase
+commonPrefixWith:aCollection caseSensitive:caseSensitive
"return the common prefix of myself and the argument, aCollection.
If there is none, an empty collection is returned."
@@ -1771,24 +1771,55 @@
matchLen := self size min:aCollection size.
1 to:matchLen do:[:idx |
- |elHere elThere same|
-
- elHere := self at:idx.
- elThere := aCollection at:idx.
-
- ignoreCase ifTrue:[
- same := elHere sameAs:elThere
- ] ifFalse:[
- same := elHere = elThere
- ].
- same ifFalse:[
- ^ self copyTo:(idx - 1).
- ]
+ |elHere elThere same|
+
+ elHere := self at:idx.
+ elThere := aCollection at:idx.
+
+ caseSensitive ifFalse:[
+ same := elHere sameAs:elThere
+ ] ifTrue:[
+ same := elHere = elThere
+ ].
+ same ifFalse:[
+ ^ self copyTo:(idx - 1).
+ ]
].
^ self copyTo:matchLen
"
+ 'hello' commonPrefixWith:'hello' caseSensitive:false
+ 'hello' commonPrefixWith:'hElLo' caseSensitive:false
+ 'hello' commonPrefixWith:'hello world' caseSensitive:false
+ 'hello' commonPrefixWith:'hElLo WoRlD' caseSensitive:false
+
+ 'hello world' commonPrefixWith:'hello' caseSensitive:false
+ 'hello WoRlD' commonPrefixWith:'hElLo' caseSensitive:false
+
+ 'abcd' commonPrefixWith:'bcde' caseSensitive:false
+
+ 'abcd' commonPrefixWith:'abab' caseSensitive:false
+ 'abcd' commonPrefixWith:'aBAb' caseSensitive:false
+ 'abcd' commonPrefixWith:'ab' caseSensitive:false
+ 'abcd' commonPrefixWith:'ababab' caseSensitive:false
+ 'abcd' commonPrefixWith:'abcdef' caseSensitive:false
+
+ 'abab' commonPrefixWith:'abcd' caseSensitive:false
+ 'ab' commonPrefixWith:'abcd' caseSensitive:false
+ 'ababab' commonPrefixWith:'abcd' caseSensitive:false
+ 'abcdef' commonPrefixWith:'abcd' caseSensitive:false
+ "
+!
+
+commonPrefixWith:aCollection ignoreCase:ignoreCase
+ <resource: #obsolete>
+ "return the common prefix of myself and the argument, aCollection.
+ If there is none, an empty collection is returned."
+
+ ^ self commonPrefixWith:aCollection caseSensitive:ignoreCase not
+
+ "
'hello' commonPrefixWith:'hello' ignoreCase:true
'hello' commonPrefixWith:'hElLo' ignoreCase:true
'hello' commonPrefixWith:'hello world' ignoreCase:true
@@ -1842,7 +1873,7 @@
"
!
-commonSuffixWith:aCollection ignoreCase:ignoreCase
+commonSuffixWith:aCollection caseSensitive:caseSensitive
"return the common suffix (tail) of myself and the argument, aCollection.
If there is none, an empty collection is returned."
@@ -1852,24 +1883,56 @@
l2 := aCollection size.
matchLen := l1 min:l2.
1 to:matchLen do:[:idx |
- |elHere elThere same|
-
- elHere := self at:(l1 - idx + 1).
- elThere := aCollection at:(l2 - idx + 1).
-
- ignoreCase ifTrue:[
- same := elHere sameAs:elThere
- ] ifFalse:[
- same := elHere = elThere
- ].
- same ifFalse:[
- ^ self copyFrom:(l1 - idx + 2).
- ]
+ |elHere elThere same|
+
+ elHere := self at:(l1 - idx + 1).
+ elThere := aCollection at:(l2 - idx + 1).
+
+ caseSensitive ifFalse:[
+ same := elHere sameAs:elThere
+ ] ifTrue:[
+ same := elHere = elThere
+ ].
+ same ifFalse:[
+ ^ self copyFrom:(l1 - idx + 2).
+ ]
].
^ self copyFrom:(l1 - matchLen + 1)
"
+ 'hello' commonSuffixWith:'hello' caseSensitive:false
+ 'hello' commonSuffixWith:'hElLo' caseSensitive:false
+ 'hello' commonSuffixWith:'hello world' caseSensitive:false
+ 'hello' commonSuffixWith:'hElLo WoRlD' caseSensitive:false
+ 'hello2 world' commonSuffixWith:'hello world' caseSensitive:false
+ 'hello2 world' commonSuffixWith:'hElLo WoRlD' caseSensitive:false
+
+ 'hello world' commonSuffixWith:'world' caseSensitive:false
+ 'hello WoRlD' commonSuffixWith:'world' caseSensitive:false
+
+ 'dcba' commonSuffixWith:'edcb' caseSensitive:false
+
+ 'dcba' commonSuffixWith:'baba' caseSensitive:false
+ 'dcba' commonSuffixWith:'ba' caseSensitive:false
+ 'dcba' commonSuffixWith:'bababa' caseSensitive:false
+ 'dcba' commonSuffixWith:'fdcba' caseSensitive:false
+
+ 'baba' commonSuffixWith:'dcba' caseSensitive:false
+ 'ba' commonSuffixWith:'dcba' caseSensitive:false
+ 'bababa' commonSuffixWith:'dcba' caseSensitive:false
+ 'fdcba' commonSuffixWith:'dcba' caseSensitive:false
+ "
+!
+
+commonSuffixWith:aCollection ignoreCase:ignoreCase
+ <resource: #obsolete>
+ "return the common suffix (tail) of myself and the argument, aCollection.
+ If there is none, an empty collection is returned."
+
+ ^ self commonSuffixWith:aCollection caseSensitive:ignoreCase not
+
+ "
'hello' commonSuffixWith:'hello' ignoreCase:true
'hello' commonSuffixWith:'hElLo' ignoreCase:true
'hello' commonSuffixWith:'hello world' ignoreCase:true
@@ -9122,11 +9185,11 @@
!SequenceableCollection class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.350 2013-08-26 13:09:16 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.351 2013-08-31 19:23:31 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.350 2013-08-26 13:09:16 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.351 2013-08-31 19:23:31 cg Exp $'
! !
--- a/Smalltalk.st Wed Aug 28 10:49:29 2013 +0100
+++ b/Smalltalk.st Wed Sep 04 09:43:51 2013 +0100
@@ -2391,7 +2391,7 @@
|packageDir shLibName
binaryClassLibraryFilename projectDefinitionFilename projectDefinitionClass projectDefinitionClassName silent somethingHasBeenLoaded
- loadOK loadErrorOccurred exePath|
+ loadOK exePath errorInInitialize|
packageDirOrStringOrNil notNil ifTrue:[
packageDir := packageDirOrStringOrNil asFilename.
@@ -2497,6 +2497,9 @@
].
binaryClassLibraryFilename exists ifTrue:[
+ |loadErrorOccurred|
+
+ loadErrorOccurred := false.
ObjectFileLoader::ObjectFileLoadErrorNotification handle:[:ex |
loadErrorOccurred := true.
ex proceedWith:true.
@@ -2545,9 +2548,26 @@
projectDefinitionFilename exists ifTrue:[
Class withoutUpdatingChangesDo:[
Smalltalk silentlyLoadingDo:[
- projectDefinitionFilename fileIn.
+ Error handle:[:ex |
+ "/ catch error during initialization;
+ ex suspendedContext withAllSendersDo:[:sender |
+ sender selector == #initialize ifTrue:[
+ sender receiver isBehavior ifTrue:[
+ sender receiver name = projectDefinitionClassName ifTrue:[
+ errorInInitialize := true
+ ]
+ ]
+ ]
+ ].
+ errorInInitialize ifFalse:[ ex reject ].
+ ] do:[
+ projectDefinitionFilename fileIn.
+ ].
].
].
+ errorInInitialize ifTrue:[
+ Transcript showCR:'Smalltalk [info]: an error happened in #initialize - retry after loading package.'.
+ ].
projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
"/ done below
"/ projectDefinitionClass notNil ifTrue:[
@@ -2560,6 +2580,10 @@
projectDefinitionClass autoload.
projectDefinitionClass loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
somethingHasBeenLoaded := projectDefinitionClass loadAsAutoloaded:doLoadAsAutoloaded.
+ errorInInitialize ifTrue:[
+ Transcript showCR:('Smalltalk [info]: retrying #initialize').
+ projectDefinitionClass initialize.
+ ].
(silent not and:[somethingHasBeenLoaded]) ifTrue:[
Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageString , ' from project definition').
].
@@ -7995,11 +8019,11 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1035 2013-08-21 14:08:19 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1036 2013-09-02 15:18:35 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1035 2013-08-21 14:08:19 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1036 2013-09-02 15:18:35 cg Exp $'
!
version_HG
--- a/StandaloneStartup.st Wed Aug 28 10:49:29 2013 +0100
+++ b/StandaloneStartup.st Wed Sep 04 09:43:51 2013 +0100
@@ -852,7 +852,7 @@
patchesToLoad := patchesDir directoryContents.
aGlobString notEmptyOrNil ifTrue:[
patchesToLoad := patchesToLoad select:[:eachFilenameString|
- aGlobString match:eachFilenameString ignoreCase:true.
+ aGlobString match:eachFilenameString caseSensitive:false.
].
].
patchesToLoad sort do:[:eachFilenameString |
@@ -1168,11 +1168,11 @@
!StandaloneStartup class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.75 2013-07-09 16:48:12 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.76 2013-08-31 22:37:43 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.75 2013-07-09 16:48:12 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.76 2013-08-31 22:37:43 cg Exp $'
! !
--- a/Stream.st Wed Aug 28 10:49:29 2013 +0100
+++ b/Stream.st Wed Sep 04 09:43:51 2013 +0100
@@ -194,7 +194,6 @@
^ ChunkSeparator
! !
-
!Stream methodsFor:'accessing'!
contents
@@ -1873,6 +1872,19 @@
!Stream methodsFor:'queries'!
+current
+ "for compatibility with Transcript - allow Transcript current,
+ even if redirected to the standardError"
+
+ self == Transcript ifTrue:[
+ ^ self
+ ].
+ "/ this will raise an DNU error, usually.
+ ^ super current
+
+ "Modified (comment): / 29-08-2013 / 11:09:21 / cg"
+!
+
inputStream
"return the receiver.
for compatibility with filtering streams"
@@ -2750,6 +2762,16 @@
^ false
!
+isTextCollector
+ ^ false
+
+ "
+ Transcript isTextCollector
+ "
+
+ "Created: / 29-08-2013 / 11:33:10 / cg"
+!
+
notEmpty
"return true, if the contents of the stream is not empty"
@@ -3467,11 +3489,11 @@
!Stream class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Stream.st,v 1.209 2013-08-27 07:21:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Stream.st,v 1.210 2013-08-29 09:33:49 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Stream.st,v 1.209 2013-08-27 07:21:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Stream.st,v 1.210 2013-08-29 09:33:49 cg Exp $'
! !
--- a/UninterpretedBytes.st Wed Aug 28 10:49:29 2013 +0100
+++ b/UninterpretedBytes.st Wed Sep 04 09:43:51 2013 +0100
@@ -123,8 +123,7 @@
!
fromHexString:aString
- "Dolphin compatibility:
- decode a byteArray from a hex string (as generated by hexPrintOn:)"
+ "decode a byteArray from a hex string (as generated by hexPrintOn:)"
| sz bytes s hi lo |
@@ -135,9 +134,9 @@
bytes := self new: sz // 2.
s := aString readStream.
1 to: sz // 2 do: [ :idx |
- hi := s next digitValue.
- lo := s next digitValue.
- bytes at:idx put: ((hi bitShift:4) bitOr: lo)
+ hi := s next digitValue.
+ lo := s next digitValue.
+ bytes at:idx put: ((hi bitShift:4) bitOr: lo)
].
^ bytes
@@ -152,9 +151,11 @@
"
"
Time millisecondsToRun:[
- 1000000 timesRepeat:[ ByteArray fromHexString:'1234FEFF1234FEFF1234FEFF1234FEFF' ]
+ 1000000 timesRepeat:[ ByteArray fromHexString:'1234FEFF1234FEFF1234FEFF1234FEFF' ]
].
"
+
+ "Modified (comment): / 28-08-2013 / 20:40:04 / cg"
!
fromHexStringWithSeparators:aString
@@ -3024,10 +3025,10 @@
!UninterpretedBytes class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.93 2013-04-15 13:45:33 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.94 2013-08-28 18:41:01 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.93 2013-04-15 13:45:33 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.94 2013-08-28 18:41:01 cg Exp $'
! !
--- a/UserPreferences.st Wed Aug 28 10:49:29 2013 +0100
+++ b/UserPreferences.st Wed Sep 04 09:43:51 2013 +0100
@@ -1927,6 +1927,30 @@
"Modified: / 07-03-2011 / 23:56:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+toolTipShapeStyle
+ "return a symbol, or nil. If nil, the value from the stylesheet is used."
+
+ ^ self at:#toolTipShapeStyle ifAbsent:[ nil ]
+
+ "
+ UserPreferences current toolTipShapeStyle
+ UserPreferences current toolTipShapeStyle:#cartoon
+ UserPreferences current toolTipShapeStyle:nil
+ "
+!
+
+toolTipShapeStyle:aSymbolOrNil
+ "A symbol, or nil. If nil, the value from the stylesheet is used."
+
+ self at:#toolTipShapeStyle put:aSymbolOrNil
+
+ "
+ UserPreferences current toolTipShapeStyle
+ UserPreferences current toolTipShapeStyle:#cartoon
+ UserPreferences current toolTipShapeStyle:nil
+ "
+!
+
waitCursorVisibleTime
"anser the time (in ms), how long a wait cursor should be visible at least"
@@ -3279,6 +3303,19 @@
^ 'menu actions'.
!
+haltInObsoleteMethod
+ "sometimes, these are annoying..."
+
+ ^ self at:#haltInObsoleteMethod ifAbsent:true
+
+ "
+ UserPreferences current haltInObsoleteMethod
+
+ UserPreferences current haltInObsoleteMethod:true
+ UserPreferences current haltInObsoleteMethod:false
+ "
+!
+
ignorePublicPrivateCategories
"used when loading dolphin code (which defines multiple categories per method);
if on, categories like public and private are ignored (if the method already has a category).
@@ -3501,6 +3538,30 @@
!UserPreferences methodsFor:'accessing-prefs-editor'!
+codeCompletionOnControlKey
+ "show completion with CTRL-key - experimental"
+
+ ^ self at:#codeCompletionOnControlKey ifAbsent:false
+
+ "
+ UserPreferences current codeCompletionOnControlKey
+ UserPreferences current codeCompletionOnControlKey:true
+ UserPreferences current codeCompletionOnControlKey:false
+ "
+!
+
+codeCompletionOnControlKey:aBoolean
+ "show completion with CTRL key - experimental"
+
+ ^ self at:#codeCompletionOnControlKey put:aBoolean
+
+ "
+ UserPreferences current codeCompletionOnControlKey
+ UserPreferences current codeCompletionOnControlKey:true
+ UserPreferences current codeCompletionOnControlKey:false
+ "
+!
+
deleteSetsClipboardText
"if true, a delete also updates the clipboard with the deleted text"
@@ -3573,6 +3634,30 @@
"Created: / 03-07-2006 / 16:50:20 / cg"
!
+immediateCodeCompletion
+ "show completion, as you type - experimental"
+
+ ^ self at:#immediateCodeCompletion ifAbsent:false
+
+ "
+ UserPreferences current immediateCodeCompletion
+ UserPreferences current immediateCodeCompletion:true
+ UserPreferences current immediateCodeCompletion:false
+ "
+!
+
+immediateCodeCompletion:aBoolean
+ "show completion, as you type - experimental"
+
+ ^ self at:#immediateCodeCompletion put:aBoolean
+
+ "
+ UserPreferences current immediateCodeCompletion
+ UserPreferences current immediateCodeCompletion:true
+ UserPreferences current immediateCodeCompletion:false
+ "
+!
+
numberOfRememberedUndoOperationsInEditor
"the number of possible undo-operations.
Nil means: unlimited.
@@ -4450,11 +4535,11 @@
!UserPreferences class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/UserPreferences.st,v 1.340 2013-08-27 14:32:29 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UserPreferences.st,v 1.346 2013-09-03 11:52:58 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/UserPreferences.st,v 1.340 2013-08-27 14:32:29 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UserPreferences.st,v 1.346 2013-09-03 11:52:58 cg Exp $'
!
version_SVN