Squeak-dev November 2017

squeak-dev@lists.squeakfoundation.org

38 participants
198 discussions

The Trunk: Collections-nice.771.mcz
by commits＠source.squeak.org 30 Nov '17

30 Nov '17

Nicolas Cellier uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-nice.771.mcz ==================== Summary ==================== Name: Collections-nice.771 Author: nice Time: 30 November 2017, 9:57:27.873964 pm UUID: d8b64711-6119-429b-b3f5-259b46ef864b Ancestors: Collections-nice.770 Fix awfully broken CharacterSetComplement select:/reject: If we want to select:/reject:, we must not only enumerate the absent characters, but rather all the characters in the complement. That's way two many, thus we prefer to do it with a LazyCharacterSet, anything else is unfeasible (we don't even know the upper limit of the set of characters...). Introduce an AbstractCharacterSet superclass of all the CharacterSet family in order to begin factoring some behavior. TODO: we should better rename CharacterSet -> ByteCharacterSet AbstractCharacterSet -> CharacterSet. We delay this quite technical operation, because we don't want to break existing instances, AND we want to redirect (Byte)CharacterSet references to (Abstract)CharacterSet, the Abstract one becoming a factory. =============== Diff against Collections-nice.770 =============== Item was added: + Collection subclass: #AbstractCharacterSet + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Support'! Item was added: + ----- Method: AbstractCharacterSet>>byteArrayMap (in category 'accessing') ----- + byteArrayMap + ^self subclassReponsibility! Item was added: + ----- Method: AbstractCharacterSet>>findFirstInByteString:startingAt: (in category 'enumerating') ----- + findFirstInByteString: aByteString startingAt: startIndex + "Double dispatching: since we know this is a ByteString, we can use a superfast primitive using a ByteArray map with 0 slots for byte characters not included and 1 for byte characters included in the receiver." + ^ByteString + findFirstInString: aByteString + inSet: self byteArrayMap + startingAt: startIndex! Item was added: + ----- Method: AbstractCharacterSet>>occurrencesOf: (in category 'enumerating') ----- + occurrencesOf: anObject + "Answer how many of the receiver's elements are equal to anObject. Optimized version." + + (self includes: anObject) ifTrue: [ ^1 ]. + ^0! Item was added: + ----- Method: AbstractCharacterSet>>removeAll (in category 'removing') ----- + removeAll + self becomeForward: CharacterSet new! Item was changed: + AbstractCharacterSet subclass: #CharacterSet - Collection subclass: #CharacterSet instanceVariableNames: 'map tally' classVariableNames: 'CrLf NonSeparators Separators' poolDictionaries: '' category: 'Collections-Support'! !CharacterSet commentStamp: '<historical>' prior: 0! A set of characters. Lookups for inclusion are very fast.! Item was changed: + ----- Method: CharacterSet>>= (in category 'comparing') ----- - ----- Method: CharacterSet>>= (in category 'comparison') ----- = anObject self species == anObject species ifFalse: [ ^false ]. anObject size = tally ifFalse: [ ^false ]. ^self byteArrayMap = anObject byteArrayMap! Item was changed: + ----- Method: CharacterSet>>add: (in category 'adding') ----- - ----- Method: CharacterSet>>add: (in category 'collection ops') ----- add: aCharacter "I automatically become a WideCharacterSet if you add a wide character to myself" | index | (index := aCharacter asInteger + 1) <= 256 ifFalse: [ | wide | wide := WideCharacterSet new. wide addAll: self. wide add: aCharacter. self becomeForward: wide. ^aCharacter ]. (map at: index) = 1 ifFalse: [ map at: index put: 1. tally := tally + 1 ]. ^aCharacter! Item was changed: + ----- Method: CharacterSet>>do: (in category 'enumerating') ----- - ----- Method: CharacterSet>>do: (in category 'collection ops') ----- do: aBlock "evaluate aBlock with each character in the set" | index | tally >= 128 ifTrue: [ "dense" index := 0. [ (index := index + 1) <= 256 ] whileTrue: [ (map at: index) = 1 ifTrue: [ aBlock value: (Character value: index - 1) ] ]. ^self ]. "sparse" index := 0. [ (index := map indexOf: 1 startingAt: index + 1) = 0 ] whileFalse: [ aBlock value: (Character value: index - 1) ]. ! Item was changed: + ----- Method: CharacterSet>>findFirstInByteString:startingAt: (in category 'enumerating') ----- - ----- Method: CharacterSet>>findFirstInByteString:startingAt: (in category 'collection ops') ----- findFirstInByteString: aByteString startingAt: startIndex "Double dispatching: since we know this is a ByteString, we can use a superfast primitive using a ByteArray map with 0 slots for byte characters not included and 1 for byte characters included in the receiver." ^ByteString findFirstInString: aByteString inSet: self byteArrayMap startingAt: startIndex! Item was changed: + ----- Method: CharacterSet>>hash (in category 'comparing') ----- - ----- Method: CharacterSet>>hash (in category 'comparison') ----- hash ^self byteArrayMap hash! Item was changed: + ----- Method: CharacterSet>>includes: (in category 'testing') ----- - ----- Method: CharacterSet>>includes: (in category 'collection ops') ----- includes: anObject | index | anObject isCharacter ifFalse: [ ^false ]. (index := anObject asInteger + 1) > 256 ifTrue: [ ^false ]. ^(map at: index) > 0! Item was removed: - ----- Method: CharacterSet>>occurrencesOf: (in category 'enumerating') ----- - occurrencesOf: anObject - "Answer how many of the receiver's elements are equal to anObject. Optimized version." - - (self includes: anObject) ifTrue: [ ^1 ]. - ^0! Item was changed: + ----- Method: CharacterSet>>remove: (in category 'removing') ----- - ----- Method: CharacterSet>>remove: (in category 'collection ops') ----- remove: aCharacter ^self remove: aCharacter ifAbsent: aCharacter! Item was changed: + ----- Method: CharacterSet>>remove:ifAbsent: (in category 'removing') ----- - ----- Method: CharacterSet>>remove:ifAbsent: (in category 'collection ops') ----- remove: aCharacter ifAbsent: aBlock | index | (index := aCharacter asciiValue + 1) <= 256 ifFalse: [ ^aBlock value ]. (map at: index) = 0 ifTrue: [ ^aBlock value ]. map at: index put: 0. tally := tally - 1. ^aCharacter! Item was changed: + ----- Method: CharacterSet>>size (in category 'accessing') ----- - ----- Method: CharacterSet>>size (in category 'collection ops') ----- size ^tally! Item was changed: + ----- Method: CharacterSet>>species (in category 'comparing') ----- - ----- Method: CharacterSet>>species (in category 'comparison') ----- species ^CharacterSet! Item was changed: + AbstractCharacterSet subclass: #CharacterSetComplement - Collection subclass: #CharacterSetComplement instanceVariableNames: 'absent byteArrayMapCache' classVariableNames: '' poolDictionaries: '' category: 'Collections-Support'! !CharacterSetComplement commentStamp: 'nice 8/31/2008 14:53' prior: 0! CharacterSetComplement is a space efficient implementation of (CharacterSet complement) taking care of WideCharacter (code > 255) However, it will maintain a byteArrayMap for character <= 255 in a cache keeping instance variables: absent <CharacterSet> contains character that are not in the set (i.e. my complement) byteArrayMapCache <ByteArray | nil> cache this information because it has to be used in tight loops where efficiency matters! Item was changed: + ----- Method: CharacterSetComplement>>add: (in category 'adding') ----- - ----- Method: CharacterSetComplement>>add: (in category 'collection ops') ----- add: aCharacter "a character is present if not absent, so adding a character is removing it from the absent" (absent includes: aCharacter) ifTrue: [byteArrayMapCache := nil. absent remove: aCharacter]. ^ aCharacter! Item was changed: + ----- Method: CharacterSetComplement>>do: (in category 'enumerating') ----- - ----- Method: CharacterSetComplement>>do: (in category 'collection ops') ----- do: aBlock "evaluate aBlock with each character in the set. don't do it, there are too many..." self shouldNotImplement! Item was changed: + ----- Method: CharacterSetComplement>>findFirstInByteString:startingAt: (in category 'enumerating') ----- - ----- Method: CharacterSetComplement>>findFirstInByteString:startingAt: (in category 'collection ops') ----- findFirstInByteString: aByteString startingAt: startIndex "Double dispatching: since we know this is a ByteString, we can use a superfast primitive using a ByteArray map with 0 slots for byte characters not included and 1 for byte characters included in the receiver." ^ByteString findFirstInString: aByteString inSet: self byteArrayMap startingAt: startIndex! Item was changed: + ----- Method: CharacterSetComplement>>includes: (in category 'testing') ----- - ----- Method: CharacterSetComplement>>includes: (in category 'collection ops') ----- includes: anObject anObject isCharacter ifFalse: [ ^false ]. (absent includes: anObject) ifTrue: [ ^false ]. ^true! Item was removed: - ----- Method: CharacterSetComplement>>occurrencesOf: (in category 'enumerating') ----- - occurrencesOf: anObject - "Answer how many of the receiver's elements are equal to anObject. Optimized version." - - (self includes: anObject) ifTrue: [ ^1 ]. - ^0! Item was changed: + ----- Method: CharacterSetComplement>>reject: (in category 'enumerating') ----- - ----- Method: CharacterSetComplement>>reject: (in category 'collection ops') ----- reject: aBlock + ^LazyCharacterSet including: [:c | (absent includes: c) not and: [(aBlock value: c) not]]! - "Implementation note: rejecting present is selecting absent" - - ^(absent select: aBlock) complement! Item was changed: + ----- Method: CharacterSetComplement>>remove: (in category 'removing') ----- - ----- Method: CharacterSetComplement>>remove: (in category 'collection ops') ----- remove: aCharacter "This means aCharacter is now absent from myself. It must be added to my absent." byteArrayMapCache := nil. ^absent add: aCharacter! Item was changed: + ----- Method: CharacterSetComplement>>remove:ifAbsent: (in category 'removing') ----- - ----- Method: CharacterSetComplement>>remove:ifAbsent: (in category 'collection ops') ----- remove: aCharacter ifAbsent: aBlock (self includes: aCharacter) ifFalse: [^aBlock value]. ^self remove: aCharacter! Item was removed: - ----- Method: CharacterSetComplement>>removeAll (in category 'collection ops') ----- - removeAll - - self becomeForward: CharacterSet new! Item was changed: + ----- Method: CharacterSetComplement>>select: (in category 'enumerating') ----- - ----- Method: CharacterSetComplement>>select: (in category 'collection ops') ----- select: aBlock + ^LazyCharacterSet including: [:c | (absent includes: c) not and: [aBlock value: c]]! - "Implementation note: selecting present is rejecting absent" - - ^(absent reject: aBlock) complement! Item was removed: - ----- Method: CharacterSetComplement>>size (in category 'collection ops') ----- - size - "Is this 2**32-absent size ?" - - ^self shouldNotImplement! Item was added: + ----- Method: Interval>>copyFrom:to: (in category 'copying') ----- + copyFrom: startIndex to: stopIndex + stopIndex < startIndex ifTrue: [^self copyEmpty]. + ^(self at: startIndex) to: (self at: stopIndex) by: step! Item was added: + AbstractCharacterSet subclass: #LazyCharacterSet + instanceVariableNames: 'block byteArrayMapCache' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Support'! + + !LazyCharacterSet commentStamp: 'nice 11/30/2017 21:40' prior: 0! + A LazyCharacterSet is a kind of CharacterSet which does not know in advance which Character it contains or not. + If will lazily evaluate a block on demand if ever one ask whether it includes: a character. + It is not feasible to enumerate a LazyCharacterSet, because there are way too many characters. + + Instance Variables + block: <BlockContext | Symbol> + byteArrayMapCache: <ByteArray | nil> + + block + - a valuable, answering either true or false when sent the message value: - true means that this set includes the character passed as value: argument. + + byteArrayMapCache + - a cache holding 0 or 1 for the first 256 character codes - 0 meaning not included, 1 included. This is used in some priitives + ! Item was added: + ----- Method: LazyCharacterSet class>>including: (in category 'instance creation') ----- + including: aBlock + "Create the set of Character for which aBlock evaluates to true" + ^self class new block: aBlock! Item was added: + ----- Method: LazyCharacterSet>>add: (in category 'adding') ----- + add: aCharacter + self block: [:c | c = aCharacter or: [block value: c]]. + ^aCharacter! Item was added: + ----- Method: LazyCharacterSet>>addAll: (in category 'adding') ----- + addAll: aCollection + self block: [:c | (aCollection includes: c) or: [block value: c]]. + ^aCollection! Item was added: + ----- Method: LazyCharacterSet>>block (in category 'accessing') ----- + block + ^block! Item was added: + ----- Method: LazyCharacterSet>>block: (in category 'accessing') ----- + block: aValuable + "Set the block used to determine if I include a Character or not. + aValuable is an object that shoud answer true or false when sent value:" + + byteArrayMapCache := nil. + ^block := aValuable! Item was added: + ----- Method: LazyCharacterSet>>byteArrayMap (in category 'accessing') ----- + byteArrayMap + "return a ByteArray mapping each ascii value to a 1 if that ascii value is in the set, and a 0 if it isn't. Intended for use by primitives only" + + ^byteArrayMapCache ifNil: [byteArrayMapCache := (0 to: 255) collect: [:i | self includes: (Character value: i)]]! Item was added: + ----- Method: LazyCharacterSet>>complement (in category 'converting') ----- + complement + ^self class including: [:char | (block value: char) not]! Item was added: + ----- Method: LazyCharacterSet>>do: (in category 'enumerating') ----- + do: aBlock + "evaluate aBlock with each character in the set. + don't do it, there are too many loop..." + + self shouldNotImplement! Item was added: + ----- Method: LazyCharacterSet>>includes: (in category 'testing') ----- + includes: aCharacter + ^block value: aCharacter! Item was added: + ----- Method: LazyCharacterSet>>reject: (in category 'enumerating') ----- + reject: aBlock + ^self class including: [:char | (aBlock value: char) not and: [block value: char]]! Item was added: + ----- Method: LazyCharacterSet>>remove: (in category 'removing') ----- + remove: aCharacter + self block: [:c | (c = aCharacter) not and: [block value: c]]. + ^aCharacter! Item was added: + ----- Method: LazyCharacterSet>>remove:ifAbsent: (in category 'removing') ----- + remove: aCharacter ifAbsent: aBlock + (self includes: aCharacter) ifFalse: [^aBlock value]. + ^self remove: aCharacter! Item was added: + ----- Method: LazyCharacterSet>>removeAll: (in category 'removing') ----- + removeAll: aCollection + self block: [:c | (aCollection include: c) not and: [block value: c]]. + ^aCollection! Item was added: + ----- Method: LazyCharacterSet>>select: (in category 'enumerating') ----- + select: aBlock + ^self class including: [:char | (block value: char) and: [aBlock value: char]]! Item was changed: + AbstractCharacterSet subclass: #WideCharacterSet - Collection subclass: #WideCharacterSet instanceVariableNames: 'map byteArrayMap bitsetCapacity highBitsShift lowBitsMask' classVariableNames: '' poolDictionaries: '' category: 'Collections-Support'! !WideCharacterSet commentStamp: 'nice 12/10/2009 19:17' prior: 0! WideCharacterSet is used to store a Set of WideCharacter with fast access and inclusion test. Implementation should be efficient in memory if sets are sufficently sparse. Wide Characters are at most 32bits. We split them into 16 highBits and 16 lowBits. map is a dictionary key: 16 highBits value: map of 16 lowBits. Maps of lowBits are stored as arrays of bits in a ByteArray. If a bit is set to 1, this indicate that corresponding character is present. 8192 bytes are necessary in each lowmap. Empty lowmap are removed from the map Dictionary. A byteArrayMap is maintained in parallel with map for fast handling of ByteString. (byteArrayMap at: i+1) = 0 means that character of asciiValue i is absent, = 1 means present.! Item was changed: + ----- Method: WideCharacterSet>>add: (in category 'adding') ----- - ----- Method: WideCharacterSet>>add: (in category 'collection ops') ----- add: aCharacter | value highBits lowBits | (value := aCharacter asInteger) < 256 ifTrue: [ byteArrayMap at: value + 1 put: 1 ]. highBits := value bitShift: highBitsShift. lowBits := value bitAnd: lowBitsMask. (map at: highBits ifAbsentPut: [ Bitset new: bitsetCapacity ]) setBitAt: lowBits. ^aCharacter! Item was changed: + ----- Method: WideCharacterSet>>do: (in category 'enumerating') ----- - ----- Method: WideCharacterSet>>do: (in category 'collection ops') ----- do: aBlock map keysAndValuesDo: [ :index :bitset | | highBits | highBits := index * bitsetCapacity. bitset do: [ :lowBits | aBlock value: (Character value: highBits + lowBits) ] ]! Item was changed: + ----- Method: WideCharacterSet>>findFirstInByteString:startingAt: (in category 'enumerating') ----- - ----- Method: WideCharacterSet>>findFirstInByteString:startingAt: (in category 'collection ops') ----- findFirstInByteString: aByteString startingAt: startIndex "Double dispatching: since we know this is a ByteString, we can use a superfast primitive using a ByteArray map with 0 slots for byte characters not included and 1 for byte characters included in the receiver." ^ByteString findFirstInString: aByteString inSet: byteArrayMap startingAt: startIndex! Item was changed: + ----- Method: WideCharacterSet>>includes: (in category 'testing') ----- - ----- Method: WideCharacterSet>>includes: (in category 'collection ops') ----- includes: anObject | value | anObject isCharacter ifFalse: [ ^false ]. (value := anObject asInteger) < 256 ifTrue: [ ^(byteArrayMap at: value + 1) ~= 0 ]. ^((map at: (value bitShift: highBitsShift) ifAbsent: nil) ifNil: [ ^false ]) includes: (value bitAnd: lowBitsMask)! Item was removed: - ----- Method: WideCharacterSet>>occurrencesOf: (in category 'enumerating') ----- - occurrencesOf: anObject - "Answer how many of the receiver's elements are equal to anObject. Optimized version." - - (self includes: anObject) ifTrue: [ ^1 ]. - ^0! Item was changed: + ----- Method: WideCharacterSet>>remove: (in category 'removing') ----- - ----- Method: WideCharacterSet>>remove: (in category 'collection ops') ----- remove: aCharacter "Don't signal an error when aCharacter is not present." ^self remove: aCharacter ifAbsent: aCharacter! Item was changed: + ----- Method: WideCharacterSet>>remove:ifAbsent: (in category 'removing') ----- - ----- Method: WideCharacterSet>>remove:ifAbsent: (in category 'collection ops') ----- remove: aCharacter ifAbsent: aBlock | value highBits lowBits bitset | (value := aCharacter asInteger) < 256 ifTrue: [ (byteArrayMap at: value + 1) = 0 ifTrue: [ ^aBlock value ]. byteArrayMap at: value + 1 put: 0 ]. highBits := value bitShift: highBitsShift. lowBits := value bitAnd: lowBitsMask. bitset := (map at: highBits ifAbsent: nil) ifNil: [ ^aBlock value ]. ((bitset clearBitAt: lowBits) and: [ bitset size = 0 ]) ifTrue: [ map removeKey: highBits ]. ^aCharacter! Item was changed: + ----- Method: WideCharacterSet>>removeAll (in category 'removing') ----- - ----- Method: WideCharacterSet>>removeAll (in category 'collection ops') ----- removeAll map isEmpty ifTrue: [ ^self ]. map removeAll. byteArrayMap atAllPut: 0! Item was changed: + ----- Method: WideCharacterSet>>size (in category 'accessing') ----- - ----- Method: WideCharacterSet>>size (in category 'collection ops') ----- size ^map detectSum: [ :each | each size ]!

