Squeak-dev June 2017

squeak-dev@lists.squeakfoundation.org

36 participants
130 discussions

The Trunk: KernelTests-nice.330.mcz
by commits＠source.squeak.org 10 Jun '17

10 Jun '17

Nicolas Cellier uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-nice.330.mcz ==================== Summary ==================== Name: KernelTests-nice.330 Author: nice Time: 10 June 2017, 5:48:42.935057 pm UUID: 356066a2-7666-4b6f-be07-5158f997854f Ancestors: KernelTests-eem.329 don't testIfNotNilDo, we might deprecate this message and this exact behavior is already tested in testIfNotNil =============== Diff against KernelTests-eem.329 =============== Item was removed: - ----- Method: UndefinedObjectTest>>testIfNotNilDo (in category 'tests - testing') ----- - testIfNotNilDo - - self shouldnt: [ nil ifNotNilDo: [self halt]] raise: Halt. - !

1 0

The Trunk: EToys-nice.300.mcz
by commits＠source.squeak.org 10 Jun '17

10 Jun '17

Nicolas Cellier uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-nice.300.mcz ==================== Summary ==================== Name: EToys-nice.300 Author: nice Time: 10 June 2017, 5:45:20.413477 pm UUID: b5f8be2a-6356-4991-8120-114515478877 Ancestors: EToys-eem.299 Massively replace ifNotNilDo: by ifNotNil: We don't need two different selectors to do a single thing. =============== Diff against EToys-eem.299 =============== Item was changed: ----- Method: CategoryViewer>>getterTilesFor:type: (in category 'get/set slots') ----- getterTilesFor: getterSelector type: aType "Answer classic getter for the given name/type" "aPhrase := nil, assumed" | selfTile selector aPhrase | (#(#color:sees: #colorSees) includes: getterSelector) ifTrue: [aPhrase := self colorSeesPhrase]. (#(#getPatchValueIn:) includes: getterSelector) ifTrue: [aPhrase := self patchValuePhrase]. (#(#getRedComponentIn:) includes: getterSelector) ifTrue: [aPhrase := self colorComponentPhraseFor: #red]. (#(#getGreenComponentIn:) includes: getterSelector) ifTrue: [aPhrase := self colorComponentPhraseFor: #green]. (#(#getBlueComponentIn:) includes: getterSelector) ifTrue: [aPhrase := self colorComponentPhraseFor: #blue]. (#(#getUphillIn:) includes: getterSelector) ifTrue: [aPhrase := self patchUphillPhrase]. (#(#bounceOn:) includes: getterSelector) ifTrue: [aPhrase := self bounceOnPhrase]. " (#(#bounceOn:color: #bounceOnColor:) includes: getterSelector) ifTrue: [aPhrase := self bounceOnColorPhrase]." (getterSelector = #getDistanceTo:) ifTrue: [aPhrase := self distanceToPhrase]. (getterSelector = #getAngleTo:) ifTrue: [aPhrase := self angleToPhrase]. (getterSelector = #getTurtleOf:) ifTrue: [aPhrase := self turtleOfPhrase]. (getterSelector = #distanceToPlayer:) ifTrue: [aPhrase := self distanceToPlayerPhrase]. (getterSelector = #bearingTo:) ifTrue: [aPhrase := self bearingToPhrase]. (getterSelector = #bearingFrom:) ifTrue: [aPhrase := self bearingFromPhrase]. (#(#seesColor: #isOverColor) includes: getterSelector) ifTrue: [aPhrase := self seesColorPhrase]. (#(#overlaps: #overlaps) includes: getterSelector) ifTrue: [aPhrase := self overlapsPhrase]. (#(#overlapsAny: #overlapsAny) includes: getterSelector) ifTrue: [aPhrase := self overlapsAnyPhrase]. (#(#touchesA: #touchesA) includes: getterSelector) ifTrue: [aPhrase := self touchesAPhrase]. aPhrase ifNil: [aPhrase := PhraseTileMorph new setSlotRefOperator: getterSelector asSymbol type: aType]. selfTile := self tileForSelf bePossessive. selfTile position: aPhrase firstSubmorph position. aPhrase firstSubmorph addMorph: selfTile. selector := aPhrase submorphs second. (#(#getPatchValueIn: getUphillIn: bearingFrom: bearingTo: distanceToPlayer:) includes: getterSelector) ifFalse: [ (Vocabulary vocabularyNamed: aType capitalized) + ifNotNil: [:aVocab | aVocab wantsSuffixArrow ifTrue: [selector addSuffixArrow]]. - ifNotNilDo: [:aVocab | aVocab wantsSuffixArrow ifTrue: [selector addSuffixArrow]]. ]. selector updateLiteralLabel. aPhrase enforceTileColorPolicy. ^aPhrase! Item was changed: ----- Method: CategoryViewer>>makeSetterForColorComponent:componentName:event:from: (in category 'get/set slots') ----- makeSetterForColorComponent: selectorAndTypePair componentName: componentName event: evt from: aMorph | argType m argTile selfTile argValue actualGetter | argType := selectorAndTypePair second. componentName = #red ifTrue: [actualGetter := #setRedComponentIn:]. componentName = #green ifTrue: [actualGetter := #setGreenComponentIn:]. componentName = #blue ifTrue: [actualGetter := #setBlueComponentIn:]. m := PhraseTileMorph new setColorComponentRoot: actualGetter componentName: componentName type: #command rcvrType: #Patch argType: argType vocabulary: self currentVocabulary. argValue := self scriptedPlayer perform: selectorAndTypePair first asSymbol with: nil. (argValue isKindOf: Player) ifTrue: [argTile := argValue tileReferringToSelf] ifFalse: [argTile := ScriptingSystem tileForArgType: argType. (argType == #Number and: [argValue isNumber]) ifTrue: [(scriptedPlayer decimalPlacesForGetter: actualGetter) + ifNotNil: [:places | (argTile findA: UpdatingStringMorph) decimalPlaces: places]]. - ifNotNilDo: [:places | (argTile findA: UpdatingStringMorph) decimalPlaces: places]]. argTile setLiteral: argValue; updateLiteralLabel]. argTile position: m lastSubmorph position. m lastSubmorph addMorph: argTile. selfTile := self tileForSelf bePossessive. selfTile position: m firstSubmorph position. m firstSubmorph addMorph: selfTile. m enforceTileColorPolicy. m submorphs second setPatchDefaultTo: scriptedPlayer defaultPatchPlayer. m openInHand! Item was changed: ----- Method: CategoryViewer>>makeSetterForGetPatchValue:event:from: (in category 'get/set slots') ----- makeSetterForGetPatchValue: selectorAndTypePair event: evt from: aMorph | argType m argTile selfTile argValue actualGetter | argType := selectorAndTypePair second. actualGetter := #patchValueIn:. m := PhraseTileMorph new setPixelValueRoot: actualGetter type: #command rcvrType: #Player argType: argType vocabulary: self currentVocabulary. argValue := self scriptedPlayer perform: selectorAndTypePair first asSymbol with: nil. (argValue isPlayerLike) ifTrue: [argTile := argValue tileReferringToSelf] ifFalse: [argTile := ScriptingSystem tileForArgType: argType. (argType == #Number and: [argValue isNumber]) ifTrue: [(scriptedPlayer decimalPlacesForGetter: actualGetter) + ifNotNil: [:places | (argTile findA: UpdatingStringMorph) decimalPlaces: places]]. - ifNotNilDo: [:places | (argTile findA: UpdatingStringMorph) decimalPlaces: places]]. argTile setLiteral: argValue; updateLiteralLabel]. argTile position: m lastSubmorph position. m lastSubmorph addMorph: argTile. selfTile := self tileForSelf bePossessive. selfTile position: m firstSubmorph position. m firstSubmorph addMorph: selfTile. m enforceTileColorPolicy. m submorphs second setPatchDefaultTo: scriptedPlayer defaultPatchPlayer. m openInHand! Item was changed: ----- Method: EToyProjectDetailsMorph>>setInfoField:to: (in category '*Etoys-Squeakland-utilities') ----- setInfoField: aFieldName to: aValue "Install a value into an info field of the dialog. Textual fields are filled literally, but enumerated fields (subject, region, etc.) are represented by codes which get mapped into (translated) text to display." | newValue choices | newValue := aValue. choices := self choicesFor: aFieldName. choices ifNotNil: "i.e. one of the fields with enumerated values" + [(choices detect: [:c | c first = aValue] ifNone: [nil]) ifNotNil: - [(choices detect: [:c | c first = aValue] ifNone: [nil]) ifNotNilDo: [:item | newValue := item third translated]]. (namedFields at: aFieldName) contentsWrapped: newValue ! Item was changed: ----- Method: EtoysPresenter>>reallyAllExtantPlayersNoSort (in category 'intialize') ----- reallyAllExtantPlayersNoSort "The initial intent here was to produce a list of Player objects associated with any Morph in the tree beneath the receiver's associatedMorph. whether it is the submorph tree or perhaps off on unseen bookPages. We have for the moment moved away from that initial intent, and in the current version we only deliver up players associated with the submorph tree only. <-- this note dates from 4/21/99" | fullList objectsReferredToByTiles aSet fullClassList | self flushPlayerListCache. aSet := IdentitySet new: 400. associatedMorph allMorphsAndBookPagesInto: aSet. fullList := aSet select: [:m | m player ~~ nil] thenCollect: [:m | m player]. fullClassList := fullList collect: [:aPlayer | aPlayer class] thenSelect: [:aClass | aClass isUniClass]. fullClassList do: [:aPlayerClass | aPlayerClass scripts do: [:aScript | aScript isTextuallyCoded ifFalse: + [aScript currentScriptEditor ifNotNil: [:ed | - [aScript currentScriptEditor ifNotNilDo: [:ed | objectsReferredToByTiles := ed allMorphs select: [:aMorph | (aMorph isKindOf: TileMorph) and: [aMorph type == #objRef]] thenCollect: [:aMorph | aMorph actualObject]. fullList addAll: objectsReferredToByTiles]]]]. ^ fullList! Item was changed: ----- Method: EventMorph>>brownDragConcluded (in category 'drag and drop') ----- brownDragConcluded "After the user has manually repositioned the receiver via brown-halo-drag, this is invoked." ActiveWorld abandonAllHalos. + self eventRoll ifNotNil: - self eventRoll ifNotNilDo: [:evtRoll | evtRoll pushChangesBackToEventTheatre]! Item was changed: ----- Method: EventMorph>>justDroppedInto:event: (in category 'drag and drop') ----- justDroppedInto: aMorph event: anEvent "The receiver was just dropped somewhere..." | aFormerOwner | aFormerOwner := self formerOwner ifNil: [^ self]. aMorph == aFormerOwner ifTrue: [^ self]. (aFormerOwner isKindOf: EventTimeline) ifTrue: + [aFormerOwner eventRoll ifNotNil: [:r | r pushChangesBackToEventTheatre. - [aFormerOwner eventRoll ifNotNilDo: [:r | r pushChangesBackToEventTheatre. self formerOwner: nil] ]. "NB only do this once!!"! Item was changed: ----- Method: EventPlaybackButton>>initializeFrom: (in category 'initialization') ----- initializeFrom: anEventRecordingSpace "Initialize the receiver to be a button which will play the sequence currenty defined in the given event-recording space." self initializeToShow: anEventRecordingSpace initialContentArea withLabel: anEventRecordingSpace captionString andSend: #launchPlayback to: self. "Icon is made with the recording space in whatever state the user prefers -- may be at the beginning or end of playback, for example." autoStart := true. autoDismiss := true. anEventRecordingSpace rewind. contentArea := anEventRecordingSpace initialContentArea veryDeepCopy. tape := anEventRecordingSpace eventRecorder tape veryDeepCopy. caption := anEventRecordingSpace captionString veryDeepCopy. initialPicture := anEventRecordingSpace initialPicture veryDeepCopy. finalPicture := anEventRecordingSpace finalPicture veryDeepCopy. self on: #click send: nil to: nil. "Undo generic IconicButton evt handler" self target: self; actionSelector: #launchPlayback; arguments: #(). self actWhen: #buttonUp. + anEventRecordingSpace balloonHelpString ifNotNil: - anEventRecordingSpace balloonHelpString ifNotNilDo: [:t | self setBalloonText: t] ! Item was changed: ----- Method: EventPlaybackSpace>>abandon (in category 'commands') ----- abandon "Abandon the entire exercise." self delete. self dismantlePaintBoxArtifacts. self abandonReplayHandsAndHalos. + (self valueOfProperty: #stopper) ifNotNil: - (self valueOfProperty: #stopper) ifNotNilDo: [:stopper | stopper delete]. + (self valueOfProperty: #originatingButton) ifNotNil: - (self valueOfProperty: #originatingButton) ifNotNilDo: [:aButton | aButton playbackConcludedIn: self]! Item was changed: ----- Method: EventPlaybackSpace>>comeToFront (in category 'commands') ----- comeToFront "Bring the receiver to the front, then its dismisser in front of it." super comeToFront. + (self valueOfProperty: #stopper) ifNotNil: - (self valueOfProperty: #stopper) ifNotNilDo: [:s | s comeToFront]! Item was changed: ----- Method: EventRecordingSpace>>dismantlePaintBoxArtifacts (in category 'commands') ----- dismantlePaintBoxArtifacts "Cleanup after playback -- if a paint-box has been left up, take it down." + (ActiveWorld findA: SketchEditorMorph) ifNotNil: - (ActiveWorld findA: SketchEditorMorph) ifNotNilDo: [:skEd | skEd cancelOutOfPainting]! Item was changed: ----- Method: EventRecordingSpace>>installPaintBoxSettingsPrevailingAtRecordingTime (in category 'commands') ----- installPaintBoxSettingsPrevailingAtRecordingTime "Install settings for the PaintBox assumed by the recording, in preparation for playback. But first save the existing values for these settings, so that after playback the pre-existing state could be restored, though in current design we decide not to do that last." self setProperty: #incomingPaintBoxBrushSymbol toValue: PaintBoxMorph prototype currentBrushSymbol. self setProperty: #incomingPaintBoxCurrentColor toValue: PaintBoxMorph prototype getColor. + (contentArea valueOfProperty: #paintBoxBrushSymbol) ifNotNil: - (contentArea valueOfProperty: #paintBoxBrushSymbol) ifNotNilDo: [:sym | PaintBoxMorph prototype brush: sym]. + (contentArea valueOfProperty: #paintBoxCurrentColor) ifNotNil: - (contentArea valueOfProperty: #paintBoxCurrentColor) ifNotNilDo: [:aColor | PaintBoxMorph prototype currentColor: aColor]! Item was changed: ----- Method: EventRecordingSpace>>pausePlayback (in category 'commands') ----- pausePlayback "Pause the playback. Sender responsible for setting state to #suspendedPlayback" eventRecorder pausePlayback. + (ActiveWorld findA: SketchEditorMorph) ifNotNil: - (ActiveWorld findA: SketchEditorMorph) ifNotNilDo: [:skEd | skEd cancelOutOfPainting. ^ self rewind]. self borderColor: Color orange. self setProperty: #suspendedContentArea toValue: contentArea veryDeepCopy. self populateControlsPanel! Item was changed: ----- Method: EventRecordingSpace>>removeSugarNavigatorFlap (in category 'sugar flaps') ----- removeSugarNavigatorFlap "Hide the fake interior sugar navigator." + (contentArea findA: InteriorSugarNavBar) ifNotNil: - (contentArea findA: InteriorSugarNavBar) ifNotNilDo: [:aBar | aBar delete]! Item was changed: ----- Method: EventRecordingSpace>>restoreIncomingPaintBoxSettings (in category 'commands') ----- restoreIncomingPaintBoxSettings "After a playback, restore the current-brush-width and current-color settings that had prevailed before playback started. Only current sender has its call to this method commented out, however..." + (self valueOfProperty: #incomingPaintBoxBrushSymbol) ifNotNil: - (self valueOfProperty: #incomingPaintBoxBrushSymbol) ifNotNilDo: [:sym | PaintBoxMorph prototype brush: sym. self removeProperty: #incomingPaintBoxBrushSymbol]. + (self valueOfProperty: #incomingPaintBoxCurrentColor) ifNotNil: - (self valueOfProperty: #incomingPaintBoxCurrentColor) ifNotNilDo: [:aColor | PaintBoxMorph prototype currentColor: aColor. self removeProperty: #incomingPaintBoxCurrentColor]! Item was changed: ----- Method: ExtendedClipboardMacInterface>>readByteStringClipboardData (in category 'general-api-read') ----- readByteStringClipboardData ^(self readClipboardData: 'com.apple.traditional-mac-plain-text') + ifNotNil: [: bytes | bytes asString macToSqueak] - ifNotNilDo: [: bytes | bytes asString macToSqueak] ! Item was changed: ----- Method: ExtendedClipboardMacInterface>>readTextClipboardData (in category 'general-api-read') ----- readTextClipboardData ^self readStringClipboardData + ifNotNil: [:string | (string replaceAll: Character lf with: Character cr) asText] - ifNotNilDo: [:string | (string replaceAll: Character lf with: Character cr) asText] ! Item was changed: ----- Method: ExtendedClipboardMacInterface>>readUTF8StringClipboardData (in category 'general-api-read') ----- readUTF8StringClipboardData ^(self readClipboardData: 'public.utf8-plain-text') + ifNotNil: [:bytes | - ifNotNilDo: [:bytes | [bytes asString utf8ToSqueak] ifError: [bytes asString] ] ! Item was changed: ----- Method: FileList2 class>>morphicViewProjectLoader2InWorld:title:reallyLoad:dirFilterType:isGeneral: (in category '*Etoys-Squeakland-blue ui') ----- morphicViewProjectLoader2InWorld: aWorld title: title reallyLoad: aBoolean dirFilterType: aSymbol isGeneral: isGeneral "Put up a blue file-list for loading etoy projects." " FileList2 morphicViewProjectLoader2InWorld: self currentWorld reallyLoad: true dirFilterType: #limitedSuperSwikiDirectoryList " | window aFileList actionRow treePane p | aFileList := self buildFileListDirFilterType: aSymbol. window := self buildMorphicWindow: aFileList title: title. actionRow := self buildLoadButtons: window fileList: aFileList reallyLoad: aBoolean. isGeneral ifTrue: [self buildFileTypeButtons: window actionRow: actionRow fileList: aFileList]. treePane := self buildPane: aWorld fileList: aFileList window: window dirFilterType: aSymbol. window addMorphBack: actionRow. window fullBounds. window position: aWorld topLeft + (aWorld extent - window extent // 2). window beSticky. aFileList sortByName. "This crazy stuff I really cannot figure out how to get the directory selected by default other than this." (treePane scroller submorphs detect: [:e | p := e complexContents withoutListWrapper pathName. (p beginsWith: 'sugar://') or: [p = SecurityManager default untrustedUserDirectory]] ifNone: [nil]) + ifNotNil: [:item | WorldState addDeferredUIMessage: [aFileList setSelectedDirectoryTo: item complexContents]]. - ifNotNilDo: [:item | WorldState addDeferredUIMessage: [aFileList setSelectedDirectoryTo: item complexContents]]. aFileList postOpen. ^ window! Item was changed: ----- Method: Flaps class>>addAndEnableEToyFlapsWithPreviousEntries: (in category '*Etoys-Squeakland-predefined flaps') ----- addAndEnableEToyFlapsWithPreviousEntries: aCollection "Initialize the standard default out-of-box set of global flaps. This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed." | aSuppliesFlap | SharedFlapTabs ifNotNil: [^ self]. SharedFlapTabs := OrderedCollection new. aSuppliesFlap := self newSuppliesFlapFromQuads: self quadsDefiningPlugInSuppliesFlap positioning: #right withPreviousEntries: aCollection. aSuppliesFlap referent setNameTo: 'Supplies Flap' translated. "Per request from Kim Rose, 7/19/02" SharedFlapTabs add: aSuppliesFlap. "The #center designation doesn't quite work at the moment" SugarNavigatorBar showSugarNavigator ifTrue: [SharedFlapTabs add: self newSugarNavigatorFlap] ifFalse: [SharedFlapTabs add: self newNavigatorFlap]. self enableGlobalFlapWithID: 'Supplies' translated. SugarNavigatorBar showSugarNavigator ifTrue: [self enableGlobalFlapWithID: 'Sugar Navigator Flap' translated. + (self globalFlapTabWithID: 'Sugar Navigator Flap' translated) ifNotNil: - (self globalFlapTabWithID: 'Sugar Navigator Flap' translated) ifNotNilDo: [:navTab | aSuppliesFlap sugarNavTab: navTab]] ifFalse: [self enableGlobalFlapWithID: 'Navigator' translated]. SharedFlapsAllowed := true. Project current flapsSuppressed: false. ^ SharedFlapTabs "Flaps addAndEnableEToyFlaps"! Item was changed: ----- Method: FunctionNameTile>>setOperator: (in category 'choice of function') ----- setOperator: anOperatorSymbol "The user chose an entry with the given inherent operator symbol (this may differ from what the user sees in the pop-up or on the tile." | aTable | operatorOrExpression := anOperatorSymbol. operatorOrExpression = #grouped ifTrue: [self line1: ' '. self setBalloonText: 'parenthesized' translated] ifFalse: [aTable := ScriptingSystem tableOfNumericFunctions. + (aTable detect: [:m | m second = anOperatorSymbol] ifNone: [nil]) ifNotNil: - (aTable detect: [:m | m second = anOperatorSymbol] ifNone: [nil]) ifNotNilDo: [:aTriplet | self line1: aTriplet first translated. self setBalloonText: aTriplet third translated]]. self addArrows. self scriptEdited. self layoutChanged! Item was changed: ----- Method: KeyboardEventMorph>>changeCharacter (in category 'menu commands') ----- changeCharacter "Allow the user to select a new character for the receiver." | result | result := FillInTheBlank request: 'New character? ' translated initialAnswer: character asString. result isEmptyOrNil ifTrue: [^ self]. result = character asString ifTrue: [^ self]. event keyValue: result first asciiValue. + self eventRoll ifNotNil: [:r | r pushChangesBackToEventTheatre]! - self eventRoll ifNotNilDo: [:r | r pushChangesBackToEventTheatre]! Item was changed: ----- Method: Morph>>defaultFloatPrecisionFor: (in category '*Etoys-scripting') ----- defaultFloatPrecisionFor: aGetSelector "Answer a number indicating the default float precision to be used in a numeric readout for which the receiver provides the data. Individual morphs can override this. Showing fractional values for readouts of getCursor was in response to an explicit request from ack" + (self renderedMorph decimalPlacesForGetter: aGetSelector) ifNotNil: [:places | ^ (Utilities floatPrecisionForDecimalPlaces: places)]. - (self renderedMorph decimalPlacesForGetter: aGetSelector) ifNotNilDo: [:places | ^ (Utilities floatPrecisionForDecimalPlaces: places)]. (#(getCursor getNumericValue getNumberAtCursor getCursorWrapped getScaleFactor) includes: aGetSelector) ifTrue: [^ 0.01]. (#(getXOnGraph getYOnGraph getLocationOnGraph) includes: aGetSelector) ifTrue: [^ 0.1]. ^ 1! Item was changed: ----- Method: MorphExtension>>inspectAllPropertiesOf: (in category '*Etoys-Squeakland-inspecting') ----- inspectAllPropertiesOf: aMorph "Open an Inspector on all the properties. This lets you see them but not in the initial instance actually modify them." | aDict | aDict := otherProperties ifNil: [IdentityDictionary new] ifNotNil: [otherProperties copy]. ((self class allInstVarNames reject: [:e | e = 'otherProperties']) collect: [:e | e asSymbol]) do: + [:var | (self instVarNamed: var) ifNotNil: - [:var | (self instVarNamed: var) ifNotNilDo: [:val | aDict add: (var -> val)]]. aDict inspectWithLabel: 'Properties of ', aMorph defaultLabelForInspector! Item was changed: ----- Method: MouseEventSequenceMorph>>growConcluded (in category 'processing') ----- growConcluded "After the user has manually resized the receiver, via its halo, this is called." | leftTime rightTime newSpan oldSpan ratio baseline | + self eventRoll ifNotNil: [:roll | - self eventRoll ifNotNilDo: [:roll | leftTime :=roll timeStampForCurrentPositionOf: self. rightTime := roll timeStampForRightEdgeOf: self. oldSpan := event duration. newSpan := rightTime - leftTime. ratio := newSpan asFloat / oldSpan. newSpan ~= oldSpan ifTrue: [baseline := event events first timeStamp. event events do: [:evt | evt timeStamp: (baseline + (((evt timeStamp - baseline) * ratio)))]. event startTime: event events first timeStamp. event stopTime: event events last timeStamp. roll pushChangesBackToEventTheatre] ifFalse: [^ self]]! Item was changed: ----- Method: PasteUpMorph>>abandonReplayHandsAndHalos (in category '*Etoys-Squeakland-olpc') ----- abandonReplayHandsAndHalos "Cleanup after playback." (self submorphs select: [:m | m isKindOf: HaloMorph]) do: [:m | m delete]. HandMorphForReplay allInstancesDo: [:i | + i halo ifNotNil: [:h | h delete]. - i halo ifNotNilDo: [:h | h delete]. self removeHand: i] " ActiveWorld abandonReplayHandsAndHalos. " ! Item was changed: ----- Method: PasteUpMorph>>abandonReplayHandsAndHalosFor: (in category '*Etoys-Squeakland-olpc') ----- abandonReplayHandsAndHalosFor: anEventRecorder "Cleanup after playback." (self submorphs select: [:m | m isKindOf: HaloMorph]) do: [:m | m delete]. HandMorphForReplay allInstancesDo: [:i | i recorder == anEventRecorder ifTrue: + [i halo ifNotNil: [:h | h delete]. - [i halo ifNotNilDo: [:h | h delete]. self removeHand: i]]! Item was changed: ----- Method: PlaybackInvoker>>initializeFrom: (in category 'initialization') ----- initializeFrom: anEventRecordingSpace "Initialize the receiver from the given recording space." | beforeImage theatreCopy | theatreCopy := anEventRecordingSpace veryDeepCopy. "Still want to do the below but there are still maddening problems with it." "theatreCopy convertToCanonicalForm." autoStart := true. autoDismiss := true. caption := theatreCopy captionString. offeringHint := true. beforeImage := theatreCopy initialPicture. beforeBitmap := beforeImage scaledToSize: (beforeImage extent * 0.3) rounded. theatreCopy rewind. contentArea := theatreCopy initialContentArea veryDeepCopy. tape := theatreCopy eventRecorder tape veryDeepCopy. caption := theatreCopy captionString. + theatreCopy balloonHelpString ifNotNil: - theatreCopy balloonHelpString ifNotNilDo: [:t | self setBalloonText: t]. self form: beforeBitmap. initialPicture := anEventRecordingSpace initialPicture veryDeepCopy. finalPicture := anEventRecordingSpace finalPicture veryDeepCopy. postPlaybackImageFeature := false. self on: #mouseUp send: #launchPlayback to: self ! Item was changed: ----- Method: Player>>getNewClone (in category 'slot getters/setters') ----- getNewClone "Answer a new player of the same class as the receiver, with a costume much like mine" | clone | clone := costume usableSiblingInstance. + costume pasteUpMorph ifNotNil: [:parent | parent addMorph: clone]. - costume pasteUpMorph ifNotNilDo: [:parent | parent addMorph: clone]. ^ clone player ! Item was changed: ----- Method: Player>>getPrecisionFor: (in category '*Etoys-Squeakland-slots-user') ----- getPrecisionFor: slotName "get the precision for the given slot name" | aGetter places precision | precision := 1. (self slotInfo includesKey: slotName) ifTrue: ["it's a user slot" precision := (self slotInfoAt: slotName) floatPrecision] ifFalse: ["reference to system slots" aGetter := Utilities getterSelectorFor: slotName. + self costume renderedMorph ifNotNil: [ :morph | - self costume renderedMorph ifNotNilDo: [ :morph | places := morph decimalPlacesForGetter: aGetter. precision := Utilities floatPrecisionForDecimalPlaces: places ]]. ^precision! Item was changed: ----- Method: Player>>getXOnGraph (in category '*Etoys-Squeakland-morphicExtras-Charts') ----- getXOnGraph "Answer the x-coordinate with respect to a corresponding horizontal axis, if any; if none, answer the cartesian x" | aCostume | (aCostume := self costume) isInWorld ifFalse: [^ self getX]. + (aCostume referencePlayfield findA: HorizontalNumberLineMorph) ifNotNil: - (aCostume referencePlayfield findA: HorizontalNumberLineMorph) ifNotNilDo: [:aNumberLine | ^ aNumberLine horizontalCoordinateOf: aCostume]. ^ self getX! Item was changed: ----- Method: Player>>getYOnGraph (in category '*Etoys-Squeakland-morphicExtras-Charts') ----- getYOnGraph "Answer the y-coordinate with respect to a corresponding horizontal axis, if any; if none, answer the cartesian x" | aCostume | (aCostume := self costume) isInWorld ifFalse: [^ self getY]. + (aCostume referencePlayfield findA: VerticalNumberLineMorph) ifNotNil: - (aCostume referencePlayfield findA: VerticalNumberLineMorph) ifNotNilDo: [:aNumberLine | ^ aNumberLine verticalCoordinateOf: aCostume]. ^ self getY! Item was changed: ----- Method: Player>>overlapsAny: (in category 'scripts-standard') ----- overlapsAny: aPlayer "Answer true if my costume overlaps that of aPlayer, or any of its siblings (if aPlayer is a scripted player) or if my costume overlaps any morphs of the same class (if aPlayer is unscripted)." | possibleCostumes itsCostume itsCostumeClass myShadow | (self ~= aPlayer and: [self overlaps: aPlayer]) ifTrue: [^true]. possibleCostumes := IdentitySet new. aPlayer belongsToUniClass ifTrue: [aPlayer class allSubInstancesDo: [:anInstance | (anInstance ~~ self and: [itsCostume := anInstance costume. (itsCostume bounds intersects: costume bounds) and: [itsCostume world == costume world]]) ifTrue: [possibleCostumes add: itsCostume]]] ifFalse: [itsCostumeClass := aPlayer costume class. self costume world presenter allExtantPlayers do: [:ep | self ~= ep ifTrue:[ ep costume + ifNotNil: [:ea | (ea class == itsCostumeClass - ifNotNilDo: [:ea | (ea class == itsCostumeClass and: [ea bounds intersects: costume bounds]) ifTrue: [possibleCostumes add: ea]]]]]. possibleCostumes isEmpty ifTrue: [^ false]. myShadow := costume shadowForm. ^possibleCostumes anySatisfy: [:m | m overlapsShadowForm: myShadow bounds: costume fullBounds]. ! Item was changed: ----- Method: Player>>referencePool (in category '*Etoys-Squeakland-as yet unclassified') ----- referencePool + self costume ifNotNil: [:c | c referenceWorld ifNotNil: [:w | ^ w referencePool]]. - self costume ifNotNilDo: [:c | c referenceWorld ifNotNilDo: [:w | ^ w referencePool]]. ^ nil. ! Item was changed: ----- Method: Player>>removeWatchersOfSlotNamed: (in category '*Etoys-Squeakland-translation') ----- removeWatchersOfSlotNamed: aName "A variable has been removed. Deal with possible watchers." | aGetter | aGetter := Utilities getterSelectorFor: aName. self allPossibleWatchersFromWorld do: [:aWatcher | (aWatcher getSelector = aGetter) ifTrue: [aWatcher stopStepping. + (aWatcher ownerThatIsA: WatcherWrapper) ifNotNil: - (aWatcher ownerThatIsA: WatcherWrapper) ifNotNilDo: [:aWrapper | aWrapper delete]]]! Item was changed: ----- Method: Player>>renameScript:newSelector: (in category 'scripts-kernel') ----- renameScript: oldSelector newSelector: newSelector "Rename the given script to have the new selector" | aUserScript anInstantiation aDict | oldSelector = newSelector ifTrue: [^ self]. oldSelector numArgs == 0 ifTrue: [self class allInstancesDo: [:aPlayer | | itsCostume | anInstantiation := aPlayer scriptInstantiationForSelector: oldSelector. anInstantiation ifNotNil: [ newSelector numArgs == 0 ifTrue: [anInstantiation changeSelectorTo: newSelector]. aDict := aPlayer costume actorState instantiatedUserScriptsDictionary. itsCostume := aPlayer costume renderedMorph. itsCostume renameScriptActionsFor: aPlayer from: oldSelector to: newSelector. self currentWorld renameScriptActionsFor: aPlayer from: oldSelector to: newSelector. aDict removeKey: oldSelector. newSelector numArgs == 0 ifTrue: [aDict at: newSelector put: anInstantiation. anInstantiation assureEventHandlerRepresentsStatus]]]] ifFalse: [newSelector numArgs == 0 ifTrue: [self class allInstancesDo: [:aPlayer | anInstantiation := aPlayer scriptInstantiationForSelector: newSelector. anInstantiation ifNotNil: [anInstantiation assureEventHandlerRepresentsStatus]]]]. aUserScript := self class userScriptForPlayer: self selector: oldSelector. aUserScript renameScript: newSelector fromPlayer: self. "updates all script editors, and inserts the new script in my scripts directory" self removeScriptNamed: oldSelector. ((self existingScriptInstantiationForSelector: newSelector) notNil and: [newSelector numArgs > 0]) ifTrue: [self error: 'ouch']. self updateScriptsCategoryOfViewers. + (self scriptEditorFor: newSelector) ifNotNil: - (self scriptEditorFor: newSelector) ifNotNilDo: [:e | e updateHeader]! Item was changed: ----- Method: Player>>revealPlayerIn: (in category 'misc') ----- revealPlayerIn: aWorld "Reveal the receiver if at all possible in the world; once it's visible, flash its image for a bit, and leave it with its halo showing" | aMorph | (aMorph := self costume) isInWorld ifTrue: [aMorph goHome. self indicateLocationOnScreen. + aMorph owner ifNotNil: [:ownr | ownr layoutPolicy ifNil: - aMorph owner ifNotNilDo: [:ownr | ownr layoutPolicy ifNil: [aMorph comeToFront]]. aMorph addHalo. ^ self]. "It's hidden somewhere; search for it" aWorld submorphs do: [:m | (m succeededInRevealing: self) ifTrue: "will have obtained halo already" [aWorld doOneCycle. self indicateLocationOnScreen. ^ self]]. "The morph is truly unreachable in this world at present. So extract it from hyperspace, and place it at center of screen, wearing a halo." aMorph isWorldMorph ifFalse: [aWorld addMorphFront: aMorph. aMorph position: aWorld bounds center. aMorph addHalo]! Item was changed: ----- Method: Player>>setXOnGraph: (in category '*Etoys-Squeakland-morphicExtras-Charts') ----- setXOnGraph: aNumber "Set the x-on-graph coordinate as indicated. If there is Horizontal Number Line in the same playfield, this is interpreted with reference to the position and scale of that number line; if not, this is no different from setX:" | aCostume | (aCostume := self costume) isInWorld ifFalse: [^ self setX: aNumber]. + (aCostume referencePlayfield findA: HorizontalNumberLineMorph) ifNotNil: - (aCostume referencePlayfield findA: HorizontalNumberLineMorph) ifNotNilDo: [:aNumberLine | ^ aNumberLine setXOnGraphFor: aCostume to: aNumber]. ^ self getX! Item was changed: ----- Method: Player>>setYOnGraph: (in category '*Etoys-Squeakland-morphicExtras-Charts') ----- setYOnGraph: aNumber "Set the y-on-graph coordinate as indicated. If there is Vertical Number Line in the same playfield, this is interpreted with reference to the position and scale of that number line; if not, this is no different from setY:" | aCostume | (aCostume := self costume) isInWorld ifFalse: [^ self setY: aNumber]. + (aCostume referencePlayfield findA: VerticalNumberLineMorph) ifNotNil: - (aCostume referencePlayfield findA: VerticalNumberLineMorph) ifNotNilDo: [:aNumberLine | ^ aNumberLine setYOnGraphFor: aCostume to: aNumber]. ^ self setY: aNumber! Item was changed: ----- Method: PopUpMenu>>startUpWithCaption:at:allowKeyboard:centered: (in category '*Etoys-Squeakland-basic control sequence') ----- startUpWithCaption: captionOrNil at: location allowKeyboard: allowKeyboard centered: centered "Display the menu, with caption if supplied. Wait for the mouse button to go down, then track the selection as long as the button is pressed. When the button is released, Answer the index of the current selection, or zero if the mouse is not released over any menu item. Location specifies the desired topLeft of the menu body rectangle. The final argument indicates whether the menu should seize the keyboard focus in order to allow the user to navigate it via the keyboard If centered is true, the menu items are displayed centered.." | maxHeight aMenu | + (ProvideAnswerNotification signal: captionOrNil) ifNotNil: - (ProvideAnswerNotification signal: captionOrNil) ifNotNilDo: [:answer | ^ selection := answer ifTrue: [1] ifFalse: [2]]. maxHeight := Display height*3//4. self frameHeight > maxHeight ifTrue: [^ self startUpSegmented: maxHeight withCaption: captionOrNil at: location allowKeyboard: allowKeyboard]. Smalltalk isMorphic ifTrue:[ selection := Cursor normal showWhile: [aMenu := MVCMenuMorph from: self title: captionOrNil. centered ifTrue: [aMenu submorphs allButFirst do: [:m | m setProperty: #centered toValue: true]]. aMenu invokeAt: location in: ActiveWorld allowKeyboard: allowKeyboard]. ^ selection]. frame ifNil: [self computeForm]. Cursor normal showWhile: [self displayAt: location withCaption: captionOrNil during: [self controlActivity]]. ^ selection! Item was changed: ----- Method: Preferences class>>persistValue:for: (in category '*Etoys-Squeakland-persistence') ----- persistValue: aBooleanOrNil for: aSymbol "Save the preference aSymbol on file, so it can be restored to the given value on startup. If nil, delete persistent value." | fileName file | fileName := self persistedFileNameFor: aSymbol. aBooleanOrNil ifNil: [ + ^ExternalSettings preferenceDirectory ifNotNil: [:fd | - ^ExternalSettings preferenceDirectory ifNotNilDo: [:fd | fd deleteFileNamed: fileName ifAbsent: []]]. file := ExternalSettings assuredPreferenceDirectory forceNewFileNamed: fileName. [file wantsLineEndConversion: true; nextPutAll: 'value: '; print: aBooleanOrNil; cr. ] ensure: [file close]! Item was changed: ----- Method: Project>>keepSugarProperties:monitor: (in category '*Etoys-Squeakland-sugar') ----- keepSugarProperties: aDictionary monitor: aBoolean | dontKeep props | aDictionary at: 'title' ifPresent: [:title | self name: title]. dontKeep := #('activity' 'activity_id' 'title' 'title_set_by_user' 'keep' 'mtime' 'timestamp' 'preview' 'icon-color' 'mime_type') asSet. props := Dictionary new: aDictionary size. aDictionary keysAndValuesDo: [:key :value | (dontKeep includes: key) ifFalse: [props at: key put: value]]. self sugarProperties: props. aBoolean ifTrue: [ + self sugarObjectId ifNotNil: [:id | - self sugarObjectId ifNotNilDo: [:id | SugarLauncher current monitorJournalEntry: id]].! Item was changed: ----- Method: ProjectLoading class>>loadFromImagePath: (in category '*etoys') ----- loadFromImagePath: projectName "Open the project in image path. This is used with projects in OLPC distribution. - The image's directory is used. - Squeaklets directory is ignored. - If there is a project named projectName, it is opened. " "self openFromImagePath: 'Welcome'" | directory aStream entries fileName | (Project named: projectName) + ifNotNil: [:project | ^ project]. - ifNotNilDo: [:project | ^ project]. directory := FileDirectory on: Smalltalk imagePath. entries := FileList2 projectOnlySelectionMethod: directory entries. fileName := (entries detect: [:each | (Project parseProjectFileName: each name) first = projectName] ifNone: [^ nil]) name. 'Loading a Project...' displaySequentialProgress: [ProgressNotification signal: '0'. directory := FileDirectory on: Smalltalk imagePath. aStream := directory readOnlyFileNamed: fileName. ^ self loadName: fileName stream: aStream fromDirectory: directory withProjectView: nil]! Item was changed: ----- Method: ProjectLoading class>>loadName:stream:fromDirectory:withProjectView:clearOriginFlag: (in category '*etoys') ----- loadName: aFileName stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView clearOriginFlag: clearOriginFlag "Reconstitute a Morph from the selected file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world." | morphOrList archive mgr substituteFont numberOfFontSubstitutes resultArray anObject project manifests dict | (self checkStream: preStream) ifTrue: [^ nil]. ProgressNotification signal: '0.2'. archive := preStream isZipArchive ifTrue:[ZipArchive new readFrom: preStream] ifFalse:[nil]. manifests := (archive membersMatching: '*manifest'). (manifests size = 1 and: [((dict := self parseManifest: manifests first contents) at: 'Project-Format' ifAbsent: []) = 'S-Expression']) ifTrue: [^ self loadSexpProjectDict: dict stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView]. morphOrList := self morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive. morphOrList ifNil: [^ nil]. ProgressNotification signal: '0.4'. resultArray := self fileInName: aFileName archive: archive morphOrList: morphOrList. anObject := resultArray first. numberOfFontSubstitutes := resultArray second. substituteFont := resultArray third. mgr := resultArray fourth. preStream close. ProgressNotification signal: '0.7'. "the hard part is over" (anObject isKindOf: ImageSegment) ifTrue: [ project := self loadImageSegment: anObject fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr. project noteManifestDetailsIn: dict. project removeParameter: #sugarProperties. Smalltalk at: #SugarPropertiesNotification ifPresent: [:notification | + notification signal ifNotNil: [:props | - notification signal ifNotNilDo: [:props | project keepSugarProperties: props monitor: true]]. clearOriginFlag ifTrue: [project forgetExistingURL]. ProgressNotification signal: '0.8'. ^ project ].! Item was changed: ----- Method: RecordingControls>>durationString (in category 'private') ----- durationString "Answer a string representing my duration." recorder ifNotNil: + [recorder recordedSound ifNotNil: - [recorder recordedSound ifNotNilDo: [:aSound | ^ 'Recorded sound duration: {1} second(s)' translated format: {(aSound duration printShowingDecimalPlaces: 2)}]]. ^ 'no sound recorded yet' translated! Item was changed: ----- Method: ScriptEditorMorph>>buttonRowForEditor (in category 'buttons') ----- buttonRowForEditor "Answer a row of buttons that comprise the header at the top of the Scriptor" | aRow aString aStatusMorph aButton aTile aMorph goldBoxButton aBox | aRow := AlignmentMorph newRow color: ScriptingSystem baseColor; layoutInset: 1. aRow hResizing: #spaceFill. aRow vResizing: #shrinkWrap. self addDismissButtonTo: aRow. aRow addTransparentSpacerOfSize: 9. "Player's name" aString := playerScripted externalName. aMorph := StringMorph contents: aString font: ScriptingSystem fontForTiles. aMorph setNameTo: 'title'. aRow addMorphBack: aMorph. aRow addTransparentSpacerOfSize: 6. "Script's name" aBox := AlignmentMorph newRow. aBox hResizing: #shrinkWrap; vResizing: #shrinkWrap. aBox color: (Color r: 0.839 g: 1.0 b: 0.806). aBox borderWidth: 1. aBox borderColor: (Color r: 0.645 g: 0.774 b: 0.613). aButton := UpdatingStringMorph new. aButton useStringFormat; target: self; getSelector: #scriptTitle; setNameTo: 'script name'; font: ScriptingSystem fontForNameEditingInScriptor; putSelector: #setScriptNameTo:; setProperty: #okToTextEdit toValue: true; step; yourself. aBox addMorph: aButton. aRow addMorphBack: aBox. aBox setBalloonText: 'Click here to edit the name of the script.' translated. "aRow addTransparentSpacerOfSize: 9." aRow addVariableTransparentSpacer. "Try It button" self hasParameter ifFalse: [aRow addMorphBack: ((ThreePhaseButtonMorph labelSymbol: #TryIt target: self actionSelector: #tryMe arguments: #()) actWhen: #whilePressed; balloonTextSelector: #tryMe). aRow addTransparentSpacerOfSize: 3]. "Step button, only for non-Kedama" (self playerScripted isPrototypeTurtlePlayer or: [self hasParameter]) ifFalse: [aRow addMorphBack: (aButton := ThreePhaseButtonMorph labelSymbol: #StepMe target: self actionSelector: #stepMe arguments: #()). aButton balloonTextSelector: #stepMe. aRow addTransparentSpacerOfSize: 3]. "Status controller" self hasParameter ifTrue: [aTile := TypeListTile new choices: Vocabulary typeChoicesForUserVariables dataType: nil. aTile addArrows. aTile setLiteral: self typeForParameter. aRow addMorphBack: aTile. aTile borderColor: Color red. aTile color: ScriptingSystem uniformTileInteriorColor. aTile setBalloonText: 'Drag from here to get a parameter tile' translated. aTile addCaretsAsAppropriate: true] ifFalse: [aRow addMorphBack: (aStatusMorph := self scriptInstantiation statusControlMorph)]. "aRow addTransparentSpacerOfSize: 3." aRow addVariableTransparentSpacer. "Gold-box" aRow addMorphBack: (goldBoxButton := IconicButton new). goldBoxButton borderWidth: 0; labelGraphic: (ScriptingSystem formAtKey: 'RoundGoldBox'); color: Color transparent; actWhen: #buttonDown; target: self; actionSelector: #offerGoldBoxMenu; shedSelvedge; setBalloonText: 'click here to get a palette of useful tiles to use in your script.' translated. aRow addTransparentSpacerOfSize: 6@1. "Menu Button" aButton := self menuButton. aButton actionSelector: #offerScriptorMenu. aRow addMorphBack: aButton. (playerScripted existingScriptInstantiationForSelector: scriptName) + ifNotNil: - ifNotNilDo: [:inst | inst updateStatusMorph: aStatusMorph]. ^ aRow! Item was changed: ----- Method: ScriptEncoder>>lookupInPools:ifFound: (in category 'private') ----- lookupInPools: varName ifFound: assocBlock referenceObject referencePool ifNotNil: [:pool | + (pool bindingOf: varName asSymbol) ifNotNil:[:assoc| - (pool bindingOf: varName asSymbol) ifNotNilDo:[:assoc| assocBlock value: assoc. ^ true]]. ^ super lookupInPools: varName ifFound: assocBlock. ! Item was changed: ----- Method: SugarLauncher class>>welcomeProjectName (in category 'accessing') ----- welcomeProjectName "Deprecated" + ^Project home ifNotNil: [:p | p name]! - ^Project home ifNotNilDo: [:p | p name]! Item was changed: ----- Method: SugarLauncher>>active: (in category 'commands') ----- active: aBoolean "Etoys activity received or lost focus" Preferences setPreference: #soundsEnabled toValue: aBoolean. aBoolean ifTrue: [ + UISema ifNotNil: [:s | s signal]. - UISema ifNotNilDo: [:s | s signal]. ] ifFalse: [ SoundPlayer shutDown. SoundRecorder anyActive ifTrue: [SoundRecorder allSubInstancesDo: [:r | r stopRecording]]. Smalltalk at: #VideoDevice ifPresent: [:vd | vd shutDown: true]. UISema ifNil: [UISema := Semaphore new]. UISema initSignals. WorldState addDeferredUIMessage: [UISema wait]. ].! 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]. - ifNotNilDo: [:bar | bar startUp]. parameters at: 'ACTIVITY_ID' ifPresent: [ :activityId | OLPCVirtualScreen setupIfNeeded. 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>>welcome: (in category 'commands') ----- welcome: aUrl "Sent either when running from Sugar, or at regular startUp otherwise" aUrl isEmpty ifFalse: [ | url | url := (aUrl includes: $/) ifTrue: [aUrl] ifFalse: ['file:', (parameters at: 'BUNDLE_PATH'), '/', aUrl]. ^(url endsWith: '.pr') ifTrue: [Project fromUrl: url] ifFalse: [WorldState addDeferredUIMessage: [FileStream fileIn: (url copyAfter: $:)]]]. + self shouldEnterHomeProject ifTrue: [Project home ifNotNil: [:p | p enter]].! - self shouldEnterHomeProject ifTrue: [Project home ifNotNilDo: [:p | p enter]].! Item was changed: ----- Method: SugarNavigatorBar class>>configureCurrentForSqueakland (in category 'utilitity') ----- configureCurrentForSqueakland + SugarNavigatorBar current ifNotNil: [:bar | bar configureForSqueakland]. - SugarNavigatorBar current ifNotNilDo: [:bar | bar configureForSqueakland]. ! Item was changed: ----- Method: SugarNavigatorBar class>>rebuildButtons (in category 'utilitity') ----- rebuildButtons + self current ifNotNil: [:bar | bar rebuildButtons]! - self current ifNotNilDo: [:bar | bar rebuildButtons]! Item was changed: ----- Method: SugarNavigatorBar>>chooseScreenSetting (in category 'buttons creation') ----- chooseScreenSetting "Put up a menu allowing the user to choose between virtual-olpc-display mode and normal-display mode." | aMenu availableModes | aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'display mode' translated. Preferences noviceMode ifFalse: [aMenu addStayUpItem]. availableModes := self availableDisplayModes. availableModes do: [:mode | aMenu addUpdating: #stringForDisplayModeIs: target: self selector: #toggleScreenSetting: argumentList: {mode}. + (self balloonTextForMode: mode) ifNotNil: - (self balloonTextForMode: mode) ifNotNilDo: [:help | aMenu balloonTextForLastItem: help translated]]. aMenu addLine. aMenu addUpdating: #stringForFullScreenToggle target: self action: #toggleFullScreen. aMenu popUpInWorld "(Flaps globalFlapTabWithID: 'Sugar Navigator Flap' translated) referent chooseScreenSetting"! Item was changed: ----- Method: SugarNavigatorBar>>previousProject (in category 'the actions') ----- previousProject Preferences eToyFriendly ifTrue: [ | prev | prev := Project current previousProject. (prev isNil or: [prev isTopProject]) ifTrue: [ + Project home ifNotNil: [:p | Project current setParent: p]]]. - Project home ifNotNilDo: [:p | Project current setParent: p]]]. super previousProject! 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: - (submorphs first submorphs detect: [:e | e isButton and: [e actionSelector = aQuad first]] ifNone: [nil]) ifNotNilDo: [:aButton | b1 := BalloonMorph string: aQuad second for: aButton corner: aQuad third force: aQuad fourth. p addMorph: b1]]. 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>>setEdge: (in category 'event handling') ----- setEdge: aSymbol "Establish the given edge to which to cling." + (Flaps globalFlapTab: 'Supplies' translated) ifNotNil: - (Flaps globalFlapTab: 'Supplies' translated) ifNotNilDo: [:s | s setEdge: aSymbol]! Item was changed: ----- Method: SystemDictionary>>logError:inContext:to: (in category '*Etoys-Squeakland-miscellaneous') ----- logError: errMsg inContext: aContext to: aFilename "Log the error message and a stack trace to the given file." | ff | [Preferences logDebuggerStackToConsole + ifTrue: [FileStream stderr ifNotNil: [:stderr | - ifTrue: [FileStream stderr ifNotNilDo: [:stderr | stderr nextPutAll: '=========== '; nextPutAll: aFilename; nextPutAll: ' START =========='; cr; nextPutAll: errMsg; cr; nextPutAll: (String streamContents: [:strm | aContext errorReportOn: strm]); nextPutAll: '=========== '; nextPutAll: aFilename; nextPutAll: ' END =========='; cr]]] ifError: ["ignore"]. FileDirectory default deleteFileNamed: aFilename ifAbsent: []. (ff := FileStream fileNamed: aFilename) ifNil: [^ self "avoid recursive errors"]. ff nextPutAll: errMsg; cr. aContext errorReportOn: ff. ff close. ! Item was changed: ----- Method: TheWorldMenu class>>registerStandardInternetApps (in category '*Etoys-Squeakland-open-menu registry') ----- registerStandardInternetApps "Register the three currently-built-in internet apps and the hook for SqueakMap with the open-menu registry. This is a one-time initialization affair, contending with the fact that the three apps are already in the image." self registerOpenCommand: { 'Package Loader' translated. { TheWorldMenu . #openPackageLoader }. 'A tool that lets you browse and load packages from SqueakMap, an index of Squeak code available on the internet' translated}. #(Scamper Celeste IRCConnection) do: [:sym | + (Smalltalk at: sym ifAbsent: [nil]) ifNotNil: - (Smalltalk at: sym ifAbsent: [nil]) ifNotNilDo: [:aClass | aClass registerInOpenMenu]] " OpenMenuRegistry := nil. TheWorldMenu registerStandardInternetApps. "! Item was changed: ----- Method: TileMorph>>acceptNewLiteral (in category 'code generation') ----- acceptNewLiteral "Tell the scriptEditor who I belong to that I have a new literal value." | topScript | topScript := self outermostMorphThat: [:m | m isKindOf: ScriptEditorMorph]. topScript ifNotNil: [topScript installWithNewLiteral]. + (self ownerThatIsA: ViewerLine) ifNotNil: - (self ownerThatIsA: ViewerLine) ifNotNilDo: [:aLine | (self ownerThatIsA: PhraseTileMorph) ifNotNil: [aLine removeHighlightFeedback. self layoutChanged. ActiveWorld doOneSubCycle. aLine addCommandFeedback: nil]]! Item was changed: ----- Method: TileMorph>>arrowAction: (in category 'arrows') ----- arrowAction: delta "Do what is appropriate when an arrow on the tile is pressed; delta will be +1 or -1" | index options | (type == #literal and: [literal isNumber]) ifTrue: [self value: (((literal + delta) printShowingDecimalPlaces: self decimalPlaces) asNumber)] ifFalse: [options := self options ifNil: [^ self]. index := (options first indexOf: self value) + delta. self value: (options first atWrap: index). + (options second atWrap: index) ifNotNil: - (options second atWrap: index) ifNotNilDo: [:bt | submorphs last setBalloonText: bt translated]]! Item was changed: ----- Method: TileMorph>>setDecimalPlacesFromTypeIn: (in category '*Etoys-Squeakland-misc') ----- setDecimalPlacesFromTypeIn: aString + self labelMorph ifNotNil: [:m | - self labelMorph ifNotNilDo: [:m | m setDecimalPlacesFromTypeIn: aString]! Item was changed: ----- Method: TileMorph>>setVisibilityOfUpDownCarets: (in category '*Etoys-Squeakland-arrows') ----- setVisibilityOfUpDownCarets: showCarets "If the argument is true, make all the 'up and down' carets, such as those that let you change the value of a number or of a boolean constant, visible; if false, remove them from sight. " + (submorphs detect: [:m | m hasProperty: #arrows] ifNone: [nil]) ifNotNil: - (submorphs detect: [:m | m hasProperty: #arrows] ifNone: [nil]) ifNotNilDo: [:wrapper | showCarets ifTrue: [wrapper width: 9] ifFalse: [wrapper width: 0]]! Item was changed: ----- Method: TileMorph>>updateWordingToMatchVocabulary (in category 'initialization') ----- updateWordingToMatchVocabulary "The current vocabulary has changed; change the wording on my face, if appropriate" | aMethodInterface | type == #operator ifTrue: [self line1: (self currentVocabulary tileWordingForSelector: operatorOrExpression). (ScriptingSystem doesOperatorWantArrows: operatorOrExpression) ifTrue: [self addArrows]. self updateLiteralLabel. aMethodInterface := self currentVocabulary methodInterfaceAt: operatorOrExpression ifAbsent: [ Vocabulary eToyVocabulary methodInterfaceAt: operatorOrExpression ifAbsent: [^ self]]. self setBalloonText: aMethodInterface documentation. ]. type == #objRef ifTrue: [ self isPossessive ifTrue: [self bePossessive] ifFalse: [ + self labelMorph ifNotNil: [:label | - self labelMorph ifNotNilDo: [:label | label contents: self actualObject nameForViewer asSymbol translated] ] ]. "submorphs last setBalloonText: aMethodInterface documentation"! Item was changed: ----- Method: Utilities class>>versionNumberAndDateFromConfig: (in category '*Etoys-Squeakland-fetching updates') ----- versionNumberAndDateFromConfig: anMCConfiguration "Answer the latest date found in anMCConfiguration (or the associated working copy), and the sum of its version numbers." | versionNumbers versionDates | versionNumbers := anMCConfiguration dependencies collect: [:d | (d versionInfo name copyAfterLast: $.) asInteger]. versionDates := anMCConfiguration dependencies collect: [:d | d versionInfo date ifNil: [((d package workingCopy ancestry findAncestor: d versionInfo) + ifNotNil: [:v | v date]) - ifNotNilDo: [:v | v date]) ifNil: [Date fromDays: 0]]]. ^{versionNumbers sum. versionDates max}. ! Item was changed: ----- Method: WatcherWrapper>>reconstituteName (in category 'updating') ----- reconstituteName "Reconstitute the external name of the receiver" variableName ifNotNil: [self setNameTo: ('{1}''s {2}' translated format: {player externalName. variableName translated}). + (self submorphWithProperty: #watcherLabel) ifNotNil: - (self submorphWithProperty: #watcherLabel) ifNotNilDo: [:aLabel | aLabel contents: variableName asString translated, ' = ']]! Item was changed: ----- Method: Worldlet>>closeNavigatorFlap (in category 'flaps') ----- closeNavigatorFlap "Close the navigator flap" (self submorphs detect: [:m | (m isKindOf: FlapTab) and: [m flapID = 'Navigator']] ifNone: [nil]) + ifNotNil: - ifNotNilDo: [:nav | nav hideFlap]!

