--- a/ArithmeticValue.st Wed Oct 28 10:00:01 2015 +0100
+++ b/ArithmeticValue.st Thu Oct 29 06:54:02 2015 +0100
@@ -907,6 +907,7 @@
lessFromFixedPoint:aFixedPoint
"the receiver does not know how to compare to a fixedPoint number -
+ Return true if aFixedPoint < self.
retry the operation by coercing to higher generality"
^ aFixedPoint retry:#< coercing:self
@@ -916,6 +917,7 @@
lessFromFloat:aFloat
"the receiver does not know how to compare to a float -
+ Return true if aFloat < self.
retry the operation by coercing to higher generality"
^ aFloat retry:#< coercing:self
@@ -923,6 +925,7 @@
lessFromFraction:aFraction
"the receiver does not know how to compare to a fraction -
+ Return true if aFraction < self.
retry the operation by coercing to higher generality"
^ aFraction retry:#< coercing:self
@@ -930,6 +933,7 @@
lessFromInteger:anInteger
"the receiver does not know how to compare to an integer -
+ Return true if anInteger < self.
retry the operation by coercing to higher generality"
^ anInteger retry:#< coercing:self
@@ -937,6 +941,7 @@
lessFromLargeFloat:aLargeFloat
"the receiver does not know how to compare to a largeFloat -
+ Return true if aLargeFloat < self.
retry the operation by coercing to higher generality"
^ aLargeFloat retry:#< coercing:self
@@ -944,6 +949,7 @@
lessFromLongFloat:aLongFloat
"the receiver does not know how to compare to a longFloat -
+ Return true if aLongFloat < self.
retry the operation by coercing to higher generality"
^ aLongFloat retry:#< coercing:self
@@ -953,6 +959,7 @@
lessFromShortFloat:aShortFloat
"the receiver does not know how to compare to a shortFloat -
+ Return true if aShortFloat < self.
retry the operation by coercing to higher generality"
^ aShortFloat retry:#< coercing:self
@@ -1187,24 +1194,38 @@
"Modified: / 17-07-2006 / 12:51:33 / cg"
!
-raisedTo: aNumber
- aNumber isInteger ifTrue:[
- ^ self raisedToInteger:aNumber
- ].
- ^ self subclassResponsibility
-!
+basicRaisedToInteger:exp
+ "return the receiver raised to exp"
+
+ |result e t|
+
+ "use the addition chaining algorithm,
+ which is much faster for big exponents"
-raisedToInteger:exp
- "return the receiver raised to exp.
- Warning: if the receiver is a float/double, currently INF
- may be returned. This may be changed silently to raise an error
- in future versions."
+ result := 1.
+ t := self.
+ exp < 0 ifTrue:[
+ e := exp negated.
+ ] ifFalse:[
+ e := exp.
+ ].
- ^ self raisedToIntegerAsInteger:exp
+ [e ~~ 0] whileTrue:[
+ [(e bitAnd:1) == 0] whileTrue:[
+ e := e bitShift:-1.
+ t := t * t.
+ ].
+ e := e - 1.
+ result := result * t.
+ ].
+
+ (exp < 0) ifTrue:[
+ ^ 1 / result
+ ].
+
+ ^ result
"
- (2.0 raisedToInteger:10000)
-
(2.0 raisedToInteger:216)
(2 raisedToInteger:216)
(2 raisedTo:216)
@@ -1217,6 +1238,8 @@
(2 raisedToInteger:500)
(2 raisedTo:500)
-> 3273390607896141870013189696827599152216642046043064789483291368096133796404674554883270092325904157150886684127560071009217256545885393053328527589376
+ (2 raisedTo:-500)
+ -> (1/3273390607896141870013189696827599152216642046043064789483291368096133796404674554883270092325904157150886684127560071009217256545885393053328527589376)
2 raisedToInteger:10
-> 1024
-2 raisedToInteger:10
@@ -1249,38 +1272,26 @@
"Modified: / 27.4.1999 / 16:16:11 / stefan"
!
-raisedToIntegerAsInteger:exp
- "return the receiver raised to exp as a (large-) integer"
-
- |result e t|
-
- "use the addition chaining algorithm,
- which is much faster for big exponents"
-
- result := 1.
- t := self.
- exp < 0 ifTrue:[
- e := exp negated.
- ] ifFalse:[
- e := exp.
+raisedTo: aNumber
+ aNumber isInteger ifTrue:[
+ ^ self raisedToInteger:aNumber
].
+ ^ self subclassResponsibility
+!
- [e ~~ 0] whileTrue:[
- [(e bitAnd:1) == 0] whileTrue:[
- e := e bitShift:-1.
- t := t * t.
- ].
- e := e - 1.
- result := result * t.
- ].
+raisedToInteger:exp
+ "return the receiver raised to exp.
+ Warning: if the receiver is a float/double, currently INF
+ may be returned. This may be changed silently to raise an error
+ in future versions."
- (exp < 0) ifTrue:[
- ^ 1 / result
- ].
-
- ^ result
+ ^ self basicRaisedToInteger:exp
"
+ (2.0 raisedToInteger:10000)
+ (2 raisedToInteger:10000)
+ (2 raisedToInteger:-10000)
+
(2.0 raisedToInteger:216)
(2 raisedToInteger:216)
(2 raisedTo:216)
@@ -1419,7 +1430,7 @@
!
negative
- "return true if the receiver is less than zero"
+ "return true if the receiver is less than zero."
^ self < self class zero
!
@@ -1437,7 +1448,7 @@
!
positive
- "return true, if the receiver is >= 0"
+ "return true, if the receiver is greater or equal to zero (not negative)"
^ self negative not
!
@@ -1454,7 +1465,7 @@
!
strictlyPositive
- "return true, if the receiver is > 0"
+ "return true, if the receiver is greater than zero"
^ self class zero < self
! !
--- a/Fraction.st Wed Oct 28 10:00:01 2015 +0100
+++ b/Fraction.st Thu Oct 29 06:54:02 2015 +0100
@@ -439,9 +439,10 @@
negated
"optional - could use inherited method ..."
- ^ self class
- numerator:(numerator negated)
- denominator:denominator
+ "/ no need to reduce - I am already
+ ^ self class basicNew
+ setNumerator:(numerator negated)
+ denominator:denominator
"Modified: 5.11.1996 / 10:29:11 / cg"
!
@@ -450,9 +451,10 @@
"optional - could use inherited method ..."
numerator == 1 ifTrue:[^ denominator].
- ^ self class
- numerator:denominator
- denominator:numerator
+ "/ no need to reduce - I am already
+ ^ self class basicNew
+ setNumerator:denominator
+ denominator:numerator
"Modified: 5.11.1996 / 10:29:22 / cg"
! !
@@ -691,11 +693,10 @@
hash
"return a number for hashing; redefined, since fractions compare
- by numeric value (i.e. (9/3) = 3), therefore (9/3) hash must be the same
- as 3 hash."
+ by numeric value (i.e. (1/2) = 0.5), hash values must be the same"
- (denominator = 1) ifTrue:[^ numerator hash].
-
+ (denominator == 1) ifTrue:[^ numerator hash].
+ (denominator == -1) ifTrue:[^ numerator hash negated].
^ self asFloat hash
"
@@ -708,6 +709,11 @@
0.5 hash
0.25 hash
0.4 hash
+
+ 0.25 hash
+ -0.25 hash
+ (1/4) hash
+ (-1/4) hash
"
!
@@ -825,7 +831,8 @@
!
lessFromFraction:aFraction
- "sent when a fraction does not know how to compare to the receiver"
+ "sent when a fraction does not know how to compare to the receiver.
+ Return true if aFraction < self."
|n d|
@@ -834,13 +841,14 @@
"/ save a multiplication if possible
d == denominator ifTrue:[
- ^ n < numerator
+ ^ n < numerator
].
^ (denominator * n) < (numerator * d)
!
lessFromInteger:anInteger
- "sent when an integer does not know how to compare to the receiver, a fraction"
+ "sent when an integer does not know how to compare to the receiver, a fraction.
+ Return true if anInteger < self."
^ (denominator * anInteger) < numerator
!
@@ -1089,10 +1097,10 @@
!
negative
- "return true if the receiver is negative"
+ "return true if the receiver is less than zero"
(numerator < 0) ifTrue:[
- ^ (denominator < 0) not
+ ^ (denominator < 0) not
].
^ (denominator < 0)
! !
--- a/Integer.st Wed Oct 28 10:00:01 2015 +0100
+++ b/Integer.st Thu Oct 29 06:54:02 2015 +0100
@@ -17,7 +17,7 @@
Number subclass:#Integer
instanceVariableNames:''
- classVariableNames:'DefaultDisplayRadix BCDConversionErrorSignal PrimeCache'
+ classVariableNames:'BCDConversionErrorSignal PrimeCache'
poolDictionaries:''
category:'Magnitude-Numbers'
!
@@ -56,16 +56,6 @@
int op fraction -> fraction
int op float -> float
- [Class variables:]
-
- DefaultDisplayRadix the radix in which integers present their
- displayString (which is used in inspectors)
- If you are to look at many hex numbers, bitmasks
- etc. you may set this to 2 or 16.
- (avoids typing printStringRadix:.. all the time
- - I know - I am lazy ;-). Default is 10.
-
-
[author:]
Claus Gittinger
@@ -808,25 +798,11 @@
"Modified: 18.7.1996 / 12:26:38 / cg"
! !
-!Integer class methodsFor:'misc'!
-
-displayRadix:aNumber
- "being tired of always sending #printStringRadix: in the inspectors,
- this allows you to change the default print radix for the displayString
- method."
-
- DefaultDisplayRadix := aNumber
-
- "
- Integer displayRadix:16. 123456 inspect
- Integer displayRadix:10. 123456 inspect
- "
-! !
-
!Integer class methodsFor:'prime numbers'!
flushPrimeCache
- "cleanup after using a primeCache"
+ "cleanup after using a primeCache.
+ See comment in initializePrimeCacheUpTo:limit"
PrimeCache := nil.
@@ -950,6 +926,8 @@
!
primeCacheSize
+ "see comment in initializePrimeCacheUpTo:limit"
+
^ PrimeCache size * 2
"
@@ -1078,8 +1056,9 @@
!
primesUpTo: max do: aBlock
- "Compute aBlock with all prime integers up to and including the given integer."
-
+ "Compute aBlock with all prime integers up to and including the given integer.
+ See comment in initializePrimeCacheUpTo:limit"
+
| limit flags prime k |
max <= 2000 ifTrue:[
@@ -3150,10 +3129,10 @@
!
integerSqrt
- "newton's method to get the largest integer which is less or equal to the
+ "return the largest integer which is less or equal to the
receiver's square root.
This might be needed for some number theoretic problems with large numbers
- (and also in cryptography)"
+ (and also in cryptography). Uses Newton's method"
|guess prevGuess guessSquared|
@@ -3302,6 +3281,8 @@
(*):which does not mean that the code below is optimal - far from it !!"
+ "See comment in initializePrimeCacheUpTo:limit"
+
|rest n factors limit lastPrime checkThisFactor nextTry|
factors := Bag new.
@@ -3564,19 +3545,6 @@
"Created: / 30.4.1999 / 15:53:15 / stefan"
"Modified: / 5.5.1999 / 11:01:15 / stefan"
-!
-
-raisedToInteger:exp
- "return the receiver raised to exp"
-
- exp > 1000 ifTrue:[
- "LargeInteger req's more than 1000 bits"
- (self < 0) ifTrue:[
- ^ PowerInteger new base:(self negated) exponent:exp negative:(exp odd).
- ].
- ^ PowerInteger new base:self exponent:exp
- ].
- ^ self raisedToIntegerAsInteger:exp
! !
!Integer methodsFor:'printing & storing'!
@@ -3652,30 +3620,6 @@
"
!
-displayOn:aGCOrStream
- "return a string to display the receiver.
- The output radix is usually 10, but can be changed by setting
- DefaultDisplayRadix (see Integer>>displayRadix:)"
-
- "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
- "/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
- (aGCOrStream isStream) ifFalse:[
- ^ super displayOn:aGCOrStream
- ].
-
- (DefaultDisplayRadix isNil or:[DefaultDisplayRadix == 10]) ifTrue:[
- self printOn:aGCOrStream
- ] ifFalse:[
- self printOn:aGCOrStream base:DefaultDisplayRadix showRadix:true.
- ].
-
- "
- Integer displayRadix:16. 12345
- Integer displayRadix:2. 12345
- Integer displayRadix:10. 12345
- "
-!
-
errorPrintHex
"print the receiver as a hex number on the standard error stream"
@@ -3716,32 +3660,6 @@
(self printStringRadix:16) print
!
-printOn:aStream
- "append a printed description of the receiver to aStream"
-
- self printOn:aStream base:10
-
- "Modified: / 20.1.1998 / 14:10:45 / stefan"
-!
-
-printOn:aStream base:b
- "return a string representation of the receiver in the specified
- radix (without the initial XXr)"
-
- ^ self printOn:aStream base:b showRadix:false
-
- "
- 10 printOn:Transcript base:3
- 31 printOn:Transcript base:3
- -20 printOn:Transcript base:16
- -20 printOn:Transcript base:10
- 3000 factorial printOn:Transcript base:10
- "
-
- "Modified: / 20.1.1998 / 18:05:02 / stefan"
- "Modified: / 7.9.2001 / 13:52:17 / cg"
-!
-
printOn:aStream base:b showRadix:showRadix
"append a string representation of the receiver in the specified numberBase to aStream
(if showRadix is true, with initial XXr)
@@ -3772,13 +3690,13 @@
claus: changed it from a recursive algorithm;
(it used to trigger stack-overflow exceptions when printing 3000 factorial ...)
"
-"/ leftPart := num // base.
-"/ (leftPart ~= 0) ifTrue:[
-"/ leftPart printOn:aStream base:base.
-"/ aStream nextPut:(Character digitValue:(num \\ base).
-"/ ^ self
-"/ ].
-"/ aStream nextPut:(Character digitValue:num).
+ "/ leftPart := num // base.
+ "/ (leftPart ~= 0) ifTrue:[
+ "/ leftPart printOn:aStream base:base.
+ "/ aStream nextPut:(Character digitValue:(num \\ base).
+ "/ ^ self
+ "/ ].
+ "/ aStream nextPut:(Character digitValue:num).
"/ instead of computing the quotient and remainder
"/ against radix, do it in junks of 5 or 6 digits.
@@ -4019,21 +3937,6 @@
"Modified (comment): / 26-07-2013 / 12:55:18 / cg"
!
-printStringRadix:base showRadix:showRadixBoolean
- "return a string representation of the receiver in the specified
- base; does NOT prepend XXr to the string.
- See also: radixPrintStringRadix:
- printOn:base:showRadix:"
-
- |s|
-
- s := WriteStream on:(String basicNew:20).
- self printOn:s base:base showRadix:showRadixBoolean.
- ^ s contents
-
- "Created: / 23-09-2011 / 13:59:19 / cg"
-!
-
printStringRadix:aRadix size:sz fill:fillCharacter
"return a string representation of the receiver in the specified
radix. The string is padded on the left with fillCharacter to make
@@ -4055,25 +3958,6 @@
"
!
-radixPrintStringRadix:radix
- "return a string representation of the receiver in the specified
- base; prepend XXr to the string"
-
- ^ self printStringRadix:radix showRadix:true
-
- "
- 31 radixPrintStringRadix:2
- 31 radixPrintStringRadix:3
- 31 radixPrintStringRadix:10
- 31 radixPrintStringRadix:16
- 31 radixPrintStringRadix:36
- "
-
- "Created: / 19-01-1998 / 17:38:00 / stefan"
- "Modified: / 20-01-1998 / 14:11:03 / stefan"
- "Modified: / 23-09-2011 / 14:00:02 / cg"
-!
-
romanPrintString
"return a roman number representation of the receiver as a string"
@@ -4177,6 +4061,54 @@
^ true
!
+isPerfectSquare
+ "return true if I am a perfect square.
+ That is a number for which the square root is an integer."
+
+ |intSqrt realSqrt|
+
+ self strictlyPositive ifFalse:[
+ "/ should we raise a domain error for negative receivers?
+ ^ false
+ ].
+
+ "/ q&d check for common small squares
+ self < 400 ifTrue:[
+ ^ #(1 4 9 16 25 36 49 64 81 100 121 144 169 196 225 256 289 324 361 ) includes:self.
+ ].
+ self < 1024 ifTrue:[
+ ^ #(400 441 484 529 576 625 676 729 784 841 900 961) includes:self.
+ ].
+ "/ try powers of 2
+ self isPowerOfTwo ifTrue:[
+ ^ self lowBit odd
+ ].
+
+ "/ guess
+ realSqrt := self sqrt.
+ realSqrt isFinite ifTrue:[
+ realSqrt = realSqrt truncated ifTrue:[
+ "/ still have to check due to rounding errors.
+ intSqrt := realSqrt truncated asInteger.
+ ^ intSqrt squared = self
+ ].
+ ].
+
+ "/ slow code
+ intSqrt := self integerSqrt.
+ ^ intSqrt squared = self
+
+ "
+ (1 to:1000000) count:[:n | n isPerfectSquare] 1000
+ 12345678987654321234567 isPerfectSquare
+ 123123123432 squared isPerfectSquare
+ (123123123432 raisedTo:7) isPerfectSquare
+ ((123456789123456789 raisedTo:7)) isPerfectSquare
+ ((123456789123456789 raisedTo:7)-1) isPerfectSquare
+ Time microsecondsToRun:[12345678987654321234567 isPerfectSquare]
+ "
+!
+
isPowerOf:p
"return true, if the receiver is a power of p"
@@ -4259,6 +4191,14 @@
self even ifTrue:[^ self == 2 ].
self == 1 ifTrue:[^ false ].
+ "/ See comment in initializePrimeCacheUpTo:limit
+ "/ Integer initializePrimeCacheUpTo:(10 raisedTo:7)
+ "/ Integer flushPrimeCache
+ "/
+ "/ by default, no primeCache is used.
+ "/ if you do lots of number-stuff with primes, you may want to enable it with
+ "/ Integer initializePrimeCacheUpTo:1000000
+ "/ and when done, cleanup with flushPrimeCache
self <= (PrimeCache size*2) ifTrue:[
^ PrimeCache at:self//2.
].
@@ -4369,6 +4309,7 @@
37 nextPrime
36 nextPrime
3456737 nextPrime
+ 1000 factorial nextPrime
"
!
--- a/Number.st Wed Oct 28 10:00:01 2015 +0100
+++ b/Number.st Thu Oct 29 06:54:02 2015 +0100
@@ -17,7 +17,8 @@
ArithmeticValue subclass:#Number
instanceVariableNames:''
- classVariableNames:'DecimalPointCharacterForPrinting DecimalPointCharactersForReading'
+ classVariableNames:'DecimalPointCharacterForPrinting DecimalPointCharactersForReading
+ DefaultDisplayRadix'
poolDictionaries:''
category:'Magnitude-Numbers'
!
@@ -46,6 +47,13 @@
DecimalPointCharacterForPrinting <Character> used when printing
DecimalPointCharactersForReading <Collection of Character> accepted as decimalPointChars when reading
+ DefaultDisplayRadix the radix in which integers present their
+ displayString (which is used in inspectors)
+ If you are to look at many hex numbers, bitmasks
+ etc. you may set this to 2 or 16.
+ (avoids typing printStringRadix:.. all the time
+ - I know - I am lazy ;-). Default is 10.
+
[author:]
Claus Gittinger
@@ -689,6 +697,21 @@
"Modified: / 16.11.2001 / 14:13:16 / cg"
! !
+!Number class methodsFor:'misc'!
+
+displayRadix:aNumber
+ "being tired of always sending #printStringRadix: in the inspectors,
+ this allows you to change the default print radix for the displayString
+ method."
+
+ DefaultDisplayRadix := aNumber
+
+ "
+ Integer displayRadix:16. 123456 inspect
+ Integer displayRadix:10. 123456 inspect
+ "
+! !
+
!Number class methodsFor:'private'!
readMantissaAndScaleFrom:aStream radix:radix
@@ -1319,7 +1342,8 @@
!
ln
- "compute ln of the receiver"
+ "return the natural logarithm of myself.
+ Raises an exception, if the receiver is less or equal to zero."
(self isLimitedPrecisionReal not
or:[self generality < 1.0 generality]) ifTrue:[
@@ -1446,6 +1470,63 @@
!Number methodsFor:'printing & storing'!
+displayOn:aGCOrStream
+ "return a string to display the receiver.
+ The output radix is usually 10, but can be changed by setting
+ DefaultDisplayRadix (see Integer>>displayRadix:)"
+
+ "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
+ "/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
+ (aGCOrStream isStream) ifFalse:[
+ ^ super displayOn:aGCOrStream
+ ].
+
+ (DefaultDisplayRadix isNil or:[DefaultDisplayRadix == 10]) ifTrue:[
+ self printOn:aGCOrStream
+ ] ifFalse:[
+ self printOn:aGCOrStream base:DefaultDisplayRadix showRadix:true.
+ ].
+
+ "
+ Integer displayRadix:16. 12345
+ Integer displayRadix:2. 12345
+ Integer displayRadix:10. 12345
+ "
+!
+
+printOn:aStream
+ "append a printed description of the receiver to aStream"
+
+ self printOn:aStream base:10
+
+ "Modified: / 20.1.1998 / 14:10:45 / stefan"
+!
+
+printOn:aStream base:b
+ "return a string representation of the receiver in the specified
+ radix (without the initial XXr)"
+
+ ^ self printOn:aStream base:b showRadix:false
+
+ "
+ 10 printOn:Transcript base:3
+ 31 printOn:Transcript base:3
+ -20 printOn:Transcript base:16
+ -20 printOn:Transcript base:10
+ 3000 factorial printOn:Transcript base:10
+ "
+
+ "Modified: / 20.1.1998 / 18:05:02 / stefan"
+ "Modified: / 7.9.2001 / 13:52:17 / cg"
+!
+
+printOn:aStream base:b showRadix:showRadix
+ "the central print method for integer.
+ Must be defined in concrete classes"
+
+ self subclassResponsibility
+!
+
printOn:aStream paddedWith:padCharacter to:size base:radix
|s|
@@ -1540,6 +1621,21 @@
"
!
+printStringRadix:base showRadix:showRadixBoolean
+ "return a string representation of the receiver in the specified
+ base; does NOT prepend XXr to the string.
+ See also: radixPrintStringRadix:
+ printOn:base:showRadix:"
+
+ |s|
+
+ s := WriteStream on:(String basicNew:20).
+ self printOn:s base:base showRadix:showRadixBoolean.
+ ^ s contents
+
+ "Created: / 23-09-2011 / 13:59:19 / cg"
+!
+
printStringWithThousandsSeparator
"print the receiver as swiss business number with thousands separator to aStream.
Caveat: Should use the separator from the locale here"
@@ -1604,6 +1700,25 @@
"
!
+radixPrintStringRadix:radix
+ "return a string representation of the receiver in the specified
+ base; prepend XXr to the string"
+
+ ^ self printStringRadix:radix showRadix:true
+
+ "
+ 31 radixPrintStringRadix:2
+ 31 radixPrintStringRadix:3
+ 31 radixPrintStringRadix:10
+ 31 radixPrintStringRadix:16
+ 31 radixPrintStringRadix:36
+ "
+
+ "Created: / 19-01-1998 / 17:38:00 / stefan"
+ "Modified: / 20-01-1998 / 14:11:03 / stefan"
+ "Modified: / 23-09-2011 / 14:00:02 / cg"
+!
+
storeOn:aStream
"append a string for storing the receiver onto the argument, aStream
- since numbers are literals,they store as they print."
--- a/ObjectMemory.st Wed Oct 28 10:00:01 2015 +0100
+++ b/ObjectMemory.st Thu Oct 29 06:54:02 2015 +0100
@@ -5565,13 +5565,23 @@
by '.chg', or, if not running from an image, the default name 'st.chg'.
However, it can be overwritten via the nameForChanges: setter"
- |nm|
-
- (nm := UserPreferences current changeFileName) notNil ifTrue:[
- ^ nm
+ |userPrefs localName nm wd|
+
+ localName := self nameForChangesLocal.
+ userPrefs := UserPreferences current.
+
+ "/ if the prefs provide a full, explicit name
+ (nm := userPrefs changeFileName) notNil ifTrue:[ ^ nm ].
+
+ "/ if there is a workspace, create it there
+ ((wd := userPrefs workspaceDirectory) notNil and:[wd exists]) ifTrue:[
+ ^ wd / (localName asFilename baseName)
].
+
+ "/ if it was set by a startup file
ChangeFileName notNil ifTrue:[^ ChangeFileName].
- ^ self nameForChangesLocal
+ "/ finally, fall back to a default.
+ ^ localName
"
ObjectMemory nameForChanges
@@ -5617,6 +5627,26 @@
This is the filename of the current image or,
if not running from an image, the default name 'st.img'"
+ |localName wd|
+
+ localName := self nameForSnapshotLocal.
+
+ "/ if there is a workspace, create it there
+ ((wd := UserPreferences current workspaceDirectory) notNil and:[wd exists]) ifTrue:[
+ ^ wd / (localName asFilename baseName)
+ ].
+ ^ localName
+
+ "
+ ObjectMemory nameForSnapshot
+ "
+!
+
+nameForSnapshotLocal
+ "return a reasonable filename to store the snapshot image into.
+ This is the filename of the current image or,
+ if not running from an image, the default name 'st.img'"
+
^ self imageBaseName , '.', self suffixForSnapshot
"
@@ -5693,7 +5723,7 @@
snapShot
"create a snapshot file containing all of the current state."
- self snapShotOn:self nameForSnapshot setImageName:true
+ self snapShotOn:(self nameForSnapshot) setImageName:true
"
ObjectMemory snapShot
@@ -5701,6 +5731,8 @@
!
snapShotOn:aFileName
+ "create a snapshot file containing all of the current state."
+
^ self snapShotOn:aFileName setImageName:true.
"
@@ -5729,7 +5761,7 @@
ST-80 compatibility; send #preSnapshot to all classes
"
Smalltalk allClassesDo:[:aClass |
- aClass preSnapshot
+ aClass preSnapshot
].
"
@@ -5739,58 +5771,55 @@
"
snapshotFilename := aFileName asFilename.
snapshotFilename isAbsolute ifFalse:[
- snapshotFilename := self directoryForImageAndChangeFile
- / snapshotFilename name.
+ snapshotFilename := self directoryForImageAndChangeFile
+ / snapshotFilename name.
].
tempFilename := (FileStream newTemporaryIn:snapshotFilename directory)
- close;
- fileName.
+ close;
+ fileName.
ok := self primSnapShotOn:tempFilename.
ok ifTrue:[
- "keep history of one snapshot file"
- snapshotFilename exists ifTrue:[
- tempFilename symbolicAccessRights:snapshotFilename symbolicAccessRights.
- snapshotFilename renameTo:(snapshotFilename withSuffix:'sav').
- ] ifFalse:[
- "image file hat stx as interpreter and can be executed"
- tempFilename makeExecutable.
- ].
- tempFilename renameTo:snapshotFilename.
-
- Class addChangeRecordForSnapshot:aFileName.
-
- setImageName ifTrue:[
- oldChangeFile := self nameForChanges.
- ImageName := snapshotFilename asAbsoluteFilename asString.
- self refreshChangesFrom:oldChangeFile.
- ].
+ "keep history of one snapshot file"
+ snapshotFilename exists ifTrue:[
+ tempFilename symbolicAccessRights:snapshotFilename symbolicAccessRights.
+ snapshotFilename renameTo:(snapshotFilename withSuffix:'sav').
+ ] ifFalse:[
+ "image file hat stx as interpreter and can be executed"
+ tempFilename makeExecutable.
+ ].
+ tempFilename renameTo:snapshotFilename.
+
+ Class addChangeRecordForSnapshot:aFileName.
+
+ setImageName ifTrue:[
+ oldChangeFile := self nameForChanges.
+ ImageName := snapshotFilename asAbsoluteFilename asString.
+ self refreshChangesFrom:oldChangeFile.
+ ].
] ifFalse:[
- tempFilename remove.
+ tempFilename remove.
].
"
ST-80 compatibility; send #postSnapshot to all classes
"
Smalltalk allClassesDo:[:aClass |
- aClass postSnapshot
+ aClass postSnapshot
].
self changed:#finishedSnapshot. "/ ST-80 compatibility
ok ifFalse:[
- SnapshotError raise.
- "not reached"
+ SnapshotError raise.
+ "not reached"
].
Transcript
- show:'Snapshot ';
- show:snapshotFilename baseName allBold;
- show:' saved ';
- show:Timestamp now;
- show:' in ';
- show:snapshotFilename asAbsoluteFilename directoryName;
- showCR:'.'.
+ show:'Snapshot '; show:snapshotFilename baseName allBold;
+ show:' saved '; show:Timestamp now;
+ show:' in '; show:snapshotFilename asAbsoluteFilename directoryName;
+ showCR:'.'.
^ ok
--- a/Project.st Wed Oct 28 10:00:01 2015 +0100
+++ b/Project.st Thu Oct 29 06:54:02 2015 +0100
@@ -970,7 +970,7 @@
packageName := 'private-' , numString.
self directory:'.'.
- self repositoryModule:(OperatingSystem getLoginName).
+ self repositoryModule:(UserPreferences current usersModuleName "OperatingSystem getLoginName").
self repositoryDirectory:'private'
"Created: 25.11.1995 / 18:05:44 / cg"
--- a/SmallInteger.st Wed Oct 28 10:00:01 2015 +0100
+++ b/SmallInteger.st Thu Oct 29 06:54:02 2015 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
@@ -2967,6 +2969,7 @@
! !
+
!SmallInteger methodsFor:'iteration'!
timesRepeat:aBlock
@@ -4963,7 +4966,7 @@
!
positive
- "return true, if the receiver is not negative
+ "return true, if the receiver is greater or equal to zero (not negative)
reimplemented here for speed"
%{ /* NOCONTEXT */
@@ -4980,7 +4983,6 @@
#endif
%}.
^ super positive
-
!
sign
--- a/Smalltalk.st Wed Oct 28 10:00:01 2015 +0100
+++ b/Smalltalk.st Thu Oct 29 06:54:02 2015 +0100
@@ -460,67 +460,68 @@
initSystemPath
"setup path where system files are searched for.
the default path is set to:
- .
- <directory of exe> (WIN32 only)
- $HOME (if defined)
- $HOME/.smalltalk (if defined & existing)
- $SMALLTALK_LIBDIR (if defined & existing)
- $STX_LIBDIR (if defined & existing)
- $STX_TOPDIR (if defined & existing)
- REGISTRY('HKEY_LOCAL_MACHINE\Software\eXept\Smalltalk/X\<CurrentVersion>\LibDir') (WIN32 only)
- REGISTRY('HKEY_LOCAL_MACHINE\Software\eXept\Smalltalk/X\LibDir') (WIN32 only)
- <standard places>
+ .
+ <directory of exe> (WIN32 only)
+ $HOME (if defined)
+ $HOME/.smalltalk (if defined & existing)
+ $SMALLTALK_LIBDIR (if defined & existing)
+ $STX_LIBDIR (if defined & existing)
+ $STX_TOPDIR (if defined & existing)
+ REGISTRY('HKEY_LOCAL_MACHINE\Software\eXept\Smalltalk/X\<CurrentVersion>\LibDir') (WIN32 only)
+ REGISTRY('HKEY_LOCAL_MACHINE\Software\eXept\Smalltalk/X\LibDir') (WIN32 only)
+ <standard places>
standard places (unix):
- /opt/smalltalk/<release> (if existing)
- /opt/smalltalk (if existing)
- /usr/local/lib/smalltalk (if existing)
- /usr/lib/smalltalk (if existing)
- /lib/smalltalk (if existing)
+ /opt/smalltalk/<release> (if existing)
+ /opt/smalltalk (if existing)
+ /usr/local/lib/smalltalk (if existing)
+ /usr/lib/smalltalk (if existing)
+ /lib/smalltalk (if existing)
win32:
- \programs\exept\smalltalk (if existing)
- \programs\smalltalk (if existing)
- \smalltalk (if existing)
+ \programs\exept\smalltalk (if existing)
+ \programs\smalltalk (if existing)
+ \smalltalk (if existing)
vms:
- $stx:lib (if existing)
- $stx:root (if existing)
+ $stx:lib (if existing)
+ $stx:root (if existing)
of course, it is possible to add entries from the 'smalltalk.rc'
startup file; add expressions such as:
- Smalltalk systemPath addFirst:'/foo/bar/baz'.
- or:
- Smalltalk systemPath addLast:'/fee/foe/foo'.
+ Smalltalk systemPath addFirst:'/foo/bar/baz'.
+ or:
+ Smalltalk systemPath addLast:'/fee/foe/foo'.
However, smalltalk.rc itself must be found along the above path.
"
ChangeFileName := 'changes'.
OperatingSystem isVMSlike ifTrue:[
- BitmapDirName := 'bitmaps.dir'.
- BinaryDirName := 'binary.dir'.
- SourceDirName := 'source.dir'.
- ResourceDirName := 'resources.dir'.
- FileInDirName := 'filein.dir'.
- PackageDirName := 'packages.dir'.
+ BitmapDirName := 'bitmaps.dir'.
+ BinaryDirName := 'binary.dir'.
+ SourceDirName := 'source.dir'.
+ ResourceDirName := 'resources.dir'.
+ FileInDirName := 'filein.dir'.
+ PackageDirName := 'packages.dir'.
] ifFalse:[
- BitmapDirName := 'bitmaps'.
- BinaryDirName := 'binary'.
- SourceDirName := 'source'.
- ResourceDirName := 'resources'.
- FileInDirName := 'fileIn'.
- PackageDirName := 'packages'.
+ BitmapDirName := 'bitmaps'.
+ BinaryDirName := 'binary'.
+ SourceDirName := 'source'.
+ ResourceDirName := 'resources'.
+ FileInDirName := 'fileIn'.
+ PackageDirName := 'packages'.
].
SystemPath isEmptyOrNil ifTrue:[
- SystemPath := OperatingSystem defaultSystemPath.
- self flushPathCaches
+ SystemPath := OperatingSystem defaultSystemPath.
+ self flushPathCaches
].
PackagePath isEmptyOrNil ifTrue:[
- PackagePath := OperatingSystem defaultPackagePath.
- ].
+ PackagePath := OperatingSystem defaultPackagePath.
+ ].
+ self addWorkspaceDirectoryToPackagePath.
"
Smalltalk initSystemPath
@@ -6585,6 +6586,18 @@
!Smalltalk class methodsFor:'system management-files'!
+addWorkspaceDirectoryToPackagePath
+ "{ Pragma: +optSpace }"
+
+ |workspaceDirectory|
+
+ (workspaceDirectory := UserPreferences current workspaceDirectory) notNil ifTrue:[
+ (workspaceDirectory := workspaceDirectory asFilename) exists ifTrue:[
+ PackagePath addFirst:workspaceDirectory
+ ]
+ ].
+!
+
bitmapFileStreamFor:aFileName
"search aFileName in some standard places;
return a readonly fileStream or nil if not found.
@@ -7540,13 +7553,14 @@
reinitializePackagePath
"{ Pragma: +optSpace }"
-
+
PackagePath notNil ifTrue:[
- PackagePath := PackagePath select:[:p | p asFilename exists].
+ PackagePath := PackagePath select:[:p | p asFilename exists].
].
PackagePath isEmptyOrNil ifTrue:[
- PackagePath := OperatingSystem defaultPackagePath
- ].
+ PackagePath := OperatingSystem defaultPackagePath
+ ].
+ self addWorkspaceDirectoryToPackagePath.
!
relativePackagePathForPackage:aPackage
--- a/UserPreferences.st Wed Oct 28 10:00:01 2015 +0100
+++ b/UserPreferences.st Thu Oct 29 06:54:02 2015 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1998 by eXept Software AG
All Rights Reserved
@@ -467,6 +469,10 @@
^ (Filename usersPrivateSmalltalkDirectory) / 'settings.stx'
"Created: / 06-10-2008 / 08:27:15 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+defaultWorkspaceDirectory
+ ^ (Filename usersPrivateSmalltalkDirectory) / 'workspace'
! !
!UserPreferences class methodsFor:'accessing defaultPrefs'!
@@ -837,23 +843,6 @@
-!UserPreferences methodsFor:'accessing-changes & history'!
-
-changeFileName
- "were to keep changes"
-
- ^self
- at: #'changeFileName'
- ifAbsent: nil
-!
-
-changeFileName:aFilename
- "were to keep changes"
-
- self
- at: #'changeFileName'
- put: aFilename.
-! !
!UserPreferences methodsFor:'accessing-locale'!
@@ -4620,6 +4609,47 @@
"Created: / 03-07-2006 / 16:50:20 / cg"
! !
+!UserPreferences methodsFor:'accessing-prefs-files and directories'!
+
+changeFileName
+ "were to keep changes"
+
+ ^ self
+ at: #'changeFileName'
+ ifAbsent: [nil]
+!
+
+changeFileName:aFilename
+ "were to keep changes"
+
+ self
+ at: #'changeFileName'
+ put: aFilename.
+!
+
+usersModuleName
+ "this will be taken as the user's module in the workspace and as a default for new projects"
+
+ ^ self at:#usersModuleName ifAbsent:[OperatingSystem getLoginName ]
+!
+
+usersModuleName:aString
+ self at:#usersModuleName put:aString
+!
+
+workspaceDirectory
+ ^ self at:#workspaceDirectory ifAbsent:[self class defaultWorkspaceDirectory]
+!
+
+workspaceDirectory:aDirectoryOrNilForDefault
+ |d|
+
+ (d := aDirectoryOrNilForDefault) notNil ifTrue:[
+ d := d asFilename
+ ].
+ self at:#workspaceDirectory put:d
+! !
+
!UserPreferences methodsFor:'accessing-prefs-localization'!
language
--- a/stx_libbasic.st Wed Oct 28 10:00:01 2015 +0100
+++ b/stx_libbasic.st Thu Oct 29 06:54:02 2015 +0100
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 2006 by eXept Software AG
All Rights Reserved
@@ -595,13 +593,6 @@
!stx_libbasic class methodsFor:'description - project information'!
-applicationIconFileName
- "Return the name (without suffix) of an icon-file (the app's icon); will be included in the rc-resource file"
-
- ^ nil
- "/ ^ self applicationName
-!
-
companyName
"Return a companyname which will appear in <lib>.rc"