2 1

The Trunk: Collections-nice.770.mcz
by commits＠source.squeak.org 30 Nov '17

30 Nov '17

Nicolas Cellier uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-nice.770.mcz ==================== Summary ==================== Name: Collections-nice.770 Author: nice Time: 30 November 2017, 6:01:07.729917 pm UUID: bab44976-95d4-e142-a0f7-eb954c3c237c Ancestors: Collections-tpr.769 Let CharacterSet union: work as expected and answer a (Wide)CharacterSet(Complement) when possible. =============== Diff against Collections-tpr.769 =============== Item was added: + ----- Method: CharacterSet>>union: (in category 'enumerating') ----- + union: aCollection + (self species = aCollection species or: [aCollection isString]) ifFalse: [^super union: aCollection]. + aCollection class = CharacterSetComplement ifTrue: [^aCollection union: self]. + ^self copy addAll: aCollection; yourself! Item was added: + ----- Method: CharacterSetComplement>>intersection: (in category 'enumerating') ----- + intersection: aCollection + aCollection class = self class ifTrue: [^(self complement union: aCollection complement) complement]. + ^(aCollection intersection: self) as: CharacterSet! Item was added: + ----- Method: CharacterSetComplement>>union: (in category 'enumerating') ----- + union: aCollection + aCollection class = self class ifTrue: [^(self complement intersection: aCollection complement) complement]. + (aCollection species = CharacterSet or: [aCollection isString]) ifFalse: [^self error: 'no way to compute the union, this collection is too big']. + ^(absent reject: [:e | aCollection includes: e]) complement! Item was added: + ----- Method: WideCharacterSet>>union: (in category 'enumerating') ----- + union: aCollection + (self species = aCollection species or: [aCollection isString]) ifFalse: [^super union: aCollection]. + ^self copy addAll: aCollection; yourself!