1 0

The Inbox: Multilingual-monty.226.mcz
by commits＠source.squeak.org 09 Jun '17

09 Jun '17

A new version of Multilingual was added to project The Inbox: http://source.squeak.org/inbox/Multilingual-monty.226.mcz ==================== Summary ==================== Name: Multilingual-monty.226 Author: monty Time: 9 June 2017, 1:40:37.860457 am UUID: 9f778323-2b0b-416b-8e3a-1d512fdadf83 Ancestors: Multilingual-pre.225 Updated for Files-monty.172 by removing MultiByteFileStream>>#open:forWrite: and moving its post-open initialization code to #opened:forWrite: =============== Diff against Multilingual-pre.225 =============== Item was removed: - ----- Method: MultiByteFileStream>>open:forWrite: (in category 'open/close') ----- - open: fileName forWrite: writeMode - | result | - result := super open: fileName forWrite: writeMode. - result ifNotNil: [ - converter ifNil: [self converter: UTF8TextConverter new]. - lineEndConvention ifNil: [ self detectLineEndConvention ] - ]. - ^result! Item was added: + ----- Method: MultiByteFileStream>>opened:forWrite: (in category 'private') ----- + opened: fileName forWrite: writeMode + super opened: fileName forWrite: writeMode. + converter + ifNil: [self converter: UTF8TextConverter new]. + lineEndConvention + ifNil: [self detectLineEndConvention]!