1 0

The Inbox: EToys-dtl.315.mcz
by commits＠source.squeak.org 30 Nov '17

30 Nov '17

David T. Lewis uploaded a new version of EToys to project The Inbox: http://source.squeak.org/inbox/EToys-dtl.315.mcz ==================== Summary ==================== Name: EToys-dtl.315 Author: dtl Time: 29 November 2017, 9:45:42.436285 pm UUID: 877a21b3-739f-4c05-8bec-bb5a153d1dbe Ancestors: EToys-dtl.314 SyntaxMorph requires asMorphicSyntaxIn: and related methods from the ParseNode hierarchy. This update adds the missing methods imported from the Etoys development image. SyntaxMorph class>>testAll exposes some problems in these earlier ParseNode methods, and this probably reflects updates that will be required to match the various compiler improvements in Squeak since the original SyntaxMorph implementation. =============== Diff against EToys-dtl.314 =============== Item was added: + ----- Method: AssignmentNode>>asMorphicSyntaxIn: (in category '*Etoys-tiles') ----- + asMorphicSyntaxIn: parent + + ^parent assignmentNode: self variable: variable value: value! Item was added: + ----- Method: BlockNode>>asMorphicCollectSyntaxIn: (in category '*Etoys-tiles') ----- + asMorphicCollectSyntaxIn: parent + + ^parent + blockNodeCollect: self + arguments: arguments + statements: statements! Item was added: + ----- Method: BlockNode>>asMorphicSyntaxIn: (in category '*Etoys-tiles') ----- + asMorphicSyntaxIn: parent + + ^parent + blockNode: self + arguments: arguments + statements: statements! Item was added: + ----- Method: BraceNode>>asMorphicSyntaxIn: (in category '*Etoys-tiles') ----- + asMorphicSyntaxIn: parent + + | row | + + row _ (parent addRow: #brace on: self) layoutInset: 1. + row addMorphBack: (StringMorph new contents: + (String streamContents: [:aStream | self printOn: aStream indent: 0])). + ^row + ! Item was added: + ----- Method: CascadeNode>>asMorphicSyntaxIn: (in category '*Etoys-tiles') ----- + asMorphicSyntaxIn: parent + + ^parent + cascadeNode: self + receiver: receiver + messages: messages + ! Item was added: + ----- Method: LiteralNode>>asMorphicSyntaxIn: (in category '*Etoys-tiles') ----- + asMorphicSyntaxIn: parent + + | row | + + row _ parent addRow: #literal on: self. + (key isVariableBinding) ifFalse: [ + row layoutInset: 1. + ^ row addMorphBack: (row addString: key storeString special: false)]. + key key isNil ifTrue: [ + ^ row addTextRow: ('###',key value soleInstance name) + ] ifFalse: [ + ^ row addTextRow: ('##', key key) + ]. ! Item was added: + ----- Method: MessageNode>>asMorphicSyntaxIn: (in category '*Etoys-tiles') ----- + asMorphicSyntaxIn: parent + + ^parent + vanillaMessageNode: self + receiver: receiver + selector: selector + arguments: arguments + ! Item was added: + ----- Method: MessageNode>>morphFromKeywords:arguments:on:indent: (in category '*Etoys-tiles') ----- + morphFromKeywords: key arguments: args on: parent indent: ignored + + ^parent + messageNode: self + receiver: receiver + selector: selector + keywords: key + arguments: args + ! Item was added: + ----- Method: MethodNode>>asMorphicSyntaxIn: (in category '*Etoys-tiles') ----- + asMorphicSyntaxIn: parent + + ^parent + methodNodeInner: self + selectorOrFalse: selectorOrFalse + precedence: precedence + arguments: arguments + temporaries: temporaries + primitive: primitive + block: block + ! Item was added: + ----- Method: MethodNode>>asMorphicSyntaxUsing: (in category '*Etoys-tiles') ----- + asMorphicSyntaxUsing: aClass + + ^ Cursor wait showWhile: [ + (aClass methodNodeOuter: self) finalAppearanceTweaks] + ! Item was added: + ----- Method: MorphicProject>>setWorld: (in category '*Etoys-Worlds') ----- + setWorld: aWorld + world := aWorld. + Smalltalk globals at: #World + ifPresent: [ :w | Smalltalk globals at: #World put: world ]. + ! Item was added: + ----- Method: ParseNode>>asMorphicSyntaxIn: (in category '*Etoys-tiles') ----- + asMorphicSyntaxIn: parent + + | morph | + "Default for missing implementations" + + morph _ parent addColumn: #error on: self. + morph addTextRow: self class printString. + ^morph + + + ! Item was added: + ----- Method: ReturnNode>>asMorphicSyntaxIn: (in category '*Etoys-tiles') ----- + asMorphicSyntaxIn: parent + + ^parent returnNode: self expression: expr + ! Item was added: + ----- Method: TempVariableNode>>asMorphicSyntaxIn: (in category '*Etoys-tiles') ----- + asMorphicSyntaxIn: parent + + ^ parent addToken: self name type: #tempVariable on: self! Item was added: + ----- Method: VariableNode>>asMorphicSyntaxIn: (in category '*Etoys-tiles') ----- + asMorphicSyntaxIn: parent + + ^ parent addToken: self name + type: #variable + on: self clone "don't hand out the prototype!! See VariableNode>>initialize" + ! Item was added: + ----- Method: VariableNode>>currentValueIn: (in category '*Etoys-tiles') ----- + currentValueIn: aContext + + aContext ifNil: [^nil]. + ^((self variableGetterBlockIn: aContext) ifNil: [^nil]) value printString + + + ! Item was added: + ----- Method: VariableNode>>variableGetterBlockIn: (in category '*Etoys-tiles') ----- + variableGetterBlockIn: aContext + + | temps index ivars | + + (self type = 4 and: [self key isVariableBinding]) ifTrue: [ + ^[self key value] + ]. + aContext ifNil: [^nil]. + self isSelfPseudoVariable ifTrue: [^[aContext receiver]]. + self type = 1 ifTrue: [ + ivars _ aContext receiver class allInstVarNames. + index _ ivars indexOf: self name ifAbsent: [^nil]. + ^[aContext receiver instVarAt: index] + ]. + self type = 2 ifTrue: [ + temps _ aContext tempNames. + index _ temps indexOf: self name ifAbsent: [^nil]. + ^[aContext tempAt: index] + ]. + ^nil + !

1 0

The Trunk: EToys-dtl.314.mcz
by commits＠source.squeak.org 29 Nov '17

29 Nov '17

David T. Lewis uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-dtl.314.mcz ==================== Summary ==================== Name: EToys-dtl.314 Author: dtl Time: 25 November 2017, 12:18:54.339694 pm UUID: 5d8ae2a6-a8d1-4c96-acc8-69ef66a4aa81 Ancestors: EToys-dtl.313 Remove references to global World from SyntaxMorph. Note: #asMorphicSyntaxIn: is required for SyntaxMorph but not implemented in the ParseNode hierarchy. Presumably this should be harvested from an Etoys image. =============== Diff against EToys-dtl.313 =============== Item was changed: ----- Method: SyntaxMorph>>offerTilesMenuFor:in: (in category 'menus') ----- offerTilesMenuFor: aReceiver in: aLexiconModel "Offer a menu of tiles for assignment and constants" | menu | menu := MenuMorph new addTitle: 'Hand me a tile for...'. menu addLine. menu add: '(accept method now)' target: aLexiconModel selector: #acceptTiles. menu submorphs last color: Color red darker. menu addLine. menu add: 'me, by name' target: self selector: #attachTileForCode:nodeType: argumentList: {'<me by name>'. aReceiver}. menu add: 'self' target: self selector: #attachTileForCode:nodeType: argumentList: {'self'. VariableNode}. menu add: '_ (assignment)' target: self selector: #attachTileForCode:nodeType: argumentList: {'<assignment>'. nil}. menu add: '"a Comment"' target: self selector: #attachTileForCode:nodeType: argumentList: {'"a comment"\' withCRs. CommentNode}. menu submorphs last color: Color blue. menu add: 'a Number' target: self selector: #attachTileForCode:nodeType: argumentList: {'5'. LiteralNode}. menu add: 'a Character' target: self selector: #attachTileForCode:nodeType: argumentList: {'$z'. LiteralNode}. menu add: '''abc''' target: self selector: #attachTileForCode:nodeType: argumentList: {'''abc'''. LiteralNode}. menu add: 'a Symbol constant' target: self selector: #attachTileForCode:nodeType: argumentList: {'#next'. LiteralNode}. menu add: 'true' target: self selector: #attachTileForCode:nodeType: argumentList: {'true'. VariableNode}. menu add: 'a Test' target: self selector: #attachTileForCode:nodeType: argumentList: {'true ifTrue: [self] ifFalse: [self]'. MessageNode}. menu add: 'a Loop' target: self selector: #attachTileForCode:nodeType: argumentList: {'1 to: 10 do: [:index | self]'. MessageNode}. menu add: 'a Block' target: self selector: #attachTileForCode:nodeType: argumentList: {'[self]'. BlockNode}. menu add: 'a Class or Global' target: self selector: #attachTileForCode:nodeType: argumentList: {'Character'. LiteralVariableNode}. menu add: 'a Reply' target: self selector: #attachTileForCode:nodeType: argumentList: {'| temp | temp'. ReturnNode}. + menu popUpAt: ActiveHand position forHand: ActiveHand in: self world. - menu popUpAt: ActiveHand position forHand: ActiveHand in: World. ! Item was changed: ----- Method: SyntaxMorph>>offerVarsMenuFor:in: (in category 'menus') ----- offerVarsMenuFor: aReceiver in: aLexiconModel "Offer a menu of tiles for assignment and constants" | menu instVarList cls | menu := MenuMorph new addTitle: 'Hand me a tile for...'. menu addLine. menu add: '(accept method now)' target: aLexiconModel selector: #acceptTiles. menu submorphs last color: Color red darker. menu addLine. menu add: 'new temp variable' target: self selector: #attachTileForCode:nodeType: argumentList: {'| temp | temp'. TempVariableNode}. instVarList := OrderedCollection new. cls := aReceiver class. [instVarList addAllFirst: cls instVarNames. cls == aLexiconModel limitClass] whileFalse: [cls := cls superclass]. instVarList do: [:nn | menu add: nn target: self selector: #instVarTile: argument: nn]. + menu popUpAt: ActiveHand position forHand: ActiveHand in: self world. - menu popUpAt: ActiveHand position forHand: ActiveHand in: World. ! Item was changed: ----- Method: SyntaxMorph>>showMenu: (in category 'menus') ----- showMenu: evt | menu | menu := MenuMorph new. self rootTile isMethodNode ifTrue: [menu add: 'accept method' target: self selector: #accept. menu addLine. menu add: 'new temp variable' target: self selector: #attachTileForCode:nodeType: argumentList: {'| temp | temp'. TempVariableNode}. menu addLine. self parsedInClass allInstVarNames do: [:nn | menu add: nn,' tile' target: self selector: #instVarTile: argument: nn]. menu addLine. menu add: 'show code' target: self selector: #showCode. menu add: 'try out' target: self selector: #try. + menu popUpAt: evt hand position forHand: evt hand in: self world]. - menu popUpAt: evt hand position forHand: evt hand in: World]. !