1 0

The Inbox: 51Deprecated-monty.48.mcz
by commits＠source.squeak.org 09 Jun '17

09 Jun '17

A new version of 51Deprecated was added to project The Inbox: http://source.squeak.org/inbox/51Deprecated-monty.48.mcz ==================== Summary ==================== Name: 51Deprecated-monty.48 Author: monty Time: 9 June 2017, 1:36:27.362829 am UUID: a7dc5474-dda7-40ca-8b71-13b997a0f14c Ancestors: 51Deprecated-mt.47 Updated for Files-monty.172 by removing CrLfFileStream>>#open:forWrite: and moving its post-open initialization code to #opened:forWrite: =============== Diff against 51Deprecated-mt.47 =============== Item was removed: - ----- Method: CrLfFileStream>>open:forWrite: (in category 'open/close') ----- - open: aFileName forWrite: writeMode - "Open the receiver. If writeMode is true, allow write, else access will be - read-only. " - | result | - result := super open: aFileName forWrite: writeMode. - result ifNotNil: [self detectLineEndConvention]. - ^ result! Item was added: + ----- Method: CrLfFileStream>>opened:forWrite: (in category 'private') ----- + opened: aFileName forWrite: writeMode + super opened: aFileName forWrite: writeMode. + self detectLineEndConvention!