1 0

The Trunk: EToys-dtl.313.mcz
by commits＠source.squeak.org 29 Nov '17

29 Nov '17

David T. Lewis uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-dtl.313.mcz ==================== Summary ==================== Name: EToys-dtl.313 Author: dtl Time: 25 November 2017, 9:54:37.052975 am UUID: af30c57e-305f-4ee3-bf9a-c8e8e46c8b3f Ancestors: EToys-bp.312 Remove most direct references to global World for Etoys. Still to be done: Remove the World references in SyntaxMorph and WiWPasteUpMorph. =============== Diff against EToys-bp.312 =============== Item was changed: ----- Method: DisplayScreen class>>restoreDisplay (in category '*Etoys-Squeakland-screen modes') ----- restoreDisplay "Clear the screen to gray and then redisplay all the scheduled views." + Smalltalk isMorphic ifTrue: [^ Project current world restoreMorphicDisplay]. - Smalltalk isMorphic ifTrue: [^ World restoreMorphicDisplay]. Display extent = DisplayScreen actualScreenSize ifFalse: [DisplayScreen startUp. ScheduledControllers unCacheWindows]. ScheduledControllers restore! Item was changed: ----- Method: EToysLauncher>>onEnterWorld (in category 'event handling') ----- onEnterWorld (owner notNil + and: [Project current world == owner]) - and: [World == owner]) ifTrue: [owner addMorphInLayer: self. self updatePane] + ifFalse: [Project current world removeActionsWithReceiver: self]! - ifFalse: [World removeActionsWithReceiver: self]! Item was changed: ----- Method: EtoysDebugger>>highlight: (in category 'highlighting') ----- highlight: aMorph "| rect | rect := BorderedMorph newBounds: aMorph bounds color: Color transparent. rect openInWorld. + Project current world addAlarm: #delete - World addAlarm: #delete withArguments: #() for: rect at: (Time millisecondClockValue + 200)." highlighter ifNotNil: [highlighter delete]. highlighter := HighlightMorph on: aMorph. highlighter openInWorld! Item was changed: ----- Method: EtoysDebugger>>trailMorph (in category 'accessing') ----- trailMorph + ^ self scriptedPlayer costume ifNil: [Project current world] ifNotNil: [:m | m trailMorph]! - ^ self scriptedPlayer costume ifNil: [World] ifNotNil: [:m | m trailMorph]! Item was changed: ----- Method: FileList2 class>>findAProjectSimple (in category '*Etoys-Squeakland-blue ui') ----- findAProjectSimple "self findAProjectSimple" ^ self + morphicViewProjectLoader2InWorld: Project current world - morphicViewProjectLoader2InWorld: World reallyLoad: true dirFilterType: #limitedSuperSwikiDirectoryList! Item was changed: ----- Method: HTTPProxyEditor class>>activateWindow: (in category 'instance creation') ----- activateWindow: aWindow "private - activate the window" + | world | + world := Project current world. aWindow + right: (aWindow right min: world bounds right); + bottom: (aWindow bottom min: world bounds bottom); + left: (aWindow left max: world bounds left); + top: (aWindow top max: world bounds top). + aWindow comeToFront; flash! - right: (aWindow right min: World bounds right). - aWindow - bottom: (aWindow bottom min: World bounds bottom). - aWindow - left: (aWindow left max: World bounds left). - aWindow - top: (aWindow top max: World bounds top). - "" - aWindow comeToFront. - aWindow flash! Item was changed: ----- Method: HTTPProxyEditor class>>open (in category 'instance creation') ----- open "open the receiver" + Project current world submorphs + do: [:each | (each isKindOf: self) + ifTrue: [self activateWindow: each. - World submorphs - do: [:each | "" - ((each isKindOf: self) - ) - ifTrue: ["" - self activateWindow: each. ^ self]]. - "" ^ self new openInWorld! Item was changed: ----- Method: KedamaMorph>>initialize (in category 'initialization') ----- initialize super initialize. drawRequested := true. changePending := false. + pixelsPerPatch := (Project current world width min: Project current world height) + // (self class defaultDimensions x * 2). "heuristic..." - pixelsPerPatch := (World width min: World height) // (self class defaultDimensions x * 2). "heuristic..." self dimensions: self class defaultDimensions. "dimensions of this StarSqueak world in patches" super extent: dimensions * pixelsPerPatch. self assuredPlayer assureUniClass. self clearAll. "be sure this is done once in case setup fails to do it" autoChanged := true. self leftEdgeMode: #wrap. self rightEdgeMode: #wrap. self topEdgeMode: #wrap. self bottomEdgeMode: #wrap. turtlesDictSemaphore := Semaphore forMutualExclusion. ! Item was changed: ----- Method: Morph>>asWearableCostume (in category '*Etoys-support') ----- asWearableCostume "Return a wearable costume for some player" + ^(Project current world drawingClass withForm: self imageForm) copyCostumeStateFrom: self! - ^(World drawingClass withForm: self imageForm) copyCostumeStateFrom: self! Item was changed: ----- Method: Morph>>showDesignationsOfObjects (in category '*Etoys-card in a stack') ----- showDesignationsOfObjects "Momentarily show the designations of objects on the receiver" | colorToUse | self isStackBackground ifFalse: [^self]. self submorphsDo: [:aMorph | | aLabel | aLabel :=aMorph renderedMorph holdsSeparateDataForEachInstance ifTrue: [colorToUse := Color orange. aMorph externalName] ifFalse: [colorToUse := aMorph isShared ifFalse: [Color red] ifTrue: [Color green]. nil]. Display border: (aMorph fullBoundsInWorld insetBy: -6) width: 6 rule: Form over fillColor: colorToUse. aLabel ifNotNil: [aLabel asString displayOn: Display at: aMorph fullBoundsInWorld bottomLeft + (0 @ 5) textColor: Color blue]]. Sensor anyButtonPressed ifTrue: [Sensor waitNoButton] ifFalse: [Sensor waitButton]. + self world fullRepaintNeeded! - World fullRepaintNeeded! Item was changed: ----- Method: MovingEyeMorph>>step (in category 'stepping and presenter') ----- step | cp | + cp := self globalPointToLocal: self world primaryHand position. - cp := self globalPointToLocal: World primaryHand position. (inner containsPoint: cp) ifTrue: [iris position: (cp - (iris extent // 2))] ifFalse: [self irisPos: cp]. self changed "cover up gribblies if embedded in Flash"! Item was changed: ----- Method: OLPCVirtualScreen>>checkForNewScreenSize (in category 'display') ----- checkForNewScreenSize | aPoint | aPoint := DisplayScreen actualScreenSize. aPoint = display extent ifTrue:[^nil]. display setExtent: aPoint depth: depth. display fillColor: (Color gray: 0.2). self setupWarp; forceToScreen. display forceToScreen. "to capture the borders" + Project current world restoreMorphicDisplay. + Project current world repositionFlapsAfterScreenSizeChange.! - World restoreMorphicDisplay. - World repositionFlapsAfterScreenSizeChange.! Item was changed: ----- Method: OLPCVirtualScreen>>zoomOut: (in category 'display') ----- zoomOut: aBoolean "When the physical display is bigger than the virtual display size, we have two options. One is to zoom in and maximize the visible area and another is to map a pixel to a pixel and show it in smaller area (at the center of screen). This flag governs them." self canZoomOut ifFalse: [^ self]. zoomOut := aBoolean. display fillColor: (Color gray: 0.2). self setupWarp; forceToScreen. display forceToScreen. "to capture the borders" + Project current world restoreMorphicDisplay. + Project current world repositionFlapsAfterScreenSizeChange. - World restoreMorphicDisplay. - World repositionFlapsAfterScreenSizeChange. ! Item was changed: ----- Method: Player>>grabPatchMorph (in category 'slot-kedama') ----- grabPatchMorph + Project current world primaryHand attachMorph: costume renderedMorph. - World primaryHand attachMorph: costume renderedMorph. ! Item was changed: ----- Method: Project class>>interruptName:preemptedProcess: (in category '*Etoys-Squeakland-utilities') ----- interruptName: labelString preemptedProcess: theInterruptedProcess "Create a Notifier on the active scheduling process with the given label." | preemptedProcess projectProcess | Smalltalk isMorphic ifFalse: [^ ScheduledControllers interruptName: labelString]. ActiveHand ifNotNil:[ActiveHand interrupted]. + ActiveWorld := Project current world. "reinstall active globals" + ActiveHand := ActiveWorld primaryHand. - ActiveWorld := World. "reinstall active globals" - ActiveHand := World primaryHand. ActiveHand interrupted. "make sure this one's interrupted too" ActiveEvent := nil. projectProcess := self uiProcess. "we still need the accessor for a while" preemptedProcess := theInterruptedProcess ifNil: [Processor preemptedProcess]. "Only debug preempted process if its priority is >= projectProcess' priority" preemptedProcess priority < projectProcess priority ifTrue:[preemptedProcess := projectProcess]. preemptedProcess suspend. Debugger openInterrupt: labelString onProcess: preemptedProcess ! Item was changed: ----- Method: ProjectLoading class>>loadSexpProjectDict:stream:fromDirectory:withProjectView: (in category '*etoys') ----- loadSexpProjectDict: dict stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView | archive anObject newProj d member memberStream members newSet allNames realName oldSet s | (self checkStream: preStream) ifTrue: [^ nil]. ProgressNotification signal: '0.2'. preStream reset. archive := preStream isZipArchive ifTrue:[ZipArchive new readFrom: preStream] ifFalse:[nil]. members := archive membersMatching: '*.cs'. members do: [:e | newSet := ChangeSorter newChangesFromStream: e contentStream named: 'zzTemp', Time totalSeconds printString]. member := (archive membersMatching: '*.sexp') first. memberStream := member contentStream. (self checkSecurity: member name preStream: preStream projStream: memberStream) ifFalse: [^nil]. self flag: #tfel. "load all projects and save them again in the new format, then get rid of the error block!!" s := memberStream basicUpToEnd. d := [(DataStream on: memberStream) next] on: Error do: [:e | (Smalltalk at: #MSExpParser) parse: s with: #ksexp]. anObject := d sissReadObjectsAsEtoysProject. preStream close. "anObject := (MSExpParser parse: (archive membersMatching: '*.sexp') first contents with: #ksexp) sissReadObjects." anObject ifNil: [^ nil]. + (anObject isKindOf: PasteUpMorph) ifFalse: [^ Project current world addMorph: anObject]. - (anObject isKindOf: PasteUpMorph) ifFalse: [^ World addMorph: anObject]. ProgressNotification signal: '0.7'. newProj := MorphicProject new. newProj installPasteUpAsWorld: anObject. newSet ifNotNil: [oldSet := newProj changeSet. newProj setChangeSet: newSet. ChangeSorter removeChangeSet: oldSet]. dict at: 'projectname' ifPresent: [:n | allNames := Project allNames. realName := Utilities keyLike: n satisfying: [:nn | (allNames includes: nn) not]. newProj renameTo: realName. ]. anObject valueOfProperty: #projectVersion ifPresentDo: [:v | newProj version: v]. newProj noteManifestDetailsIn: dict. ProgressNotification signal: '0.8'. ^ newProj.! Item was changed: ----- Method: ScrollableField>>spawn: (in category '*Etoys-Squeakland-as yet unclassified') ----- spawn: aByteString "Hack to open the object catalog when Cmd-O is pressed" self setMyText: aByteString. + (Project current world commandKeySelectors at: $o) value. - (World commandKeySelectors at: $o) value. ! Item was changed: ----- Method: SketchMorph>>asWearableCostume (in category '*Etoys-e-toy support') ----- asWearableCostume "Return a wearable costume for some player" + ^(Project current world drawingClass withForm: originalForm) copyCostumeStateFrom: self! - ^(World drawingClass withForm: originalForm) copyCostumeStateFrom: self! Item was changed: ----- Method: StandardScriptingSystem>>benchmarkCategory (in category '*Etoys-Squeakland-benchmarks') ----- benchmarkCategory "ScriptingSystem benchmarkCategory" + | m v result world | + world := Project current world. - | m v result | m := Morph new openInWorld. m openViewerForArgument. + world doOneCycle. - World doOneCycle. v := m player allOpenViewers first submorphs last. result := [v chosenCategorySymbol: #geometry. + world doOneCycle] timeToRun. - World doOneCycle] timeToRun. m delete. + world doOneCycle. - World doOneCycle. ^ result! Item was changed: ----- Method: StandardScriptingSystem>>benchmarkPainter (in category '*Etoys-Squeakland-benchmarks') ----- benchmarkPainter "ScriptingSystem benchmarkPainter" + | world result | + world := Project current world. + result := [world makeNewDrawing: nil at: 400 @ 300. + world doOneCycle] timeToRun. + (world findA: SketchEditorMorph) cancelOutOfPainting. + world doOneCycle. - | result | - result := [World makeNewDrawing: nil at: 400 @ 300. - World doOneCycle] timeToRun. - (World findA: SketchEditorMorph) cancelOutOfPainting. - World doOneCycle. ^ result! Item was changed: ----- Method: StandardScriptingSystem>>benchmarkScriptor (in category '*Etoys-Squeakland-benchmarks') ----- benchmarkScriptor "ScriptingSystem benchmarkScriptor" "(Picking up third one)" | result m | m := Morph new openInWorld. m openViewerForArgument. m player assureUniClass. m player newScriptorAround: nil. m player newScriptorAround: nil. result := [(m player newScriptorAround: nil) openInWorld. + Project current world doOneCycle] timeToRun. - World doOneCycle] timeToRun. m delete. + Project current world doOneCycle. - World doOneCycle. ^ result! Item was changed: ----- Method: StandardScriptingSystem>>benchmarkViewer (in category '*Etoys-Squeakland-benchmarks') ----- benchmarkViewer "ScriptingSystem benchmarkViewer" + | result m world | - | result m | m := Morph new openInWorld. + world := Project current world. result := [m openViewerForArgument. + world doOneCycle] timeToRun. - World doOneCycle] timeToRun. m delete. + world doOneCycle. - World doOneCycle. ^ result! Item was changed: ----- Method: SugarLauncher>>shutDown (in category 'running') ----- shutDown sharedActivity ifNotNil: [ self leaveSharedActivity. sharedActivity := nil]. Project allSubInstancesDo: [:prj | prj removeParameter: #sugarId]. ServerDirectory inImageServers keysAndValuesDo: [:srvrName :srvr | (srvr isKindOf: SugarDatastoreDirectory) ifTrue: [ ServerDirectory removeServerNamed: srvrName ifAbsent: []]]. Current := nil. + Project current world windowEventHandler: nil. - World windowEventHandler: nil. ! Item was changed: ----- Method: SugarLauncher>>startUp (in category 'running') ----- startUp self class allInstances do: [:ea | ea shutDown]. Current := self. SugarNavigatorBar current ifNotNil: [:bar | bar startUp]. parameters at: 'ACTIVITY_ID' ifPresent: [ :activityId | OLPCVirtualScreen setupIfNeeded. + Project current world windowEventHandler: self. - World windowEventHandler: self. (Smalltalk classNamed: 'DBus') ifNotNil: [:dbus | dbus sessionBus export: (Smalltalk classNamed: 'SugarEtoysActivity') new on: 'org.laptop.Activity', activityId at: '/org/laptop/Activity/', activityId]. Utilities authorName: self ownerBuddy nick. ServerDirectory addServer: (SugarDatastoreDirectory mimetype: 'application/x-squeak-project' extension: '.pr') named: SugarLauncher defaultDatastoreDirName. self joinSharedActivity. self isShared ifFalse: [ parameters at: 'OBJECT_ID' ifPresent: [:id | ^self resumeJournalEntry: id]]. self isShared ifTrue: [^self]. ^self welcome: (parameters at: 'URI' ifAbsent: [''])]. self welcome: '' ! Item was changed: ----- Method: SugarLauncher>>viewSource (in category 'commands') ----- viewSource WorldState addDeferredUIMessage: [ + Project current world showSourceKeyHit]! - World showSourceKeyHit]! Item was changed: ----- Method: SugarNavigatorBar>>putUpInitialBalloonHelp (in category 'initialization') ----- putUpInitialBalloonHelp " SugarNavigatorBar putUpInitialBalloonHelp " | suppliesButton b1 b2 p b | suppliesButton := paintButton owner submorphs detect: [:e | e isButton and: [e actionSelector = #toggleSupplies]]. b1 := BalloonMorph string: self paintButtonInitialExplanation for: paintButton corner: #topRight force: false. b2 := BalloonMorph string: self suppliesButtonInitialExplanation for: suppliesButton corner: #topLeft force: true. p := PasteUpMorph new. p clipSubmorphs: false. p color: Color transparent. p borderWidth: 0. p addMorph: b1. p addMorph: b2. + b := BalloonMorph string: p for: self world corner: #bottomLeft. - b := BalloonMorph string: p for: World corner: #bottomLeft. b color: Color transparent. b borderWidth: 0. [(Delay forSeconds: 1) wait. b popUpForHand: ActiveHand] fork. ! Item was changed: ----- Method: SugarNavigatorBar>>putUpInitialBalloonHelpFor: (in category 'initialization') ----- putUpInitialBalloonHelpFor: quads "Given a list of quads of the form <selector> <help-msg> <corner> <force-boolean> (see senders for examples), put up initial balloon help for them." " SugarNavigatorBar someInstance putUpInitialBalloonHelpFor: #((doNewPainting 'make a new painting' topRight false) (toggleSupplies 'open the supplies bin' topLeft true)) SugarNavigatorBar someInstance putUpInitialBalloonHelpFor: #((showNavBar 'show the tool bar' bottomLeft false) (hideNavBar 'hide the tool bar' bottomLeft false)) " | b1 p b | p := PasteUpMorph new. p clipSubmorphs: false. p color: Color transparent. p borderWidth: 0. quads do: [:aQuad | (submorphs first submorphs detect: [:e | e isButton and: [e actionSelector = aQuad first]] ifNone: [nil]) ifNotNil: [:aButton | b1 := BalloonMorph string: aQuad second for: aButton corner: aQuad third force: aQuad fourth. p addMorph: b1]]. + b := BalloonMorph string: p for: self world corner: #bottomLeft. - b := BalloonMorph string: p for: World corner: #bottomLeft. b color: Color transparent. b borderWidth: 0. [(Delay forSeconds: 1) wait. b popUpForHand: ActiveHand] fork. ! Item was changed: ----- Method: SugarNavigatorBar>>quitSqueak (in category 'button actions') ----- quitSqueak ^SugarLauncher isRunningInSugar ifTrue: [SugarLauncher current quit] ifFalse: [ Preferences eToyFriendly ifTrue: [super quitSqueak] ifFalse: [Smalltalk snapshot: ( UserDialogBoxMorph confirm: 'Save changes before quitting?' translated orCancel: [ ^self ] + at: self world center) - at: World center) andQuit: true]].!

1 0

FileChooser/SaverDialog
by tim Rowledge 28 Nov '17

28 Nov '17

I’ve just added the initial experimental file chooser & saver modal dialogs to the Tools package. Please try them out and find bugs or places where things could be nicer. If they work out we can replace a fair bit of really ugly code. tim -- tim Rowledge; tim(a)rowledge.org; http://www.rowledge.org/tim Original Sin is hard to find, but the digitally enhanced version is readily available.

6 36

Recent Nebraska updates are naughty
by tim Rowledge 28 Nov '17

28 Nov '17

While updating a fresh 16548 image I had to enable both assigning to block arguments and underline assignment chars. I thougt we were trying to be nice and not do that? tim -- tim Rowledge; tim(a)rowledge.org; http://www.rowledge.org/tim It is easier to change the specification to fit the program than vice versa.

2 4

The Trunk: CommandLine-tpr.9.mcz
by commits＠source.squeak.org 28 Nov '17

28 Nov '17

tim Rowledge uploaded a new version of CommandLine to project The Trunk: http://source.squeak.org/trunk/CommandLine-tpr.9.mcz ==================== Summary ==================== Name: CommandLine-tpr.9 Author: tpr Time: 27 November 2017, 4:19:28.477888 pm UUID: d691df70-b8c1-4a0b-9ec1-0976b33fe9ab Ancestors: CommandLine-mt.8 Add convenience method to save files via UIManager =============== Diff against CommandLine-mt.8 =============== Item was added: + ----- Method: DummyUIManager>>saveFilenameRequest:initialAnswer: (in category 'ui requests') ----- + saveFilenameRequest: queryString initialAnswer: defaultAnswer + "Open a FileSaverDialog to ask for a place and filename to use for saving a file. The initial suggestion for the filename is defaultAnswer but the user may choose any existing file or type in a new name entirely" + + (ProvideAnswerNotification signal: queryString) + ifNotNil: [:answer | + ^ answer == #default ifTrue: [defaultAnswer] ifFalse: [answer]]. + + self error: 'No user response possible'!