1 0

The Inbox: Files-monty.172.mcz
by commits＠source.squeak.org 09 Jun '17

09 Jun '17

A new version of Files was added to project The Inbox: http://source.squeak.org/inbox/Files-monty.172.mcz ==================== Summary ==================== Name: Files-monty.172 Author: monty Time: 9 June 2017, 1:32:52.379576 am UUID: 13aeeea1-d30e-4948-b1fb-a2b126694e13 Ancestors: Files-eem.171 Requires a VM built with CogVM sources of at least per VMMaker.oscog-eem.2237: Added #primOpenNew: and a corresponding #openNew: to StandardFileStream, and changed #newFileNamed: to use it. Moved the post-open initialization code from #open:forWrite: to the new #opened:forWrite:, which is also used by #openNew: and is meant to be overridden instead of #open:forWrite: in subclasses like MultiByteFileStream and CrLfFileStream. Fixed #primFlush: to not simlulate a flush after a failure, because fflush() can fail for the same reasons write() can, so its failure can't be ignored. Made #sync just invoke its primitive instead of also sending #flush, to keep the two operations distinct like their primitives and to be consistent with Pharo. Replaced #retryWithGC:until:forFileNamed: with a simpler two-argument version that retries when the first block evaluates to nil, since all senders of the three arugment version test for that condition anyway. Changed FileDirectory #deleteFileNamed:ifAbsent: and #rename:toBe: to not use #retryWithGC:... because their primitives don't need new file descriptors that could be freed by a GC. =============== Diff against Files-eem.171 =============== Item was changed: ----- Method: FileDirectory>>deleteFileNamed:ifAbsent: (in category 'file operations') ----- deleteFileNamed: localFileName ifAbsent: failBlock + "Delete the file of the given name if it exists, else evaluate failBlock." - "Delete the file of the given name if it exists, else evaluate failBlock. - If the first deletion attempt fails do a GC to force finalization of any lost references. ar 3/21/98 17:53" | fullName | fullName := self fullNameFor: localFileName. + "no #retryWithGC:... here because the delete primitive doesn't need + new file descriptors that could be freed by a GC" + (self primDeleteFileNamed: (self fullNameFor: localFileName) asVmPathName) + ifNil: [^ failBlock value]. - (StandardFileStream - retryWithGC:[self primDeleteFileNamed: (self fullNameFor: localFileName) asVmPathName] - until:[:result| result notNil] - forFileNamed: fullName) == nil - ifTrue: [^failBlock value]. ! Item was changed: ----- Method: FileDirectory>>rename:toBe: (in category 'file operations') ----- rename: oldFileName toBe: newFileName "Rename the file of the given name to the new name. Fail if there is no file of the old name or if there is an existing file with the new name." - "Modified for retry after GC ar 3/21/98 18:09" | replaceIt oldName newName | oldName := self fullNameFor: oldFileName. newName := self fullNameFor: newFileName. ((self fileExists: oldFileName) or: [ (self directoryExists: oldFileName) ]) ifFalse: [ ^ self error: 'Attempt to rename a non-existent file or directory.' ]. (self fileExists: newFileName) ifTrue: [replaceIt := (ReplaceExistingFileException fileName: newFileName) signal. replaceIt ifTrue: [ self deleteFileNamed: newFileName ] ifFalse: [ ^ self ]]. (self directoryExists: newFileName) ifTrue: [ FileExistsException signal: newFileName, ' already exists.' ]. + "no #retryWithGC:... here because the rename primitive doesn't need + new file descriptors that could be freed by a GC" + (self + primRename: oldName asVmPathName + to: newName asVmPathName) + ifNil: [^ self error: 'Failed to rename file']! - (StandardFileStream - retryWithGC: - [ self - primRename: oldName asVmPathName - to: newName asVmPathName ] - until: [ : result | result notNil ] - forFileNamed: oldName) ~~ nil ifTrue: [ ^ self ]. - ^ self error: 'Failed to rename file'! Item was changed: ----- Method: StandardFileStream class>>newFileNamed: (in category 'file creation') ----- + newFileNamed: fileName + "Create a new file with the given name, and answer a stream opened + for writing on that file. If the file already exists, ask the user what to + do. " + ^ self new openNew: (self fullName: fileName)! - newFileNamed: fileName - "Create a new file with the given name, and answer a stream opened for writing on that file. If the file already exists, ask the user what to do." - - | fullName | - fullName := self fullName: fileName. - - ^(self isAFileNamed: fullName) - ifTrue: ["file already exists:" - (FileExistsException fileName: fullName fileClass: self) signal] - ifFalse: [self new open: fullName forWrite: true] - - ! Item was removed: - ----- Method: StandardFileStream class>>retryWithGC:until:forFileNamed: (in category 'registry') ----- - retryWithGC: execBlock until: testBlock forFileNamed: fullName - "Re-implemented to only force GC if a file with the given name exists" - | blockValue foundIt | - blockValue := execBlock value. - (testBlock value: blockValue) ifTrue:[^blockValue]. - "See if we have a file with the given name" - foundIt := Registry keys "hold on strongly for now" - anySatisfy:[:file| file name sameAs: fullName]. - foundIt ifFalse:[^blockValue]. - Smalltalk garbageCollectMost. - blockValue := execBlock value. - (testBlock value: blockValue) ifTrue:[^blockValue]. - Smalltalk garbageCollect. - ^execBlock value.! Item was added: + ----- Method: StandardFileStream class>>retryWithGC:whileNilForFileNamed: (in category 'registry') ----- + retryWithGC: execBlock whileNilForFileNamed: fullName + "Re-implemented to only force GC if a file with the given name exists" + | foundIt | + execBlock value + ifNotNil: [:result | ^ result]. + "See if we have a file with the given name" + foundIt := Registry keys + anySatisfy: [:file | "hold on strongly for now" + file name sameAs: fullName]. + foundIt + ifFalse: [^ nil]. + Smalltalk garbageCollectMost. + execBlock value + ifNotNil: [:result | ^ result]. + Smalltalk garbageCollect. + ^ execBlock value! Item was changed: ----- Method: StandardFileStream>>flush (in category 'read, write, position') ----- flush + "When writing, this flushes the write buffer the stream uses to reduce + the number of write() system calls it makes. This should generally be + used before #sync, but on Windows they do the same thing." + + ^ self primFlush: fileID! - "Flush pending changes" - ^self primFlush: fileID! Item was changed: ----- Method: StandardFileStream>>open:forWrite: (in category 'open/close') ----- open: fileName forWrite: writeMode + "Open the file with the given name. If writeMode is true, allow writing, + otherwise open the file in read-only mode." - "Open the file with the given name. If writeMode is true, allow writing, otherwise open the file in read-only mode." "Changed to do a GC and retry before failing ar 3/21/98 17:25" | f | f := fileName asVmPathName. + fileID := self class + retryWithGC: [self primOpen: f writable: writeMode] + whileNilForFileNamed: fileName. + "nil return allows sender to detect failure" + ^ fileID + ifNotNil: [self opened: fileName forWrite: writeMode]! - - fileID := StandardFileStream retryWithGC:[self primOpen: f writable: writeMode] - until:[:id| id notNil] - forFileNamed: fileName. - fileID ifNil: [^ nil]. "allows sender to detect failure" - name := fileName. - self register. - rwmode := writeMode. - buffer1 := String new: 1. - self enableReadBuffering - ! Item was added: + ----- Method: StandardFileStream>>openNew: (in category 'open/close') ----- + openNew: fileName + "Open the new file with the given name for writing. + Raises a FileAlreadyException if the file already exists, and returns nil + for all other errors." + | f | + f := fileName asVmPathName. + "the FileExistsException isn't caught here or in + #retryWithGC:whileNilForFileNamed:, because if the file exists, GC'ing + unreferenced file streams won't delete it" + fileID := self class + retryWithGC: [self primOpenNew: f] + whileNilForFileNamed: fileName. + "nil return allows sender to detect failure" + ^ fileID + ifNotNil: [self opened: fileName forWrite: true]! Item was added: + ----- Method: StandardFileStream>>opened:forWrite: (in category 'private') ----- + opened: fileName forWrite: writeMode + name := fileName. + self register. + rwmode := writeMode. + buffer1 := String new: 1. + self enableReadBuffering! Item was changed: ----- Method: StandardFileStream>>primFlush: (in category 'primitives') ----- primFlush: id + "On Unix, the FilePlugin uses stdio FILE* structs which maintain their + own internal buffer to minimize write() syscalls. This flushes that buffer. + On Windows this and primSync: do the same thing." + - "Flush pending changes to the disk" - | p | <primitive: 'primitiveFileFlush' module: 'FilePlugin'> + + "We can't ignore fflush() failing, because it can fail for any of the + reasons write() can." + self primitiveFailed! - "In some OS's seeking to 0 and back will do a flush" - p := self position. - self position: 0; position: p! Item was added: + ----- Method: StandardFileStream>>primOpenNew: (in category 'primitives') ----- + primOpenNew: fileName + "Open a new file of the given name for writing and return the file ID + obtained. + If the file already exists, raise a FileExistsException. + For other errors, return nil." + <primitive: 'primitiveFileOpenNew' module: 'FilePlugin' error: errorCode> + errorCode == #'inappropriate operation' + ifTrue: [(FileExistsException fileName: fileName fileClass: self class) signal]. + ^ nil! Item was changed: ----- Method: StandardFileStream>>primSync: (in category 'primitives') ----- primSync: id + "On Unix, this syncs any written or flushed data still in the kernel file + system buffers to disk. On Windows this and primFlush: do the same thing" + - "Call fsync to really, really, flush pending changes to the disk" - | p | <primitive: 'primitiveFileSync' module: 'FilePlugin'> + + "fsync() failing cannot be ignored" + self primitiveFailed! - "In some OS's seeking to 0 and back will do a flush. Maybe that will help if we dont have the primitives" - p := self position. - self position: 0; position: p! Item was changed: ----- Method: StandardFileStream>>sync (in category 'read, write, position') ----- sync + "When writing, this syncs any written/flushed data still in the kernel + file system buffers to disk. This should generally be used after #flush, + but on Windows they do the same thing." + + ^ self primSync: fileID! - "Really, really, flush pending changes" - ^self flush; primSync: fileID!

1 0

MD5 is broken (Cryptography)
by casimiro barreto 08 Jun '17

08 Jun '17

MD5 (non primitive and with primitive) is broken because it relies on the conversion of Character to SmallInteger so the method shiftBits: Problem happens at ThirthyTwoBitRegister>>reverseLoadFrom:at: which is called from MD5NonPrimitive>>proccessBuffer: Error is: Instance of Character did not understand #bitShift and happened at: reverseLoadFrom: aByteArray at: index "Load my 32-bit value from the four bytes of the given ByteArray starting at the given index. Consider the first byte to contain the most significant bits of the word (i.e., use big-endian byte ordering)." hi := ((aByteArray at: index + 3) bitShift: 8) + ( aByteArray at: index + 2). low := ((aByteArray at: index + 1) bitShift: 8) + ( aByteArray at: index). -- The information contained in this message is confidential and intended to the recipients specified in the headers. If you received this message by error, notify the sender immediately. The unauthorized use, disclosure, copy or alteration of this message are strictly forbidden and subjected to civil and criminal sanctions.

3 6

The Trunk: ToolsTests-eem.80.mcz
by commits＠source.squeak.org 08 Jun '17

08 Jun '17

Eliot Miranda uploaded a new version of ToolsTests to project The Trunk: http://source.squeak.org/trunk/ToolsTests-eem.80.mcz ==================== Summary ==================== Name: ToolsTests-eem.80 Author: eem Time: 8 June 2017, 12:04:04.601222 pm UUID: 2f5c7a5c-ec42-4949-9969-99931316d84e Ancestors: ToolsTests-jr.79 Fix a speeling rorre in a selector =============== Diff against ToolsTests-jr.79 =============== Item was removed: - ----- Method: BrowseTest>>testBrowseHierarchyMataclass (in category 'testing') ----- - testBrowseHierarchyMataclass - "self debug: #testBrowseHierarchyMataclass" - | browsersBefore browsersAfter opened | - self ensureMorphic. - - browsersBefore := self currentHierarchyBrowsers. - self withImmediatelyOpeningWindowsDo: [1 class class browseHierarchy]. - browsersAfter := self currentHierarchyBrowsers. - - self assert: (browsersAfter size = (browsersBefore size + 1)). - opened := browsersAfter removeAll: browsersBefore; yourself. - self assert: (opened size = 1). - opened := opened asArray first. - self assert: (opened model selectedClass == Metaclass). - - opened delete - - - ! Item was added: + ----- Method: BrowseTest>>testBrowseHierarchyMetaclass (in category 'testing') ----- + testBrowseHierarchyMetaclass + "self debug: #testBrowseHierarchyMetaclass" + | browsersBefore browsersAfter opened | + self ensureMorphic. + + browsersBefore := self currentHierarchyBrowsers. + self withImmediatelyOpeningWindowsDo: [1 class class browseHierarchy]. + browsersAfter := self currentHierarchyBrowsers. + + self assert: (browsersAfter size = (browsersBefore size + 1)). + opened := browsersAfter removeAll: browsersBefore; yourself. + self assert: (opened size = 1). + opened := opened asArray first. + self assert: (opened model selectedClass == Metaclass). + + opened delete + + + !

1 0

The Trunk: Tools-eem.762.mcz
by commits＠source.squeak.org 08 Jun '17

08 Jun '17

Eliot Miranda uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-eem.762.mcz ==================== Summary ==================== Name: Tools-eem.762 Author: eem Time: 8 June 2017, 12:03:05.548717 pm UUID: 8fbc1072-9aae-4c6e-bcc6-2c3f2f7c3207 Ancestors: Tools-pre.761 Tools fixes (some harvested from Terf). When creating a subclass template in a brtowser mark the text as changed so it doesn't get lost. Use isCompiledCode in PointerFinder code. Use instVarNameForIndex: instaed of longer winded code, also in PointerFinder. =============== Diff against Tools-pre.761 =============== Item was changed: ----- Method: Browser>>makeNewSubclass (in category 'class functions') ----- makeNewSubclass self selectedClassOrMetaClass ifNil: [^ self]. self okToChange ifFalse: [^ self]. self editSelection: #newClass. + self contentsChanged. + "Force the text view to assume there are changes" + self changed: #editString with: self contents! - self contentsChanged! Item was changed: ----- Method: Object>>shouldFollowOutboundPointers (in category '*Tools-Debugger') ----- shouldFollowOutboundPointers "Allow other subclasses of ProtoObject to hook this method." + (self class isPointers or: [ self isCompiledCode ]) ifFalse: [ ^ false ]. - (self class isPointers or: [ self isCompiledMethod ]) ifFalse: [ ^ false ]. ^ (self class isWeak not or: [ self class instSize > 0 ]) and: [ self isLiteral not ]! Item was changed: ----- Method: PointerFinder>>buildList (in category 'application') ----- buildList | list obj parent object key | list := OrderedCollection new. obj := goal. [list addFirst: obj. obj := parents at: obj ifAbsent: []. obj == nil] whileFalse. list removeFirst. parent := Smalltalk. objectList := OrderedCollection new. pointerList := OrderedCollection new. [list isEmpty] whileFalse: [object := list removeFirst. key := nil. (parent isKindOf: Dictionary) ifTrue: [list size >= 2 ifTrue: [key := parent keyAtValue: list second ifAbsent: []. key == nil ifFalse: [object := list removeFirst; removeFirst. pointerList add: key printString , ' -> ' , object class name]]]. key == nil ifTrue: [parent class == object ifTrue: [key := 'CLASS']. key == nil ifTrue: [1 to: parent class instSize do: [:i | key == nil ifTrue: [(parent instVarAt: i) + == object ifTrue: [key := parent class instVarNameForIndex: i]]]]. + key == nil ifTrue: [parent isCompiledCode ifTrue: [key := 'literals?']]. - == object ifTrue: [key := parent class allInstVarNames at: i]]]]. - key == nil ifTrue: [parent isCompiledMethod ifTrue: [key := 'literals?']]. key == nil ifTrue: [1 to: parent basicSize do: [:i | key == nil ifTrue: [(parent basicAt: i) == object ifTrue: [key := i printString]]]]. key == nil ifTrue: [(parent isMorph and: [object isKindOf: Array]) ifTrue: [key := 'submorphs?']]. key == nil ifTrue: [key := '???']. pointerList add: key , ': ' , object class name, (object isMorph ifTrue: [' (', object identityHash asString, ')'] ifFalse: [ String empty ]) ]. objectList add: object. parent := object]!

1 0

The Trunk: Multilingual-pre.228.mcz
by commits＠source.squeak.org 08 Jun '17

08 Jun '17

Patrick Rein uploaded a new version of Multilingual to project The Trunk: http://source.squeak.org/trunk/Multilingual-pre.228.mcz ==================== Summary ==================== Name: Multilingual-pre.228 Author: pre Time: 8 June 2017, 9:40:08.341697 am UUID: cb64d235-8b3f-a140-b34f-4695b78dd94e Ancestors: Multilingual-pre.227 Adds a UTF32 TextConverter. Updates the comments of some of the TextConverter. Updates the encoding names of utf16. =============== Diff against Multilingual-pre.227 =============== Item was changed: ISO8859TextConverter subclass: #ISO88592TextConverter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-TextConversion'! + + !ISO88592TextConverter commentStamp: '<historical>' prior: 0! + Text converter for ISO 8859-2. An international encoding used in Eastern Europe.! Item was changed: ISO8859TextConverter subclass: #ISO88597TextConverter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-TextConversion'! + + !ISO88597TextConverter commentStamp: '<historical>' prior: 0! + Text converter for ISO 8859-7. An international encoding used for Greek.! Item was changed: ISO88591TextConverter subclass: #Latin1TextConverter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-TextConversion'! + + !Latin1TextConverter commentStamp: '<historical>' prior: 0! + Text converter for ISO 8859-1. An international encoding used in Western Europe.! Item was changed: ISO885915TextConverter subclass: #Latin9TextConverter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-TextConversion'! + + !Latin9TextConverter commentStamp: 'pre 4/21/2017 11:40' prior: 0! + Text converter for ISO 8859-15. An international encoding also used in Western Europe.! Item was changed: ----- Method: UTF16TextConverter class>>encodingNames (in category 'utilities') ----- encodingNames + ^ #('utf-16' 'utf16' 'utf-16-le' 'utf-16-be' 'utf-16be' 'utf-16le') copy. - ^ #('utf-16' 'utf16' 'utf-16-le' 'utf-16-be') copy. ! Item was added: + TextConverter subclass: #UTF32TextConverter + instanceVariableNames: 'useLittleEndian useByteOrderMark byteOrderMarkDone' + classVariableNames: '' + poolDictionaries: '' + category: 'Multilingual-TextConversion'! + + !UTF32TextConverter commentStamp: 'pre 6/7/2017 17:55' prior: 0! + Text converter for UTF-32. It supports the endianness and byte order mark.! Item was added: + ----- Method: UTF32TextConverter class>>encodingNames (in category 'utilities') ----- + encodingNames + + ^ #( 'utf32' 'utf32be' 'utf32le' 'utf-32' 'utf-32be' 'utf-32le' 'ucs4' 'ucs4be' 'ucs4le') copy + ! Item was added: + ----- Method: UTF32TextConverter class>>initializeLatin1MapAndEncodings (in category 'utilities') ----- + initializeLatin1MapAndEncodings + "Initialize the latin1Map and latin1Encodings. + These variables ensure that conversions from latin1 ByteString is reasonably fast" + + latin1Map := (ByteArray new: 256) atAllPut: 1. + latin1Encodings := (0 to: 255) collect: [:i | (ByteArray newFrom: {0 . 0 . 0 . i}) asString]! Item was added: + ----- Method: UTF32TextConverter>>initialize (in category 'initialize-release') ----- + initialize + + super initialize. + useLittleEndian := useByteOrderMark := byteOrderMarkDone := false! Item was added: + ----- Method: UTF32TextConverter>>next16BitValue:toStream: (in category 'private') ----- + next16BitValue: value toStream: aStream + + | v1 v2 | + v1 := (value bitShift: -8) bitAnd: 16rFF. + v2 := value bitAnd: 16rFF. + useLittleEndian + ifTrue: [ + aStream + basicNextPut: (Character value: v2); + basicNextPut: (Character value: v1) ] + ifFalse: [ + aStream + basicNextPut: (Character value: v1); + basicNextPut: (Character value: v2) ]. + ! Item was added: + ----- Method: UTF32TextConverter>>next32BitValue:toStream: (in category 'private') ----- + next32BitValue: value toStream: aStream + + | v1 v2 v3 v4 | + v1 := (value bitShift: -24) bitAnd: 16rFF. + v2 := (value bitShift: -16) bitAnd: 16rFF. + v3 := (value bitShift: -8) bitAnd: 16rFF. + v4 := (value bitShift: 0) bitAnd: 16rFF. + useLittleEndian + ifTrue: [ + aStream + basicNextPut: (Character value: v4); + basicNextPut: (Character value: v3); + basicNextPut: (Character value: v2); + basicNextPut: (Character value: v1) ] + ifFalse: [ + aStream + basicNextPut: (Character value: v1); + basicNextPut: (Character value: v2); + basicNextPut: (Character value: v3); + basicNextPut: (Character value: v4) ]. + ! Item was added: + ----- Method: UTF32TextConverter>>nextFromStream: (in category 'conversion') ----- + nextFromStream: aStream + + | character1 character2 readBOM charValue character3 character4 | + aStream isBinary ifTrue: [ ^aStream basicNext ]. + character1 := aStream basicNext ifNil: [ ^nil ]. + character2 := aStream basicNext ifNil: [ ^nil ]. + character3 := aStream basicNext ifNil: [ ^nil ]. + character4 := aStream basicNext ifNil: [ ^nil ]. + + readBOM := false. + (character1 asciiValue = 16rFF and: [character2 asciiValue = 16rFE]) ifTrue: [ + self + useByteOrderMark: true; + useLittleEndian: true. + readBOM := true ]. + + ((character1 asciiValue = 0 and: [character2 asciiValue = 0]) + and: [character3 asciiValue = 16rFE and: [character4 asciiValue = 16rFF]]) ifTrue: [ + self + useByteOrderMark: true; + useLittleEndian: false. + readBOM := true ]. + + readBOM ifTrue: [ + "Re-initialize character variables if they contain BOM" + character1 := aStream basicNext ifNil: [ ^nil ]. + character2 := aStream basicNext ifNil: [ ^nil ]. + character3 := aStream basicNext ifNil: [ ^nil ]. + character4 := aStream basicNext ifNil: [ ^nil ]. ]. + + useLittleEndian + ifTrue: [ charValue := (character4 charCode bitShift: 24) + (character3 charCode bitShift: 16) + (character2 charCode bitShift: 8) + character1 charCode ] + ifFalse: [ charValue := (character1 charCode bitShift: 24) + (character2 charCode bitShift: 16) + (character3 charCode bitShift: 8) + character4 charCode ]. + + ^ Unicode value: charValue! Item was added: + ----- Method: UTF32TextConverter>>nextPut:toStream: (in category 'conversion') ----- + nextPut: aCharacter toStream: aStream + + | charCode | + aStream isBinary ifTrue: [ ^aCharacter storeBinaryOn: aStream ]. + (useByteOrderMark and: [ byteOrderMarkDone not ]) ifTrue: [ + self next32BitValue: 16r0000FEFF toStream: aStream. + byteOrderMarkDone := true ]. + (charCode := aCharacter charCode) < 256 + ifTrue: [ + (latin1Encodings at: charCode + 1) + ifNil: [ self next32BitValue: charCode toStream: aStream ] + ifNotNil: [ :encodedString | aStream basicNextPutAll: encodedString ] ] + ifFalse: [ + self next32BitValue: charCode toStream: aStream ]. + ^aCharacter! Item was added: + ----- Method: UTF32TextConverter>>swapLatin1EncodingByteOrder (in category 'private') ----- + swapLatin1EncodingByteOrder + latin1Encodings := latin1Encodings collect: [:each | + each ifNotNil: [each reverse]]! Item was added: + ----- Method: UTF32TextConverter>>useByteOrderMark (in category 'accessing') ----- + useByteOrderMark + + ^useByteOrderMark + ! Item was added: + ----- Method: UTF32TextConverter>>useByteOrderMark: (in category 'accessing') ----- + useByteOrderMark: aBoolean + + useByteOrderMark := aBoolean. + ! Item was added: + ----- Method: UTF32TextConverter>>useLittleEndian (in category 'accessing') ----- + useLittleEndian + + ^useLittleEndian + ! Item was added: + ----- Method: UTF32TextConverter>>useLittleEndian: (in category 'accessing') ----- + useLittleEndian: aBoolean + + aBoolean = useLittleEndian ifFalse: [ self swapLatin1EncodingByteOrder ]. + useLittleEndian := aBoolean. + !

1 0

GitHub package management beta
by Eliot Miranda 07 Jun '17

07 Jun '17

Hi All, I've been invited to participate in github's Bera test of their new package management support. I don't know much, if anything, about the software except that it supports RubyGems (Ruby), Maven (Java) and npm (JavaScript) formats. My contact at github has asked me to supply a list of email addresses of those who would like to test the software. The contact will provide documentation. If you would like to participate please reply to me using this same subject line and including in the body of the message the email you'd like used. Please do top post. Maybe we could get github to directly support Monticello. Maybe this could achieve some simplifications and ease some tensions. I don't know. But I'm intrigued. Cheers! _,,,^..^,,,_ (phone)

5 4