1 0

The Trunk: Files-tpr.174.mcz
by commits＠source.squeak.org 28 Nov '17

28 Nov '17

tim Rowledge uploaded a new version of Files to project The Trunk: http://source.squeak.org/trunk/Files-tpr.174.mcz ==================== Summary ==================== Name: Files-tpr.174 Author: tpr Time: 27 November 2017, 4:17:37.367161 pm UUID: 66bc2358-5091-4a6e-8ca9-d3cc71fac05e Ancestors: Files-tpr.173 Minor changes to use vmPathToSqueakPath =============== Diff against Files-tpr.173 =============== Item was changed: ----- Method: DirectoryEntry>>convertFromSystemName (in category 'multilingual system') ----- convertFromSystemName + name := name vmPathToSqueakPath! - name := (FilePath pathName: name isEncoded: true) asSqueakPathName! Item was changed: ----- Method: StandardFileStream>>requestDropStream: (in category 'dnd requests') ----- requestDropStream: dropIndex "Return a read-only stream for some file the user has just dropped onto Squeak." | rawName | rawName := self class primDropRequestFileName: dropIndex. + name := rawName vmPathToSqueakPath. - name := (FilePath pathName: rawName isEncoded: true) asSqueakPathName. fileID := self primDropRequestFileHandle: dropIndex. fileID == nil ifTrue:[^nil]. self register. rwmode := false. buffer1 := String new: 1. self enableReadBuffering !

1 0

The Trunk: Collections-tpr.769.mcz
by commits＠source.squeak.org 28 Nov '17

28 Nov '17

tim Rowledge uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-tpr.769.mcz ==================== Summary ==================== Name: Collections-tpr.769 Author: tpr Time: 27 November 2017, 4:16:19.721254 pm UUID: be0bba64-3ddd-45fa-8627-c842ab821515 Ancestors: Collections-nice.768 Minor changes relating to FilePath use =============== Diff against Collections-nice.768 =============== Item was changed: ----- Method: String>>asFileName (in category 'converting') ----- asFileName + "Answer a String made up from the receiver that is an acceptable file base + name. Does not produce corrected fulll paths if the directory separator etc are included" - "Answer a String made up from the receiver that is an acceptable file - name." | string checkedString | string := FileDirectory checkName: self fixErrors: true. checkedString := (FilePath pathName: string) asVmPathName. ^ (FilePath pathName: checkedString isEncoded: true) asSqueakPathName. ! Item was added: + ----- Method: String>>vmPathToSqueakPath (in category 'converting') ----- + vmPathToSqueakPath + "convert a file path string received from the vm to a Squeak String" + + ^ (FilePath pathName: self isEncoded: true) asSqueakPathName!

1 0

← Newer
1
2
3
4
5
6
7
...
20
Older →

Jump to page: