Squeak-dev December 2014

squeak-dev@lists.squeakfoundation.org

35 participants
112 discussions

The Trunk: Nebraska-bf.39.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

Bert Freudenberg uploaded a new version of Nebraska to project The Trunk: http://source.squeak.org/trunk/Nebraska-bf.39.mcz ==================== Summary ==================== Name: Nebraska-bf.39 Author: bf Time: 8 December 2014, 1:56:52.004 am UUID: 0be115a5-ca25-41f7-b9e6-43c091a0f21b Ancestors: Nebraska-ul.38 Restore timestamps lost in assignment conversion. =============== Diff against Nebraska-ul.38 =============== Item was changed: ----- Method: AlertMorph>>color: (in category 'accessing') ----- color: aColor super color: aColor. onColor := aColor.! Item was changed: ----- Method: AlertMorph>>socketOwner: (in category 'as yet unclassified') ----- socketOwner: aChatGUI socketOwner := aChatGUI.! Item was changed: ----- Method: AlertMorph>>step (in category 'stepping and presenter') ----- step super step. offColor ifNil: [offColor := self onColor mixed: 0.5 with: Color black]. socketOwner objectsInQueue = 0 ifTrue: [ color = offColor ifFalse: [super color: offColor]. ] ifFalse: [ super color: (color = onColor ifTrue: [offColor] ifFalse: [onColor]). ]. ! Item was changed: ----- Method: AudioChatGUI class>>debugLog: (in category 'as yet unclassified') ----- debugLog: x " AudioChatGUI debugLog: nil AudioChatGUI debugLog: OrderedCollection new DebugLog LiveMessages NewAudioMessages PlayOnArrival " DebugLog := x. ! Item was changed: ----- Method: AudioChatGUI class>>handleNewAudioChat2From:sentBy:ipAddress: (in category 'as yet unclassified') ----- handleNewAudioChat2From: dataStream sentBy: senderName ipAddress: ipAddressString | newSound seqSound compressed | compressed := self newCompressedSoundFrom: dataStream. newSound := compressed asSound. "-------an experiment to try newSound adjustVolumeTo: 7.0 overMSecs: 10 --------" DebugLog ifNotNil: [ DebugLog add: {compressed. newSound}. ]. LiveMessages ifNil: [LiveMessages := Dictionary new]. seqSound := LiveMessages at: ipAddressString ifAbsentPut: [SequentialSound new]. seqSound isPlaying ifTrue: [ seqSound add: newSound; pruneFinishedSounds. ] ifFalse: [ seqSound initialize; add: newSound. ]. seqSound isPlaying ifFalse: [seqSound play].! Item was changed: ----- Method: AudioChatGUI class>>handleNewAudioChatFrom:sentBy:ipAddress: (in category 'as yet unclassified') ----- handleNewAudioChatFrom: dataStream sentBy: senderName ipAddress: ipAddressString | compressed | compressed := self newCompressedSoundFrom: dataStream. DebugLog ifNotNil: [ DebugLog add: {compressed}. ]. self newAudioMessages nextPut: compressed. self playOnArrival ifTrue: [self playNextAudioMessage]. ! Item was changed: ----- Method: AudioChatGUI class>>newAudioMessages (in category 'as yet unclassified') ----- newAudioMessages ^NewAudioMessages ifNil: [NewAudioMessages := SharedQueue new].! Item was changed: ----- Method: AudioChatGUI class>>newCompressedSoundFrom: (in category 'as yet unclassified') ----- newCompressedSoundFrom: dataStream | samplingRate | samplingRate := (dataStream upTo: 0 asCharacter) asNumber. ^CompressedSoundData new withEToySound: dataStream upToEnd samplingRate: samplingRate. ! Item was changed: ----- Method: AudioChatGUI class>>playOnArrival (in category 'as yet unclassified') ----- playOnArrival ^PlayOnArrival ifNil: [PlayOnArrival := false]! Item was changed: ----- Method: AudioChatGUI>>handsFreeTalking (in category 'sending') ----- handsFreeTalking ^handsFreeTalking ifNil: [handsFreeTalking := false].! Item was changed: ----- Method: AudioChatGUI>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" transmitWhileRecording := false. handsFreeTalking := false. mycodec := GSMCodec new. myrecorder := ChatNotes new. mytargetip := ''. self start2. self changeTalkButtonLabel! Item was changed: ----- Method: AudioChatGUI>>ipAddress: (in category 'initialization') ----- ipAddress: aString mytargetip := aString! Item was changed: ----- Method: AudioChatGUI>>messageWaitingAlertIndicator (in category 'initialization') ----- messageWaitingAlertIndicator | messageCounter | myalert := AlertMorph new socketOwner: self. messageCounter := UpdatingStringMorph on: self selector: #objectsInQueue. myalert addMorph: messageCounter. messageCounter contents: '0'; color: Color white. messageCounter align: messageCounter center with: myalert center. myalert setBalloonText: 'New messages indicator. This will flash and show the number of messages when there are messages that you haven''t listened to. You can click here to play the next message.'. myalert on: #mouseUp send: #playNextMessage to: self. ^myalert! Item was changed: ----- Method: AudioChatGUI>>record (in category 'sending') ----- record queueForMultipleSends := nil. myrecorder record.! Item was changed: ----- Method: AudioChatGUI>>removeConnectButton (in category 'stuff') ----- removeConnectButton theConnectButton ifNotNil: [ theConnectButton delete. theConnectButton := nil. ].! Item was changed: ----- Method: AudioChatGUI>>send (in category 'sending') ----- send | null rawSound aSampledSound | mytargetip isEmpty ifTrue: [ ^self inform: 'You must connect with someone first.'. ]. rawSound := myrecorder recorder recordedSound ifNil: [^self]. aSampledSound := rawSound asSampledSound. "Smalltalk at: #Q3 put: {rawSound. rawSound asSampledSound. aCompressedSound}." self transmitWhileRecording ifTrue: [ self sendOneOfMany: rawSound asSampledSound. queueForMultipleSends ifNotNil: [queueForMultipleSends nextPut: nil]. queueForMultipleSends := nil. ^self ]. null := String with: 0 asCharacter. EToyPeerToPeer new sendSomeData: { EToyIncomingMessage typeAudioChat,null. Preferences defaultAuthorName,null. aSampledSound originalSamplingRate asInteger printString,null. (mycodec compressSound: aSampledSound) channels first. } to: mytargetip for: self. ! Item was changed: ----- Method: AudioChatGUI>>sendAnyCompletedSounds (in category 'sending') ----- sendAnyCompletedSounds | soundsSoFar firstCompleteSound | myrecorder isRecording ifFalse: [^self]. mytargetip isEmpty ifTrue: [^self]. soundsSoFar := myrecorder recorder recordedSound ifNil: [^self]. firstCompleteSound := soundsSoFar removeFirstCompleteSoundOrNil ifNil: [^self]. self sendOneOfMany: firstCompleteSound.! Item was changed: ----- Method: AudioChatGUI>>start (in category 'stepping and presenter') ----- start | myUpdatingText playButton myOpenConnectionButton myStopButton window | " --- old system window version --- " Socket initializeNetwork. myrecorder initialize. window := (SystemWindow labelled: 'iSCREAM') model: self. myalert := AlertMorph new. myalert socketOwner: self. window addMorph: myalert frame: (0.35(a)0.4 corner: 0.5(a)0.7). (playButton := self playButton) center: 200@300. window addMorph: playButton frame: (0.5(a)0.4 corner: 1.0(a)0.7). (myOpenConnectionButton := self connectButton) center: 250@300. window addMorph: myOpenConnectionButton frame: (0.5@0 corner: 1.0(a)0.4). (myStopButton := self recordAndStopButton) center: 300@300. window addMorph: myStopButton frame: (0.5(a)0.7 corner: 1.0(a)1.0). myUpdatingText := UpdatingStringMorph on: self selector: #objectsInQueue. window addMorph: myUpdatingText frame: (0.41(a)0.75 corner: 0.45(a)0.95). "myUserList init."! Item was changed: ----- Method: AudioChatGUI>>start2 (in category 'initialization') ----- start2 Socket initializeNetwork. myrecorder initialize. self addARow: { self inAColumn: { ( self inARow: { self inAColumn: {self toggleForSendWhileTalking}. self inAColumn: {self toggleForHandsFreeTalking}. self inAColumn: {self toggleForPlayOnArrival}. } ) hResizing: #shrinkWrap. self inARow: { self talkBacklogIndicator. self messageWaitingAlertIndicator. }. }. self inAColumn: { theConnectButton := self connectButton. self playButton. theTalkButton := self talkButton. }. }. ! Item was changed: ----- Method: AudioChatGUI>>step (in category 'stepping and presenter') ----- step | now | super step. self transmitWhileRecording ifTrue: [self sendAnyCompletedSounds]. self handsFreeTalking & myrecorder isRecording ifTrue: [ now := Time millisecondClockValue. ((handsFreeTalkingFlashTime ifNil: [0]) - now) abs > 200 ifTrue: [ theTalkButton color: ( theTalkButton color = self buttonColor ifTrue: [Color white] ifFalse: [self buttonColor] ). handsFreeTalkingFlashTime := now. ]. ]. self class playOnArrival ifTrue: [self playNextMessage]. "myrecorder ifNotNil: [ myrecorder recorder samplingRate printString ,' ', SoundPlayer samplingRate printString,' ' displayAt: 0@0 ]."! Item was changed: ----- Method: AudioChatGUI>>toggleChoice: (in category 'stuff') ----- toggleChoice: aSymbol aSymbol == #playOnArrival ifTrue: [ ^PlayOnArrival := self class playOnArrival not ]. aSymbol == #transmitWhileRecording ifTrue: [ transmitWhileRecording := self transmitWhileRecording not. self changeTalkButtonLabel. ^transmitWhileRecording ]. aSymbol == #handsFreeTalking ifTrue: [ handsFreeTalking := self handsFreeTalking not. self changeTalkButtonLabel. ^handsFreeTalking ]. ! Item was changed: ----- Method: AudioChatGUI>>transmitWhileRecording (in category 'sending') ----- transmitWhileRecording ^transmitWhileRecording ifNil: [transmitWhileRecording := false]! Item was changed: ----- Method: BufferedCanvas>>checkIfTimeToDisplay (in category 'as yet unclassified') ----- checkIfTimeToDisplay remote backlog > 0 ifTrue: [^self]. "why bother if network full?" dirtyRect ifNil: [^self]. self sendDeltas. lastTick := Time millisecondClockValue. ! Item was changed: ----- Method: BufferedCanvas>>connection:clipRect:transform:remoteCanvas: (in category 'as yet unclassified') ----- connection: connection clipRect: newClipRect transform: transform remoteCanvas: remoteCanvas remote := remoteCanvas. lastTick := 0. ! Item was changed: ----- Method: BufferedCanvas>>forceToScreen: (in category 'other') ----- forceToScreen: rect mirrorOfScreen ifNil: [ mirrorOfScreen := (previousVersion ifNil: [Display]) deepCopy. ]. mirrorOfScreen copy: rect from: rect origin in: Display rule: Form over. dirtyRect := dirtyRect ifNil: [rect] ifNotNil: [dirtyRect merge: rect]. ! Item was changed: ----- Method: BufferedCanvas>>sendDeltas (in category 'as yet unclassified') ----- sendDeltas " NebraskaDebug showStats: #sendDeltas " | t deltas dirtyFraction | previousVersion ifNil: [ previousVersion := Display deepCopy. remote image: previousVersion at: 0@0 sourceRect: previousVersion boundingBox rule: Form paint. ^remote forceToScreen: previousVersion boundingBox. ]. dirtyRect ifNil: [^self]. t := Time millisecondClockValue. dirtyFraction := dirtyRect area / previousVersion boundingBox area roundTo: 0.0001. deltas := mirrorOfScreen deltaFrom: (previousVersion copy: dirtyRect) at: dirtyRect origin. previousVersion := mirrorOfScreen. mirrorOfScreen := nil. remote image: deltas at: dirtyRect origin sourceRect: deltas boundingBox rule: Form reverse; forceToScreen: dirtyRect. t := Time millisecondClockValue - t. NebraskaDebug at: #sendDeltas add: {t. dirtyFraction. deltas boundingBox}. dirtyRect := nil. ! Item was changed: ----- Method: CanvasDecoder class>>decodeTTCFont: (in category 'decoding') ----- decodeTTCFont: fontString "Decode a string that consists of <familyName> <pointSize> <emphasis> (e.g. 'ComicSansMS 12 0') into a proper instance." | first second | first := fontString indexOf: $ startingAt: 1. second := fontString indexOf: $ startingAt: first + 1. (first ~= 0 and: [second ~= 0]) ifTrue: [ ^ (TTCFont family: (fontString copyFrom: 1 to: (first - 1)) size: (fontString copyFrom: first + 1 to: second - 1) asNumber) emphasized: (fontString copyFrom: second + 1 to: fontString size) asNumber. ]. ^ TextStyle defaultFont. ! Item was changed: ----- Method: CanvasDecoder class>>reinitialize (in category 'class initialization') ----- reinitialize "CanvasDecoder reinitialize" "Set up my cache and decode table, removing old contents." CachedForms := nil. DecodeTable := nil. self initialize. ! Item was changed: ----- Method: CanvasDecoder>>connection: (in category 'network') ----- connection: aStringSocket "set this terminal to talk over the given socket" connection := aStringSocket! Item was changed: ----- Method: CanvasDecoder>>drawLine: (in category 'decoding') ----- drawLine: command | verb pt1Enc pt2Enc widthEnc colorEnc pt1 pt2 width color | verb := command first. pt1Enc := command second. pt2Enc := command third. widthEnc := command fourth. colorEnc := command fifth. "" pt1 := self class decodePoint: pt1Enc. pt2 := self class decodePoint: pt2Enc. width := self class decodeInteger: widthEnc. color := self class decodeColor: colorEnc. "" self drawCommand: [:c | c line: pt1 to: pt2 width: width color: color]! Item was changed: ----- Method: CanvasDecoder>>drawOval: (in category 'decoding') ----- drawOval: command | verb rectEnc colorEnc borderWidthEnc borderColorEnc rect color borderWidth borderColor | verb := command first. rectEnc := command second. colorEnc := command third. borderWidthEnc := command fourth. borderColorEnc := command fifth. "" rect := self class decodeRectangle: rectEnc. color := self class decodeColor: colorEnc. borderWidth := self class decodeInteger: borderWidthEnc. borderColor := self class decodeColor: borderColorEnc. "" self drawCommand: [:c | c fillOval: rect color: color borderWidth: borderWidth borderColor: borderColor]! Item was changed: ----- Method: CanvasDecoder>>drawRect: (in category 'decoding') ----- drawRect: command | verb rectEnc fillColorEnc borderWidthEnc borderColorEnc rect fillColor borderWidth borderColor | verb := command first. rectEnc := command second. fillColorEnc := command third. borderWidthEnc := command fourth. borderColorEnc := command fifth. "" rect := self class decodeRectangle: rectEnc. fillColor := self class decodeColor: fillColorEnc. borderWidth := self class decodeInteger: borderWidthEnc. borderColor := self class decodeColor: borderColorEnc. "" self drawCommand: [:c | c frameAndFillRectangle: rect fillColor: fillColor borderWidth: borderWidth borderColor: borderColor]! Item was changed: ----- Method: CanvasDecoder>>showSpaceUsed (in category 'decoding') ----- showSpaceUsed | total | CachedForms ifNil: [^self]. total := 0. CachedForms do: [ :each | each ifNotNil: [ total := total + (each depth * each width * each height // 8). ]. ]. (total // 1024) printString,' ', (Smalltalk garbageCollectMost // 1024) printString,' ' displayAt: 0@0! Item was changed: ----- Method: CanvasEncoder class>>at:count: (in category 'as yet unclassified') ----- at: anIndex count: anInteger SimpleCounters ifNil: [(SimpleCounters := Array new: 10) atAllPut: 0]. SimpleCounters at: anIndex put: (SimpleCounters at: anIndex) + anInteger.! Item was changed: ----- Method: CanvasEncoder class>>beginStats (in category 'as yet unclassified') ----- beginStats SentTypesAndSizes := Dictionary new.! Item was changed: ----- Method: CanvasEncoder class>>clearTestVars (in category 'as yet unclassified') ----- clearTestVars " CanvasEncoder clearTestVars " SimpleCounters := nil ! Item was changed: ----- Method: CanvasEncoder class>>encodeImage: (in category 'encoding') ----- encodeImage: form | t answer | form ifNil: [^'']. t := Time millisecondsToRun: [answer := form encodeForRemoteCanvas]. form boundingBox area > 5000 ifTrue: [ NebraskaDebug at: #FormEncodeTimes add: {t. form extent. answer size} ]. ^answer "HandMorph>>restoreSavedPatchOn: is one culprit here" ! Item was changed: ----- Method: CanvasEncoder class>>killStats (in category 'as yet unclassified') ----- killStats SentTypesAndSizes := nil! Item was changed: ----- Method: CanvasEncoder class>>nameForCode: (in category 'as yet unclassified') ----- nameForCode: aStringOrChar | ch | ch := (aStringOrChar isString) ifTrue: [aStringOrChar first] ifFalse: [aStringOrChar]. ch == self codeBalloonOval ifTrue: [^'balloon oval']. ch == self codeBalloonRect ifTrue: [^'balloon rectangle']. ch == self codeClip ifTrue: [^'clip']. ch == self codeExtentDepth ifTrue: [^'codeExtentDepth']. ch == self codeFont ifTrue: [^'codeFont']. ch == self codeTTCFont ifTrue: [^'codeTTCFont']. ch == self codeForce ifTrue: [^'codeForce']. ch == self codeImage ifTrue: [^'codeImage']. ch == self codeLine ifTrue: [^'codeLine']. ch == self codeOval ifTrue: [^'codeOval']. ch == self codePoly ifTrue: [^'codePoly']. ch == self codeRect ifTrue: [^'codeRect']. ch == self codeReleaseCache ifTrue: [^'codeReleaseCache']. ch == self codeStencil ifTrue: [^'codeStencil']. ch == self codeText ifTrue: [^'codeText']. ch == self codeTransform ifTrue: [^'codeTransform']. ch == self codeInfiniteFill ifTrue: [^'codeInfiniteFill']. ch == self codeShadowColor ifTrue: [^'shadowColor']. ^'????' ! Item was changed: ----- Method: CanvasEncoder>>cachingEnabled: (in category 'drawing') ----- cachingEnabled: aBoolean (cachingEnabled := aBoolean) ifFalse: [ cachedObjects := nil. ]. ! Item was changed: ----- Method: CanvasEncoder>>connection: (in category 'connection') ----- connection: aStringSocket "set this connection to talk over the given socket" cachingEnabled := true. connection := aStringSocket! Item was changed: ----- Method: CanvasEncoder>>convertToCurrentVersion:refStream: (in category 'objects from disk') ----- convertToCurrentVersion: varDict refStream: smartRefStrm cachingEnabled ifNil: [cachingEnabled := true]. ^super convertToCurrentVersion: varDict refStream: smartRefStrm. ! Item was changed: ----- Method: CanvasEncoder>>disconnect (in category 'connection') ----- disconnect connection ifNotNil: [ connection destroy. connection := nil. ].! Item was changed: ----- Method: CanvasEncoder>>image:at:sourceRect:rule:cacheID:newToCache: (in category 'drawing') ----- image: aFormOrNil at: aPoint sourceRect: sourceRect rule: rule cacheID: cacheID newToCache: newToCache | t destRect d2 | destRect := aPoint extent: sourceRect extent. d2 := (lastTransform invertBoundsRect: destRect) expandBy: 1. (d2 intersects: lastClipRect) ifFalse: [ ^NebraskaDebug at: #bigImageSkipped add: {lastClipRect. d2}. ]. t := Time millisecondsToRun: [ self sendCommand: { String with: CanvasEncoder codeImage. self class encodeImage: aFormOrNil. self class encodePoint: aPoint. self class encodeRectangle: sourceRect. self class encodeInteger: rule. self class encodeInteger: cacheID. self class encodeInteger: (newToCache ifTrue: [1] ifFalse: [0]). }. ]. (aFormOrNil notNil and: [aFormOrNil boundingBox area > 10000]) ifTrue: [ NebraskaDebug at: #bigImage add: {lastClipRect. aPoint. sourceRect extent. t. cacheID. newToCache}. ]. ! Item was changed: ----- Method: CanvasEncoder>>sendFont:atIndex: (in category 'fonts') ----- sendFont: aFont atIndex: index "Transmits the given fint to the other side" | code | code := CanvasEncoder codeFont. aFont isTTCFont ifTrue: [code := CanvasEncoder codeTTCFont]. self sendCommand: { String with: code. self class encodeInteger: index. self class encodeFont: aFont }. ! Item was changed: ----- Method: CanvasEncoder>>testRectangleFillTiming (in category 'drawing') ----- testRectangleFillTiming | r fillColor borderWidth borderColor t | " CanvasEncoder new testRectangleFillTiming " r := 100@100 extent: 300@300. fillColor := Color blue. borderWidth := 1. borderColor := Color red. t := Time millisecondsToRun: [ 1000 timesRepeat: [ { String with: CanvasEncoder codeRect. self class encodeRectangle: r. self class encodeColor: fillColor. self class encodeInteger: borderWidth. self class encodeColor: borderColor } ]. ]. t inspect.! Item was changed: ----- Method: CanvasEncoder>>updateTransform:andClipRect: (in category 'clipping and transforming') ----- updateTransform: aTransform andClipRect: aClipRect "sets the given transform and clip rectangle, if they aren't already the ones being used" aTransform = lastTransform ifFalse: [ self setTransform: aTransform. lastTransform := aTransform ]. aClipRect = lastClipRect ifFalse: [ self setClipRect: aClipRect. lastClipRect := aClipRect. ].! Item was changed: ----- Method: ChatButtonMorph>>actionDownSelector: (in category 'accessing') ----- actionDownSelector: aSymbolOrString (nil = aSymbolOrString or: ['nil' = aSymbolOrString or: [aSymbolOrString isEmpty]]) ifTrue: [^actionDownSelector := nil]. actionDownSelector := aSymbolOrString asSymbol.! Item was changed: ----- Method: ChatButtonMorph>>actionUpSelector: (in category 'accessing') ----- actionUpSelector: aSymbolOrString (nil = aSymbolOrString or: ['nil' = aSymbolOrString or: [aSymbolOrString isEmpty]]) ifTrue: [^ actionUpSelector := nil]. actionUpSelector := aSymbolOrString asSymbol.! Item was changed: ----- Method: ChatButtonMorph>>labelDown: (in category 'accessing') ----- labelDown: aString labelDown := aString.! Item was changed: ----- Method: ChatButtonMorph>>labelUp: (in category 'accessing') ----- labelUp: aString labelUp := aString! Item was changed: ----- Method: ChatButtonMorph>>mouseDown: (in category 'event handling') ----- mouseDown: evt oldColor := self fillStyle. self label: labelDown. self doButtonDownAction. ! Item was changed: ----- Method: ChatNotes>>deleteSelection (in category 'file i/o') ----- deleteSelection "Delete the selection in the list" | dir | notesIndex <= 0 ifTrue: [^self]. dir := self audioDirectory. dir deleteFileNamed: ((notes at: notesIndex), 'name') ifAbsent: []. dir deleteFileNamed: ((notes at: notesIndex), 'aiff') ifAbsent: []. names removeAt: notesIndex. notes removeAt: notesIndex. self notesListIndex: 0. self changed: #notesList. self changed: #name.! Item was changed: ----- Method: ChatNotes>>getNextName (in category 'file i/o') ----- getNextName "Return the next name available. All names are of the form '#.name' and '#.aiff'." | dir num | dir := self audioDirectory. num := 1. [dir fileExists: (num asString, '.name')] whileTrue: [num := num + 1]. ^(num asString, '.')! Item was changed: ----- Method: ChatNotes>>initialize (in category 'initialization') ----- initialize self loadNotes. notesIndex := 0. recorder := ChatRecorder new. recorder initialize.! Item was changed: ----- Method: ChatNotes>>isPlaying (in category 'testing') ----- isPlaying ^isPlaying ifNil: [isPlaying := false]! Item was changed: ----- Method: ChatNotes>>isPlaying: (in category 'testing') ----- isPlaying: aBoolean isPlaying = aBoolean ifTrue: [^self]. isPlaying := aBoolean. self changed: #isPlaying ! Item was changed: ----- Method: ChatNotes>>isRecording (in category 'testing') ----- isRecording ^isRecording ifNil: [isRecording := false]! Item was changed: ----- Method: ChatNotes>>isRecording: (in category 'testing') ----- isRecording: aBoolean isRecording = aBoolean ifTrue: [^self]. isRecording := aBoolean. self changed: #isRecording ! Item was changed: ----- Method: ChatNotes>>isSaving (in category 'testing') ----- isSaving ^isSaving ifNil: [isSaving := false]! Item was changed: ----- Method: ChatNotes>>isSaving: (in category 'testing') ----- isSaving: aBoolean isSaving = aBoolean ifTrue: [^self]. isSaving := aBoolean. self changed: #isSaving! Item was changed: ----- Method: ChatNotes>>loadNotes (in category 'initialization') ----- loadNotes "Load notes from the files" | dir | names := OrderedCollection new. notes := OrderedCollection new. (FileDirectory default directoryExists: 'audio') ifFalse: [^self]. dir := self audioDirectory. dir fileNames do: [:fname | (fname endsWith: '.name') ifTrue: [ names add: ((dir fileNamed: fname) contentsOfEntireFile). notes add: (fname copyFrom: 1 to: (fname size - 4))]].! Item was changed: ----- Method: ChatNotes>>name (in category 'accessing') ----- name ^name ifNil: [name := '']! Item was changed: ----- Method: ChatNotes>>name: (in category 'accessing') ----- name: aString name := aString. self changed: #name.! Item was changed: ----- Method: ChatNotes>>notesListIndex (in category 'accessing') ----- notesListIndex ^notesIndex ifNil: [notesIndex := 0]! Item was changed: ----- Method: ChatNotes>>notesListIndex: (in category 'accessing') ----- notesListIndex: index notesIndex := index = notesIndex ifTrue: [0] ifFalse: [index]. self name: (self notesList at: notesIndex ifAbsent: ['']). self changed: #notesListIndex.! Item was changed: ----- Method: ChatNotes>>openAsMorph (in category 'initialization') ----- openAsMorph | window aColor recordButton stopButton playButton saveButton | window := (SystemWindow labelled: 'Audio Notes') model: self. window addMorph: ( (PluggableListMorph on: self list: #notesList selected: #notesListIndex changeSelected: #notesListIndex: menu: #notesMenu: ) autoDeselect: false) frame: (0@0 corner: 0.5(a)1.0). nameTextMorph := PluggableTextMorph on: self text: #name accept: nil. nameTextMorph askBeforeDiscardingEdits: false. window addMorph: nameTextMorph frame: (0.5@0 corner: 1.0(a)0.4). aColor := Color colorFrom: self defaultBackgroundColor. (recordButton := PluggableButtonMorph on: self getState: #isRecording action: #record) label: 'record'; askBeforeChanging: true; color: aColor; onColor: aColor darker offColor: aColor. window addMorph: recordButton frame: (0.5(a)0.4 corner: 0.75(a)0.7). (stopButton := PluggableButtonMorph on: self getState: #isStopped action: #stop) label: 'stop'; askBeforeChanging: true; color: aColor; onColor: aColor darker offColor: aColor. window addMorph: stopButton frame: (0.75(a)0.4 corner: 1.0(a)0.7). (playButton := PluggableButtonMorph on: self getState: #isPlaying action: #play) label: 'play'; askBeforeChanging: true; color: aColor; onColor: aColor darker offColor: aColor. window addMorph: playButton frame: (0.5(a)0.7 corner: 0.75(a)1.0). (saveButton := PluggableButtonMorph on: self getState: #isSaving action: #save) label: 'save'; askBeforeChanging: true; color: aColor; onColor: aColor darker offColor: aColor. window addMorph: saveButton frame: (0.75(a)0.7 corner: 1.0(a)1.0). window openInWorld.! Item was changed: ----- Method: ChatNotes>>play (in category 'file i/o') ----- play | separator | self isPlaying: true. notesIndex = 0 ifTrue: [ recorder pause. recorder playback. self isPlaying: false. ^self ]. separator := FileDirectory pathNameDelimiter asString. sound := (AIFFFileReader new readFromFile: ( FileDirectory default pathName, separator, 'audio', separator, (notes at: notesIndex), 'aiff')) sound. [ sound playAndWaitUntilDone. self isPlaying: false ] fork! Item was changed: ----- Method: ChatNotes>>record (in category 'button commands') ----- record self isRecording: true. notesIndex = 0 ifFalse: [self notesListIndex: 0]. sound := nil. recorder clearRecordedSound. recorder resumeRecording.! Item was changed: ----- Method: ChatNotes>>saveName (in category 'file i/o') ----- saveName "Save the name to the '.name' file." | dir file | self name: self textMorphString. dir := self audioDirectory. file := (notes at: notesIndex), 'name'. (dir fileExists: file) ifTrue: [dir deleteFileNamed: file]. file := dir newFileNamed: file. file nextPutAll: name. file close. names at: notesIndex put: name. self changed: #notesList.! Item was changed: ----- Method: ChatNotes>>saveSound (in category 'file i/o') ----- saveSound "Move the sound from the recorder to the files." | fname file | recorder recordedSound ifNil: [^self]. self isSaving: true. fname := self getNextName. "Create .name file" file := self audioDirectory newFileNamed: (fname, 'name'). file nextPutAll: self textMorphString. file close. "Create .aiff file" file := (self audioDirectory newFileNamed: (fname, 'aiff')) binary. self storeAIFFOnFile: file. file close. "Add to names and notes" names add: self textMorphString. notes add: fname. self changed: #notesList. self notesListIndex: (notes size). "Clear Recorder" recorder := SoundRecorder new. "Stop Button" self isSaving: false! Item was changed: ----- Method: ChatRecorder>>initialize (in category 'as yet unclassified') ----- initialize "setting a higher desired recording rate seemed to fix certain powerbook problems. I'm still trying to understand it all, but there it is for now" super initialize. samplingRate := 44100. ! Item was changed: ----- Method: ChatRecorder>>pause (in category 'as yet unclassified') ----- pause "Go into pause mode. The record level continues to be updated, but no sound is recorded." paused := true. ((currentBuffer ~~ nil) and: [nextIndex > 1]) ifTrue: [self emitPartialBuffer. self allocateBuffer]. soundPlaying ifNotNil: [ soundPlaying pause. soundPlaying := nil]. self stopRecording. "Preferences canRecordWhilePlaying ifFalse: [self stopRecording]." ! Item was changed: ----- Method: ChatRecorder>>playback (in category 'as yet unclassified') ----- playback "Playback the sound that has been recorded." self pause. soundPlaying := self recordedSound ifNil: [^self]. soundPlaying play. ! Item was changed: ----- Method: ChatRecorder>>recordedSound: (in category 'accessing') ----- recordedSound: aSound self clearRecordedSound. recordedSound := aSound.! Item was changed: ----- Method: ChatRecorder>>resumeRecording (in category 'as yet unclassified') ----- resumeRecording "Continue recording from the point at which it was last paused." self startRecording. paused := false. ! Item was changed: ----- Method: ColorForm>>encodeForRemoteCanvas (in category '*nebraska-*nebraska-Morphic-Remote') ----- encodeForRemoteCanvas "encode into a bitstream for use with RemoteCanvas." | colorsToSend | colorsToSend := self colors. ^String streamContents: [ :str | str nextPut: $C; "indicates color form" nextPutAll: colorsToSend size printString; nextPut: $,. colorsToSend do: [ :each | str nextPutAll: each encodeForRemoteCanvas ]. str nextPutAll: super encodeForRemoteCanvas ]. ! Item was changed: ----- Method: DisplayTransform class>>fromRemoteCanvasEncoding: (in category '*nebraska-instance creation') ----- fromRemoteCanvasEncoding: encoded | type | "decode a transform from the given encoded string" type := (ReadStream on: encoded) upTo: $,. type = 'Morphic' ifTrue: [ ^MorphicTransform fromRemoteCanvasEncoding: encoded ]. type = 'Matrix' ifTrue: [ ^MatrixTransform2x3 fromRemoteCanvasEncoding: encoded ]. type = 'Composite' ifTrue: [ ^CompositeTransform fromRemoteCanvasEncoding: encoded ]. ^self error: 'invalid transform encoding'! Item was changed: ----- Method: EToyChatMorph class>>chatFrom:name:text: (in category 'as yet unclassified') ----- chatFrom: ipAddress name: senderName text: text | chatWindow | chatWindow := self chatWindowForIP: ipAddress name: senderName picture: (EToySenderMorph pictureForIPAddress: ipAddress) inWorld: self currentWorld. chatWindow chatFrom: ipAddress name: senderName text: text ! Item was changed: ----- Method: EToyChatMorph class>>chatWindowForIP:name:picture:inWorld: (in category 'as yet unclassified') ----- chatWindowForIP: ipAddress name: senderName picture: aForm inWorld: aWorld | makeANewOne aSenderBadge existing | existing := self instanceForIP: ipAddress inWorld: aWorld. existing ifNotNil: [^existing]. makeANewOne := [ self new recipientForm: aForm; open; setIPAddress: ipAddress ]. EToyCommunicatorMorph playArrivalSound. self doChatsInternalToBadge ifTrue: [ aSenderBadge := EToySenderMorph instanceForIP: ipAddress inWorld: aWorld. aSenderBadge ifNotNil: [ aSenderBadge startChat: false. ^aSenderBadge findDeepSubmorphThat: [ :x | x isKindOf: EToyChatMorph] ifAbsent: makeANewOne ]. aSenderBadge := EToySenderMorph instanceForIP: ipAddress. aSenderBadge ifNotNil: [ aSenderBadge := aSenderBadge veryDeepCopy. aSenderBadge killExistingChat; openInWorld: aWorld; startChat: false. ^aSenderBadge findDeepSubmorphThat: [ :x | x isKindOf: EToyChatMorph] ifAbsent: makeANewOne ]. (aSenderBadge := EToySenderMorph new) userName: senderName userPicture: aForm userEmail: 'unknown' userIPAddress: ipAddress; position: 200@200; openInWorld: aWorld; startChat: false. ^aSenderBadge findDeepSubmorphThat: [ :x | x isKindOf: EToyChatMorph] ifAbsent: makeANewOne ]. ^makeANewOne value. ! Item was changed: ----- Method: EToyChatMorph>>acceptTo:forMorph: (in category 'as yet unclassified') ----- acceptTo: someText forMorph: aMorph | betterText | betterText := self improveText: someText forMorph: aMorph. self transmitStreamedObject: (betterText eToyStreamedRepresentationNotifying: self) to: self ipAddress. aMorph setText: '' asText. self appendMessage: self startOfMessageFromMe, ' - ', betterText, String cr. ^true! Item was changed: ----- Method: EToyChatMorph>>chatFrom:name:text: (in category 'as yet unclassified') ----- chatFrom: ipAddress name: senderName text: text | initialText attrib | recipientForm ifNil: [ initialText := senderName asText allBold. ] ifNotNil: [ attrib := TextAnchor new anchoredMorph: recipientForm "asMorph". initialText := (String value: 1) asText. initialText addAttribute: attrib from: 1 to: 1. ]. self appendMessage: initialText,' - ',text,String cr. EToyCommunicatorMorph playArrivalSound. ! Item was changed: ----- Method: EToyChatMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" acceptOnCR := true. self listDirection: #topToBottom; layoutInset: 0; hResizing: #shrinkWrap; vResizing: #shrinkWrap; rubberBandCells: false; minWidth: 200; minHeight: 200; rebuild ! Item was changed: ----- Method: EToyChatMorph>>rebuild (in category 'as yet unclassified') ----- rebuild | r1 r2 | r1 := self addARow: { self simpleToggleButtonFor: self attribute: #acceptOnCR help: 'Send with Return?'. self inAColumn: {StringMorph new contents: 'Your message to:'; lock}. self textEntryFieldNamed: #ipAddress with: '' help: 'IP address for chat partner'. }. recipientForm ifNotNil: [ r1 addMorphBack: recipientForm asMorph lock ]. sendingPane := PluggableTextMorph on: self text: nil accept: #acceptTo:forMorph:. sendingPane hResizing: #spaceFill; vResizing: #spaceFill. self addMorphBack: sendingPane. r2 := self addARow: {self inAColumn: {StringMorph new contents: 'Replies'; lock}}. receivingPane := PluggableTextMorph on: self text: nil accept: nil. receivingPane hResizing: #spaceFill; vResizing: #spaceFill. self addMorphBack: receivingPane. receivingPane spaceFillWeight: 3. {r1. r2} do: [ :each | each vResizing: #shrinkWrap; minHeight: 18; color: Color veryLightGray. ]. sendingPane acceptOnCR: (acceptOnCR ifNil: [acceptOnCR := true])! Item was changed: ----- Method: EToyChatMorph>>recipientForm: (in category 'as yet unclassified') ----- recipientForm: aForm recipientForm := aForm. recipientForm ifNotNil: [recipientForm := recipientForm scaledToSize: 20@20].! Item was changed: ----- Method: EToyChatMorph>>startOfMessageFromMe (in category 'as yet unclassified') ----- startOfMessageFromMe myForm ifNil: [ myForm := EToySenderMorph pictureForIPAddress: NetNameResolver localAddressString. myForm ifNotNil: [ myForm := myForm scaledToSize: 20@20 ]. ]. myForm ifNil: [ ^(Preferences defaultAuthorName asText allBold addAttribute: TextColor blue) ]. ^(String value: 1) asText addAttribute: (TextAnchor new anchoredMorph: myForm); yourself ! Item was changed: ----- Method: EToyChatMorph>>toggleChoice: (in category 'as yet unclassified') ----- toggleChoice: aSymbol aSymbol == #acceptOnCR ifTrue: [ acceptOnCR := (acceptOnCR ifNil: [true]) not. sendingPane ifNotNil: [sendingPane acceptOnCR: acceptOnCR]. ^self ]. ! Item was changed: ----- Method: EToyFridgeMorph class>>addRecipient: (in category 'as yet unclassified') ----- addRecipient: aSenderMorph self fridgeRecipients do: [ :each | aSenderMorph ipAddress = each ipAddress ifTrue: [^self] ]. self fridgeRecipients add: aSenderMorph. UpdateCounter := self updateCounter + 1 ! Item was changed: ----- Method: EToyFridgeMorph class>>fridgeForm (in category 'as yet unclassified') ----- fridgeForm | fridgeFileName | fridgeFileName := 'fridge.form'. TheFridgeForm ifNotNil: [^TheFridgeForm]. (FileDirectory default fileExists: fridgeFileName) ifFalse: [^nil]. ^TheFridgeForm := Form fromFileNamed: fridgeFileName.! Item was changed: ----- Method: EToyFridgeMorph class>>fridgeRecipients (in category 'as yet unclassified') ----- fridgeRecipients ^FridgeRecipients ifNil: [FridgeRecipients := OrderedCollection new]! Item was changed: ----- Method: EToyFridgeMorph class>>newItem: (in category 'as yet unclassified') ----- newItem: newMorph | theFridge fridgeWorld trialRect | theFridge := Project named: 'Fridge'. theFridge ifNil: [^self newItems add: newMorph]. fridgeWorld := theFridge world. trialRect := fridgeWorld randomBoundsFor: newMorph. fridgeWorld addMorphFront: (newMorph position: trialRect topLeft); startSteppingSubmorphsOf: newMorph ! Item was changed: ----- Method: EToyFridgeMorph class>>newItems (in category 'as yet unclassified') ----- newItems ^NewItems ifNil: [NewItems := OrderedCollection new]! Item was changed: ----- Method: EToyFridgeMorph class>>removeRecipientWithIPAddress: (in category 'as yet unclassified') ----- removeRecipientWithIPAddress: ipString FridgeRecipients := self fridgeRecipients reject: [ :each | ipString = each ipAddress ]. UpdateCounter := self updateCounter + 1 ! Item was changed: ----- Method: EToyFridgeMorph>>acceptDroppingMorph:event: (in category 'layout') ----- acceptDroppingMorph: morphToDrop event: evt | outData | (morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt ]. self eToyRejectDropMorph: morphToDrop event: evt. "we will keep a copy" (morphToDrop isKindOf: EToySenderMorph) ifTrue: [ self class addRecipient: morphToDrop. ^self rebuild ]. self stopFlashing. "7 mar 2001 - remove #veryDeepCopy" outData := morphToDrop eToyStreamedRepresentationNotifying: self. self resetIndicator: #working. self class fridgeRecipients do: [ :each | self transmitStreamedObject: outData to: each ipAddress ]. ! Item was changed: ----- Method: EToyFridgeMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas | f cache | f := self class fridgeForm ifNil: [^super drawOn: aCanvas]. cache := Form extent: bounds extent depth: aCanvas depth. f displayInterpolatedIn: cache boundingBox truncated on: cache. cache replaceColor: Color black withColor: Color transparent. aCanvas translucentImage: cache at: bounds origin. ! Item was changed: ----- Method: EToyFridgeMorph>>handlesMouseDown: (in category 'event handling') ----- handlesMouseDown: globalEvt | localCursorPoint | localCursorPoint := self globalPointToLocal: globalEvt cursorPoint. groupMode ifFalse: [ self allMorphsDo: [ :each | (each isKindOf: EToySenderMorph) ifTrue: [ (each bounds containsPoint: localCursorPoint) ifTrue: [^false]. ]. ]. ]. ^true! Item was changed: ----- Method: EToyFridgeMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" groupMode := true. self listDirection: #topToBottom; layoutInset: 10; hResizing: #shrinkWrap; vResizing: #shrinkWrap; setProperty: #normalBorderColor toValue: self borderColor; setProperty: #flashingColors toValue: {Color red. Color yellow}; rebuild! Item was changed: ----- Method: EToyFridgeMorph>>rebuild (in category 'as yet unclassified') ----- rebuild | row filler fudge people maxPerRow insetY | updateCounter := self class updateCounter. self removeAllMorphs. (self addARow: { filler := Morph new color: Color transparent; extent: 4@4. }) vResizing: #shrinkWrap. self addARow: { (StringMorph contents: 'the Fridge') lock. self groupToggleButton. }. row := self addARow: {}. people := self class fridgeRecipients. maxPerRow := people size < 7 ifTrue: [2] ifFalse: [3]. "how big can this get before we need a different approach?" people do: [ :each | row submorphCount >= maxPerRow ifTrue: [row := self addARow: {}]. row addMorphBack: ( groupMode ifTrue: [ (each userPicture scaledToSize: 35@35) asMorph lock ] ifFalse: [ each veryDeepCopy killExistingChat ] ) ]. fullBounds := nil. self fullBounds. "htsBefore := submorphs collect: [ :each | each height]." fudge := 20. insetY := self layoutInset. insetY isPoint ifTrue: [insetY := insetY y]. filler extent: 4 @ (self height - filler height * 0.37 - insetY - borderWidth - fudge) truncated. "self fixLayout. htsAfter := submorphs collect: [ :each | each height]. {htsBefore. htsAfter} explore." ! Item was changed: ----- Method: EToyFridgeMorph>>toggleChoice: (in category 'as yet unclassified') ----- toggleChoice: aString updateCounter := nil. "force rebuild" aString = 'group' ifTrue: [^groupMode := (groupMode ifNil: [true]) not]. ! Item was changed: ----- Method: EToyFridgeMorph>>trulyFlashIndicator: (in category 'as yet unclassified') ----- trulyFlashIndicator: aSymbol | state | state := (self valueOfProperty: #fridgeFlashingState ifAbsent: [false]) not. self setProperty: #fridgeFlashingState toValue: state. self addMouseActionIndicatorsWidth: 15 color: (Color green alpha: (state ifTrue: [0.3] ifFalse: [0.7])). Beeper beep. "self world displayWorldSafely."! Item was changed: ----- Method: EToyGateKeeperEntry>>dateAndTimeStringFrom: (in category 'as yet unclassified') ----- dateAndTimeStringFrom: totalSeconds | dateAndTime | dateAndTime := Time dateAndTimeFromSeconds: totalSeconds. ^dateAndTime first printString,' ',dateAndTime second printString! Item was changed: ----- Method: EToyGateKeeperEntry>>initialize (in category 'initialization') ----- initialize self flag: #bob. "need to decide better initial types" super initialize. ipAddress := '???'. accessAttempts := attempsDenied := 0. lastRequests := OrderedCollection new. acceptableTypes := Set withAll: EToyIncomingMessage allTypes. ! Item was changed: ----- Method: EToyGateKeeperEntry>>ipAddress: (in category 'as yet unclassified') ----- ipAddress: aString ipAddress := aString! Item was changed: ----- Method: EToyGateKeeperEntry>>lastTimeCheckedString (in category 'as yet unclassified') ----- lastTimeCheckedString | statusTime | statusTime := self valueOfProperty: #lastTimeChecked ifAbsent: [^'none']. ^(self dateAndTimeStringFrom: statusTime)! Item was changed: ----- Method: EToyGateKeeperEntry>>latestUserName: (in category 'as yet unclassified') ----- latestUserName: aString latestUserName := aString! Item was changed: ----- Method: EToyGateKeeperEntry>>requestAccessOfType: (in category 'as yet unclassified') ----- requestAccessOfType: aString | ok | accessAttempts := accessAttempts + 1. lastRequests addFirst: {Time totalSeconds. aString}. lastRequests size > 10 ifTrue: [ lastRequests := lastRequests copyFrom: 1 to: 10. ]. ok := (acceptableTypes includes: aString) or: [acceptableTypes includes: 'all']. ok ifFalse: [attempsDenied := attempsDenied + 1]. ^ok! Item was changed: ----- Method: EToyGateKeeperEntry>>statusReplyReceivedString (in category 'as yet unclassified') ----- statusReplyReceivedString | statusTime | statusTime := self valueOfProperty: #lastStatusReplyTime ifAbsent: [^'none']. ^(self dateAndTimeStringFrom: statusTime),' accepts: ', (self valueOfProperty: #lastStatusReply) asArray printString! Item was changed: ----- Method: EToyGateKeeperMorph class>>acceptRequest:from:at: (in category 'as yet unclassified') ----- acceptRequest: requestType from: senderName at: ipAddressString | entry | UpdateCounter := self updateCounter + 1. entry := self entryForIPAddress: ipAddressString. senderName isEmpty ifFalse: [entry latestUserName: senderName]. ^entry requestAccessOfType: requestType! Item was changed: ----- Method: EToyGateKeeperMorph class>>entryForIPAddress: (in category 'as yet unclassified') ----- entryForIPAddress: ipAddressString | known entry | UpdateCounter := self updateCounter + 1. known := self knownIPAddresses. entry := known at: ipAddressString ifAbsentPut: [ entry := EToyGateKeeperEntry new. entry ipAddress: ipAddressString. entry ]. ^entry! Item was changed: ----- Method: EToyGateKeeperMorph class>>knownIPAddresses (in category 'as yet unclassified') ----- knownIPAddresses ^KnownIPAddresses ifNil: [KnownIPAddresses := Dictionary new]! Item was changed: ----- Method: EToyGateKeeperMorph class>>updateCounter (in category 'as yet unclassified') ----- updateCounter ^UpdateCounter ifNil: [UpdateCounter := 0]! Item was changed: ----- Method: EToyIncomingMessage class>>allTypes (in category 'message types') ----- allTypes ^MessageTypes ifNil: [ MessageTypes := { self typeKeyboardChat. self typeMorph. self typeFridge. self typeStatusRequest. self typeStatusReply. self typeSeeDesktop. self typeAudioChat. self typeAudioChatContinuous. self typeMultiChat. } ] ! Item was changed: ----- Method: EToyIncomingMessage class>>messageHandlers (in category 'as yet unclassified') ----- messageHandlers ^MessageHandlers ifNil: [MessageHandlers := Dictionary new].! Item was changed: ----- Method: EToyIncomingMessage class>>newObjectFromStream: (in category 'as yet unclassified') ----- newObjectFromStream: dataStream | newObject | [newObject := SmartRefStream objectFromStreamedRepresentation: dataStream upToEnd.] on: ProgressInitiationException do: [ :ex | ex sendNotificationsTo: [ :min :max :curr | "self flashIndicator: #working." ]. ]. "self resetIndicator: #working." ^newObject ! Item was changed: ----- Method: EToyIncomingMessage class>>registerType: (in category 'message types') ----- registerType: aMessageType MessageTypes := self allTypes copyWith: aMessageType! Item was changed: ----- Method: EToyIncomingMessage class>>unregisterType: (in category 'message types') ----- unregisterType: aMessageType MessageTypes := self allTypes copyWithout: aMessageType! Item was changed: ----- Method: EToyIncomingMessage>>incomingMessgage:fromIPAddress: (in category 'as yet unclassified') ----- incomingMessgage: dataStream fromIPAddress: ipAddress | nullChar messageType senderName selectorAndReceiver | nullChar := 0 asCharacter. messageType := dataStream upTo: nullChar. senderName := dataStream upTo: nullChar. (EToyGateKeeperMorph acceptRequest: messageType from: senderName at: ipAddress) ifFalse: [ ^self ]. selectorAndReceiver := self class messageHandlers at: messageType ifAbsent: [^self]. ^selectorAndReceiver second perform: selectorAndReceiver first withArguments: {dataStream. senderName. ipAddress} ! Item was changed: ----- Method: EToyListenerMorph class>>bumpUpdateCounter (in category 'as yet unclassified') ----- bumpUpdateCounter UpdateCounter := (UpdateCounter ifNil: [0]) + 1. ! Item was changed: ----- Method: EToyListenerMorph class>>commResultDeferred: (in category 'as yet unclassified') ----- commResultDeferred: anArrayOfAssociations | m ipAddress aDictionary | "to be run as part of the UI process in case user interaction is required" aDictionary := Dictionary new. anArrayOfAssociations do: [ :each | aDictionary add: each]. aDictionary at: #commFlash ifPresent: [ :ignore | ^self]. m := aDictionary at: #message ifAbsent: [^self]. m = 'OK' ifFalse: [^self]. ipAddress := NetNameResolver stringFromAddress: (aDictionary at: #ipAddress). EToyIncomingMessage new incomingMessgage: (ReadStream on: (aDictionary at: #data)) fromIPAddress: ipAddress ! Item was changed: ----- Method: EToyListenerMorph class>>critical: (in category 'as yet unclassified') ----- critical: aBlock QueueSemaphore ifNil: [QueueSemaphore := Semaphore forMutualExclusion]. ^QueueSemaphore critical: aBlock ! Item was changed: ----- Method: EToyListenerMorph class>>ensureListenerInCurrentWorld (in category 'as yet unclassified') ----- ensureListenerInCurrentWorld | w | w := self currentWorld. EToyListenerMorph allInstances detect: [ :each | each world == w] ifNone: [EToyListenerMorph new open]! Item was changed: ----- Method: EToyListenerMorph class>>globalIncomingQueue (in category 'as yet unclassified') ----- globalIncomingQueue ^GlobalIncomingQueue ifNil: [GlobalIncomingQueue := OrderedCollection new].! Item was changed: ----- Method: EToyListenerMorph class>>makeListeningToggle: (in category 'as yet unclassified') ----- makeListeningToggle: withEars | background c capExtent bgExtent earExtent earDeltaX earDeltaY botCent factor parts | factor := 2. bgExtent := (50@25) * factor. capExtent := (30@30) * factor. earExtent := (15@15) * factor. earDeltaX := capExtent x // 2. earDeltaY := capExtent y // 2. background := Form extent: bgExtent depth: 8. botCent := background boundingBox bottomCenter. c := background getCanvas. "c fillColor: Color white." parts := { (botCent - (capExtent // 2)) extent: capExtent. }. withEars ifTrue: [ parts := parts , { (botCent - (earDeltaX @ earDeltaY) - (earExtent // 2)) extent: earExtent. (botCent - (earDeltaX negated @ earDeltaY) - (earExtent // 2)) extent: earExtent. } ]. parts do: [ :each | c fillOval: each color: Color black borderWidth: 0 borderColor: Color black. ]. ^background "===== f2 := Form extent: 30@15 depth: 8. background displayInterpolatedOn: f2. f2 replaceColor: Color white withColor: Color transparent. ^f2 =====" ! Item was changed: ----- Method: EToyListenerMorph class>>makeListeningToggleNew: (in category 'as yet unclassified') ----- makeListeningToggleNew: activeMode | background c baseExtent bgExtent botCent factor len endPts base | factor := 2. bgExtent := (50@25) * factor. baseExtent := (15@15) * factor. background := Form extent: bgExtent depth: 8. botCent := background boundingBox bottomCenter. c := background getCanvas. "c fillColor: Color white." base := (botCent - (baseExtent // 2)) extent: baseExtent. c fillOval: base color: Color black borderWidth: 0 borderColor: Color black. activeMode ifTrue: [ len := background boundingBox height - 15. endPts := {botCent - (len@len). botCent - (len negated@len)}. endPts do: [ :each | c line: botCent to: each width: 2 color: Color black. ]. endPts do: [ :each | #(4 8 12) do: [ :offset | c frameOval: (each - offset corner: each + offset) color: Color red ]. ]. ]. "background asMorph openInWorld." ^background ! Item was changed: ----- Method: EToyListenerMorph class>>removeFromGlobalIncomingQueue: (in category 'as yet unclassified') ----- removeFromGlobalIncomingQueue: theActualObject self critical: [ GlobalIncomingQueue := self globalIncomingQueue reject: [ :each | each second == theActualObject ]. self bumpUpdateCounter. ].! Item was changed: ----- Method: EToyListenerMorph class>>shutDown: (in category 'system startup') ----- shutDown: quitting WasListeningAtShutdown := GlobalListener notNil. self stopListening. ! Item was changed: ----- Method: EToyListenerMorph class>>startListening (in category 'as yet unclassified') ----- startListening self stopListening. GlobalListener := EToyPeerToPeer new awaitDataFor: self. self bumpUpdateCounter. ! Item was changed: ----- Method: EToyListenerMorph class>>stopListening (in category 'as yet unclassified') ----- stopListening GlobalListener ifNotNil: [GlobalListener stopListening. GlobalListener := nil. self bumpUpdateCounter] "EToyListenerMorph stopListening"! Item was changed: ----- Method: EToyListenerMorph>>addNewObject:thumbForm:sentBy:ipAddress: (in category 'as yet unclassified') ----- addNewObject: newObject thumbForm: aForm sentBy: senderName ipAddress: ipAddressString | thumb row | thumb := aForm asMorph. thumb setProperty: #depictedObject toValue: newObject. row := self addARow: { thumb. self inAColumn: { StringMorph new contents: senderName; lock. StringMorph new contents: ipAddressString; lock. } }. true ifTrue: [ "simpler protocol" row on: #mouseUp send: #mouseUpEvent:for: to: self. ] ifFalse: [ row on: #mouseDown send: #mouseDownEvent:for: to: self. ]. ! Item was changed: ----- Method: EToyListenerMorph>>delete (in category 'submorphs-add/remove') ----- delete listener ifNotNil: [listener stopListening. listener := nil]. "for old instances that were locally listening" super delete.! Item was changed: ----- Method: EToyListenerMorph>>mouseUpEvent:for: (in category 'as yet unclassified') ----- mouseUpEvent: event for: aMorph | depictedObject | depictedObject := aMorph firstSubmorph valueOfProperty: #depictedObject. event hand attachMorph: depictedObject. self class removeFromGlobalIncomingQueue: depictedObject. self rebuild. ! Item was changed: ----- Method: EToyListenerMorph>>rebuild (in category 'as yet unclassified') ----- rebuild | earMorph | updateCounter := UpdateCounter. self removeAllMorphs. self addGateKeeperMorphs. GlobalListener ifNil: [ earMorph := (self class makeListeningToggleNew: false) asMorph. earMorph setBalloonText: 'Click to START listening for messages'. earMorph on: #mouseUp send: #startListening to: self. ] ifNotNil: [ earMorph := (self class makeListeningToggleNew: true) asMorph. earMorph setBalloonText: 'Click to STOP listening for messages'. earMorph on: #mouseUp send: #stopListening to: self. ]. self addARow: {self inAColumn: {earMorph}}. self addARow: { self inAColumn: {(StringMorph contents: 'Incoming communications') lock}. self indicatorFieldNamed: #working color: Color blue help: 'working'. self indicatorFieldNamed: #communicating color: Color green help: 'receiving'. }. "{thumbForm. newObject. senderName. ipAddressString}" self class globalIncomingQueueCopy do: [ :each | self addNewObject: each second thumbForm: each first sentBy: each third ipAddress: each fourth. ].! Item was changed: ----- Method: EToyListenerMorph>>step (in category 'stepping and presenter') ----- step | needRebuild | super step. needRebuild := false. (self valueOfProperty: #gateKeeperCounterValue) = EToyGateKeeperMorph updateCounter ifFalse: [needRebuild := true]. updateCounter = UpdateCounter ifFalse: [ needRebuild := true. ]. needRebuild ifTrue: [self rebuild]. ! Item was changed: ----- Method: EToyMorphsWelcomeMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" | earMorph | super initialize. "" self layoutInset: 8 @ 8. "earMorph := (EToyListenerMorph makeListeningToggle: true) asMorph." earMorph := TextMorph new contents: 'Morphs welcome here'; fontName: Preferences standardEToysFont familyName size: 18; centered; lock. self addARow: {earMorph}. self setBalloonText: 'My presence in this world means received morphs may appear automatically'! Item was changed: ----- Method: EToyMultiChatMorph>>acceptTo:forMorph: (in category 'as yet unclassified') ----- acceptTo: someText forMorph: aMorph | streamedMessage betterText | betterText := self improveText: someText forMorph: aMorph. streamedMessage := {targetIPAddresses. betterText} eToyStreamedRepresentationNotifying: self. targetIPAddresses do: [ :each | self transmitStreamedObject: streamedMessage to: each. ]. aMorph setText: '' asText. self appendMessage: self startOfMessageFromMe, ' - ', betterText, String cr. ^true! Item was changed: ----- Method: EToyMultiChatMorph>>editEvent:for: (in category 'as yet unclassified') ----- editEvent: anEvent for: aMorph | answer initialText aFillInTheBlankMorph | (aMorph bounds containsPoint: anEvent cursorPoint) ifFalse: [^self]. initialText := String streamContents: [ :strm | targetIPAddresses do: [ :each | strm nextPutAll: each; cr]. ]. aFillInTheBlankMorph := FillInTheBlankMorph new setQuery: 'Who are you chatting with?' initialAnswer: initialText answerHeight: 250 acceptOnCR: false. aFillInTheBlankMorph responseUponCancel: nil. self world addMorph: aFillInTheBlankMorph centeredNear: anEvent cursorPoint. answer := aFillInTheBlankMorph getUserResponse. answer ifNil: [^self]. self updateIPAddressField: (answer findTokens: ' ',String cr). ! Item was changed: ----- Method: EToyMultiChatMorph>>initialize (in category 'initialization') ----- initialize targetIPAddresses := OrderedCollection new. super initialize. bounds := 0@0 extent: 350@350.! Item was changed: ----- Method: EToyMultiChatMorph>>rebuild (in category 'as yet unclassified') ----- rebuild | r1 r2 | r1 := self addARow: { self simpleToggleButtonFor: self attribute: #acceptOnCR help: 'Send with Return?'. self inAColumn: {StringMorph new contents: 'Multi chat with:'; lock}. self textEntryFieldNamed: #ipAddress with: '' help: 'Click to edit participant list'. }. sendingPane := PluggableTextMorph on: self text: nil accept: #acceptTo:forMorph:. sendingPane hResizing: #spaceFill; vResizing: #spaceFill. self addMorphBack: sendingPane. r2 := self addARow: {self inAColumn: {StringMorph new contents: 'Replies'; lock}}. receivingPane := PluggableTextMorph on: self text: nil accept: nil. receivingPane hResizing: #spaceFill; vResizing: #spaceFill. self addMorphBack: receivingPane. receivingPane spaceFillWeight: 3. {r1. r2} do: [ :each | each vResizing: #shrinkWrap; minHeight: 18; color: Color veryLightGray. ]. self updateIPAddressField: targetIPAddresses. sendingPane acceptOnCR: (acceptOnCR ifNil: [acceptOnCR := true]).! Item was changed: ----- Method: EToyPeerToPeer class>>transmitStreamedObject:as:to:for: (in category 'as yet unclassified') ----- transmitStreamedObject: outData as: objectCategory to: anIPAddress for: aCommunicator | null | null := String with: 0 asCharacter. self new sendSomeData: { objectCategory,null. Preferences defaultAuthorName,null. outData } to: anIPAddress for: aCommunicator ! Item was changed: ----- Method: EToyPeerToPeer>>awaitDataFor: (in category 'receiving') ----- awaitDataFor: aCommunicatorMorph Socket initializeNetwork. connectionQueue := ConnectionQueue portNumber: self class eToyCommunicationsPort queueLength: 6. communicatorMorph := aCommunicatorMorph. process := [self doAwaitData] newProcess. process priority: Processor highIOPriority. process resume. ! Item was changed: ----- Method: EToyPeerToPeer>>doConnectForSend (in category 'sending') ----- doConnectForSend | addr | addr := NetNameResolver addressForName: ipAddress. addr ifNil: [ communicatorMorph commResult: {#message -> ('could not find ',ipAddress)}. ^false ]. socket connectNonBlockingTo: addr port: self class eToyCommunicationsPort. [socket waitForConnectionFor: 15] on: ConnectionTimedOut do: [:ex | communicatorMorph commResult: {#message -> ('no connection to ',ipAddress,' (', (NetNameResolver stringFromAddress: addr),')')}. ^false]. ^true ! Item was changed: ----- Method: EToyPeerToPeer>>doReceiveOneMessage (in category 'receiving') ----- doReceiveOneMessage | awaitingLength i length answer | awaitingLength := true. answer := WriteStream on: String new. [awaitingLength] whileTrue: [ leftOverData := leftOverData , socket receiveData. (i := leftOverData indexOf: $ ) > 0 ifTrue: [ awaitingLength := false. length := (leftOverData first: i - 1) asNumber. answer nextPutAll: (leftOverData allButFirst: i). ]. ]. leftOverData := ''. [answer size < length] whileTrue: [ answer nextPutAll: socket receiveData. communicatorMorph commResult: {#commFlash -> true}. ]. answer := answer contents. answer size > length ifTrue: [ leftOverData := answer allButFirst: length. answer := answer first: length ]. ^answer ! Item was changed: ----- Method: EToyPeerToPeer>>doSendData (in category 'sending') ----- doSendData | totalLength myData allTheData | myData := dataQueue next ifNil: [socket sendData: '0 '. ^false]. totalLength := (myData collect: [ :x | x size]) sum. socket sendData: totalLength printString,' '. allTheData := WriteStream on: (String new: totalLength). myData do: [ :chunk | allTheData nextPutAll: chunk asString]. NebraskaDebug at: #peerBytesSent add: {totalLength}. self sendDataCautiously: allTheData contents. ^true ! Item was changed: ----- Method: EToyPeerToPeer>>receiveDataOn:for: (in category 'receiving') ----- receiveDataOn: aSocket for: aCommunicatorMorph socket := aSocket. remoteSocketAddress := socket remoteAddress. communicatorMorph := aCommunicatorMorph. process := [ leftOverData := ''. [self doReceiveData] whileTrue. socket closeAndDestroy. ] newProcess. process priority: Processor highIOPriority. process resume. ! Item was changed: ----- Method: EToyPeerToPeer>>sendDataCautiously: (in category 'sending') ----- sendDataCautiously: aStringOrByteArray "Send all of the data in the given array, even if it requires multiple calls to send it all. Return the number of bytes sent. Try not to send too much at once since this seemed to cause problems talking to a port on the same machine" | bytesSent bytesToSend count | bytesToSend := aStringOrByteArray size. bytesSent := 0. [bytesSent < bytesToSend] whileTrue: [ count := socket sendSomeData: aStringOrByteArray startIndex: bytesSent + 1 count: (bytesToSend - bytesSent min: 4000). bytesSent := bytesSent + count. communicatorMorph commResult: {#commFlash -> true}. (Delay forMilliseconds: 10) wait. ]. ^ bytesSent ! Item was changed: ----- Method: EToyPeerToPeer>>sendSomeData:to:for: (in category 'sending') ----- sendSomeData: arrayOfByteObjects to: anIPAddress for: aCommunicatorMorph dataQueue := self sendSomeData: arrayOfByteObjects to: anIPAddress for: aCommunicatorMorph multiple: false. dataQueue nextPut: nil. "only this message to send" ! Item was changed: ----- Method: EToyPeerToPeer>>sendSomeData:to:for:multiple: (in category 'sending') ----- sendSomeData: arrayOfByteObjects to: anIPAddress for: aCommunicatorMorph multiple: aBoolean Socket initializeNetwork. socket := Socket newTCP. dataQueue := SharedQueue new. dataQueue nextPut: arrayOfByteObjects. communicatorMorph := aCommunicatorMorph. ipAddress := anIPAddress. process := [ self doConnectForSend ifTrue: [ [self doSendData] whileTrue. communicatorMorph commResult: {#message -> 'OK'}. socket closeAndDestroy. ]. ] newProcess. process priority: Processor highIOPriority. process resume. ^dataQueue ! Item was changed: ----- Method: EToyPeerToPeer>>stopListening (in category 'receiving') ----- stopListening process ifNotNil: [process terminate. process := nil]. connectionQueue ifNotNil: [connectionQueue destroy. connectionQueue := nil]. ! Item was changed: ----- Method: EToySenderMorph class>>nameForIPAddress: (in category 'as yet unclassified') ----- nameForIPAddress: ipString | senderMorphs | senderMorphs := EToySenderMorph allInstances select: [ :x | x userName notNil and: [x ipAddress = ipString] ]. senderMorphs isEmpty ifTrue: [^nil]. ^senderMorphs first userName ! Item was changed: ----- Method: EToySenderMorph class>>pictureForIPAddress: (in category 'as yet unclassified') ----- pictureForIPAddress: ipString | senderMorphs | senderMorphs := EToySenderMorph allInstances select: [ :x | x userPicture notNil and: [x ipAddress = ipString] ]. senderMorphs isEmpty ifTrue: [^nil]. ^senderMorphs first userPicture ! Item was changed: ----- Method: EToySenderMorph>>aboutToBeGrabbedBy: (in category 'dropping/grabbing') ----- aboutToBeGrabbedBy: aHand | aFridge | super aboutToBeGrabbedBy: aHand. aFridge := self ownerThatIsA: EToyFridgeMorph. aFridge ifNil: [^self]. aFridge noteRemovalOf: self.! Item was changed: ----- Method: EToySenderMorph>>acceptDroppingMorph:event: (in category 'layout') ----- acceptDroppingMorph: morphToDrop event: evt | myCopy outData | (morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt. ]. self eToyRejectDropMorph: morphToDrop event: evt. "we don't really want it" "7 mar 2001 - remove #veryDeepCopy" myCopy := morphToDrop. "gradient fills require doing this second" myCopy setProperty: #positionInOriginatingWorld toValue: morphToDrop position. self stopFlashing. outData := myCopy eToyStreamedRepresentationNotifying: self. self resetIndicator: #working. self transmitStreamedObject: outData to: self ipAddress. ! Item was changed: ----- Method: EToySenderMorph>>fixOldVersion (in category 'as yet unclassified') ----- fixOldVersion | uName uForm uEmail uIP | uName := self userName. uForm := userPicture ifNil: [ (self findDeepSubmorphThat: [ :x | (x isKindOf: ImageMorph) or: [x isSketchMorph]] ifAbsent: [self halt]) form. ]. uEmail := (fields at: #emailAddress) contents. uIP := self ipAddress. self userName: uName userPicture: (uForm scaledToSize: 61@53) userEmail: uEmail userIPAddress: uIP ! Item was changed: ----- Method: EToySenderMorph>>killExistingChat (in category 'as yet unclassified') ----- killExistingChat | oldOne | self rubberBandCells: true. "disable growing" (oldOne := self valueOfProperty: #embeddedChatHolder) ifNotNil: [ oldOne delete. self removeProperty: #embeddedChatHolder ]. (oldOne := self valueOfProperty: #embeddedAudioChatHolder) ifNotNil: [ oldOne delete. self removeProperty: #embeddedAudioChatHolder ]. ! Item was changed: ----- Method: EToySenderMorph>>mouseEnteredDZ (in category 'as yet unclassified') ----- mouseEnteredDZ | dz | dz := self valueOfProperty: #specialDropZone ifAbsent: [^self]. dz color: Color blue.! Item was changed: ----- Method: EToySenderMorph>>mouseLeftDZ (in category 'as yet unclassified') ----- mouseLeftDZ | dz | dz := self valueOfProperty: #specialDropZone ifAbsent: [^self]. dz color: Color transparent.! Item was changed: ----- Method: EToySenderMorph>>sendStatusCheck (in category 'as yet unclassified') ----- sendStatusCheck | null | null := String with: 0 asCharacter. EToyPeerToPeer new sendSomeData: { EToyIncomingMessage typeStatusRequest,null. Preferences defaultAuthorName,null. } to: self ipAddress for: self. ! Item was changed: ----- Method: EToySenderMorph>>sendStatusReply (in category 'as yet unclassified') ----- sendStatusReply | null | null := String with: 0 asCharacter. EToyPeerToPeer new sendSomeData: { EToyIncomingMessage typeStatusReply,null. Preferences defaultAuthorName,null. ((EToyGateKeeperMorph acceptableTypesFor: self ipAddress) eToyStreamedRepresentationNotifying: self). } to: self ipAddress for: self. ! Item was changed: ----- Method: EToySenderMorph>>startChat: (in category 'as yet unclassified') ----- startChat: toggleMode | chat r | (self valueOfProperty: #embeddedChatHolder) ifNotNil: [ toggleMode ifFalse: [^self]. ^self killExistingChat ]. (EToyChatMorph doChatsInternalToBadge and: [(self ownerThatIsA: EToyFridgeMorph) isNil]) ifTrue: [ chat := EToyChatMorph basicNew recipientForm: userPicture; initialize; setIPAddress: self ipAddress. chat vResizing: #spaceFill; hResizing: #spaceFill; borderWidth: 2; insetTheScrollbars. r := (self addARow: {chat}) vResizing: #spaceFill. self rubberBandCells: false. "enable growing" self height: 350. "an estimated guess for allowing shrinking as well as growing" self world startSteppingSubmorphsOf: chat. self setProperty: #embeddedChatHolder toValue: r. ] ifFalse: [ chat := EToyChatMorph chatWindowForIP: self ipAddress name: self userName picture: userPicture inWorld: self world. chat owner addMorphFront: chat. ] ! Item was changed: ----- Method: EToySenderMorph>>userName:userPicture:userEmail:userIPAddress: (in category 'as yet unclassified') ----- userName: aString userPicture: aFormOrNil userEmail: emailString userIPAddress: ipString | dropZoneRow | self setProperty: #currentBadgeVersion toValue: self currentBadgeVersion. userPicture := aFormOrNil ifNil: [ (TextStyle default fontOfSize: 26) emphasized: 1; characterFormAt: $? ]. userPicture := userPicture scaledToSize: 61@53. self killExistingChat. self removeAllMorphs. self useRoundedCorners. self addARow: { self inAColumn: {(StringMorph contents: aString) lock} }. dropZoneRow := self addARow: { self inAColumn: {userPicture asMorph lock} }. self establishDropZone: dropZoneRow. self addARow: { self textEntryFieldNamed: #emailAddress with: emailString help: 'Email address for this person' }; addARow: { self textEntryFieldNamed: #ipAddress with: ipString help: 'IP address for this person' }; addARow: { self indicatorFieldNamed: #working color: Color blue help: 'working'. self indicatorFieldNamed: #communicating color: Color green help: 'sending'. self buttonNamed: 'C' action: #startChat color: Color paleBlue help: 'Open a written chat with this person'. self buttonNamed: 'T' action: #startTelemorphic color: Color paleYellow help: 'Start telemorphic with this person'. self buttonNamed: '!!' action: #tellAFriend color: Color paleGreen help: 'Tell this person about the current project'. self buttonNamed: '?' action: #checkOnAFriend color: Color lightBrown help: 'See if this person is available'. self buttonNamed: 'A' action: #startAudioChat color: Color yellow help: 'Open an audio chat with this person'. self buttonNamed: 'S' action: #startNebraskaClient color: Color white help: 'See this person''s world (if he allows that)'. }. ! Item was changed: ----- Method: EToySenderMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') ----- wantsDroppedMorph: aMorph event: evt | dz | dz := self valueOfProperty: #specialDropZone ifAbsent: [^false]. (dz bounds containsPoint: (evt cursorPoint)) ifFalse: [^false]. ^true.! Item was changed: ----- Method: Form>>deltaFrom: (in category '*nebraska-encoding') ----- deltaFrom: previousForm | newForm | newForm := previousForm deepCopy. (BitBlt destForm: newForm sourceForm: self fillColor: nil combinationRule: Form reverse destOrigin: 0@0 sourceOrigin: 0@0 extent: self extent clipRect: self boundingBox) copyBits. ^newForm! Item was changed: ----- Method: Form>>deltaFrom:at: (in category '*nebraska-encoding') ----- deltaFrom: smallerForm at: offsetInMe | newForm | newForm := smallerForm deepCopy. (BitBlt destForm: newForm sourceForm: self fillColor: nil combinationRule: Form reverse destOrigin: 0@0 sourceOrigin: offsetInMe extent: smallerForm extent clipRect: newForm boundingBox) copyBits. ^newForm! Item was changed: ----- Method: LoopbackStringSocket class>>clearStats (in category 'as yet unclassified') ----- clearStats WRITESTRINGSIZES := nil! Item was changed: ----- Method: LoopbackStringSocket>>destroy (in category 'as yet unclassified') ----- destroy associate := inArrays := outArrays := nil.! Item was changed: ----- Method: MatrixTransform2x3 class>>fromRemoteCanvasEncoding: (in category '*nebraska-instance creation') ----- fromRemoteCanvasEncoding: encoded "DisplayTransform fromRemoteCanvasEncoding: 'Matrix,1065353216,0,1137541120,0,1065353216,1131610112,'" | nums transform encodedNums | "split the numbers up" encodedNums := encoded findTokens: ','. "remove the initial 'Matrix' specification" encodedNums := encodedNums asOrderedCollection. encodedNums removeFirst. "parse the numbers" nums := encodedNums collect: [ :enum | Integer readFromString: enum ]. "create an instance" transform := self new. "plug in the numbers" nums doWithIndex: [ :num :i | transform basicAt: i put: num ]. ^transform! Item was changed: ----- Method: NebraskaClient>>convertToBuffered (in category 'initialization') ----- convertToBuffered canvas purgeOutputQueue. canvas := canvas asBufferedCanvas.! Item was changed: ----- Method: NebraskaClient>>destroy (in category 'initialization') ----- destroy hand ifNotNil:[hand world ifNotNil:[hand world removeHand: hand]]. connection ifNotNil:[connection destroy]. encoder := canvas := hand := connection := nil.! Item was changed: ----- Method: NebraskaDebug class>>at:add: (in category 'as yet unclassified') ----- at: queueName add: anArray | now | DEBUG ifNil: [ queueName == #sketchZZZ ifFalse: [^self]. "Details := OrderedCollection new." self beginStats. ]. (Details notNil and: [Details size < 20]) ifTrue: [ Details add: thisContext longStack ]. now := Time millisecondClockValue. DEBUG add: {now},anArray,{queueName}. ! Item was changed: ----- Method: NebraskaDebug class>>beginStats (in category 'as yet unclassified') ----- beginStats DEBUG := OrderedCollection new! Item was changed: ----- Method: NebraskaDebug class>>killStats (in category 'as yet unclassified') ----- killStats DEBUG := nil. ! Item was changed: ----- Method: NebraskaDebug class>>showAndClearStats: (in category 'as yet unclassified') ----- showAndClearStats: queueName DEBUG ifNil: [^Beeper beep]. self showStats: queueName from: DEBUG. DEBUG := nil.! Item was changed: ----- Method: NebraskaDebug class>>stopAndShowAll (in category 'as yet unclassified') ----- stopAndShowAll | prev | self halt. "not updated to new format" prev := DEBUG. DEBUG := nil. prev ifNil: [^Beeper beep]. prev keysAndValuesDo: [ :k :v | self showStats: k from: v ].! Item was changed: ----- Method: NebraskaNavigationMorph>>nebraskaBorder: (in category 'as yet unclassified') ----- nebraskaBorder: aNebraskaBorder nebraskaBorder := aNebraskaBorder! Item was changed: ----- Method: NebraskaNavigationMorph>>nebraskaTerminal: (in category 'as yet unclassified') ----- nebraskaTerminal: aNebraskaTerminal nebraskaTerminal := aNebraskaTerminal! Item was changed: ----- Method: NebraskaNavigationMorph>>positionVertically (in category 'as yet unclassified') ----- positionVertically | w | w := self world ifNil: [^self]. self top < w top ifTrue: [self top: w top]. self bottom > w bottom ifTrue: [self bottom: w bottom].! Item was changed: ----- Method: NebraskaServer class>>serveWorld:onPort: (in category 'instance creation') ----- serveWorld: aWorld onPort: aPortNumber | server | Utilities authorName. "since we will need it later" server := self newForWorld: aWorld. server startListeningOnPort: aPortNumber. ^server "server acceptNullConnection" "server acceptPhonyConnection." ! Item was changed: ----- Method: NebraskaServer>>acceptNullConnection (in category 'networking') ----- acceptNullConnection | twins | twins := LoopbackStringSocket newPair. self addClientFromConnection: twins first. (NullTerminalMorph new connection: twins second) openInWorld. ! Item was changed: ----- Method: NebraskaServer>>acceptPhonyConnection (in category 'networking') ----- acceptPhonyConnection | twins | twins := LoopbackStringSocket newPair. self addClientFromConnection: twins first. (NetworkTerminalMorph new connection: twins second) inspect "openInWorld". ! Item was changed: ----- Method: NebraskaServer>>initializeForWorld: (in category 'initialization') ----- initializeForWorld: aWorld world := aWorld. clients := IdentitySet new. self extent: world extent depth: Display depth. aWorld remoteServer: self.! Item was changed: ----- Method: NebraskaServerMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" fullDisplay := false. lastFullUpdateTime := 0. self listDirection: #topToBottom; hResizing: #shrinkWrap; vResizing: #shrinkWrap! Item was changed: ----- Method: NebraskaServerMorph>>rebuild (in category 'initialization') ----- rebuild | myServer toggle closeBox font | font := StrikeFont familyName: #Palatino size: 14. self removeAllMorphs. self setColorsAndBorder. self updateCurrentStatusString. toggle := SimpleHierarchicalListMorph new perform: ( fullDisplay ifTrue: [#expandedForm] ifFalse: [#notExpandedForm] ). closeBox := SimpleButtonMorph new borderWidth: 0; label: 'X' font: Preferences standardButtonFont; color: Color transparent; actionSelector: #delete; target: self; extent: 14@14; setBalloonText: 'End Nebrasks session'. self addARow: { self inAColumn: {closeBox}. self inAColumn: { UpdatingStringMorph new useStringFormat; target: self; font: font; getSelector: #currentStatusString; contents: self currentStatusString; stepTime: 2000; lock. }. self inAColumn: { toggle asMorph on: #mouseUp send: #toggleFull to: self; setBalloonText: 'Show more or less of Nebraska Status' }. }. myServer := self server. (myServer isNil or: [fullDisplay not]) ifTrue: [ ^World startSteppingSubmorphsOf: self ]. "--- the expanded display ---" self addARow: { self inAColumn: { UpdatingStringMorph new useStringFormat; target: self; font: font; getSelector: #currentBacklogString; contents: self currentBacklogString; stepTime: 2000; lock. }. }. self addARow: { self inAColumn: { (StringMorph contents: '--clients--' translated) lock; font: font. }. }. myServer clients do: [ :each | self addARow: { UpdatingStringMorph new useStringFormat; target: each; font: font; getSelector: #currentStatusString; contents: each currentStatusString; stepTime: 2000; lock. } ]. World startSteppingSubmorphsOf: self.! Item was changed: ----- Method: NebraskaServerMorph>>step (in category 'stepping and presenter') ----- step | now | self server ifNil: [ ^self ]. self server step. now := Time millisecondClockValue. (now - lastFullUpdateTime) abs > 5000 ifTrue: [ lastFullUpdateTime := now. (previousBacklog = self server backlog and: [self server clients = previousClients]) ifFalse: [ previousClients := self server clients copy. self rebuild ] ]. ! Item was changed: ----- Method: NebraskaServerMorph>>toggleFull (in category 'initialization') ----- toggleFull fullDisplay := fullDisplay not. self rebuild. ! Item was changed: ----- Method: NebraskaServerMorph>>updateCurrentStatusString (in category 'drawing') ----- updateCurrentStatusString self server ifNil:[ currentStatusString := '<Nebraska not active>' translated. currentBacklogString := ''. ] ifNotNil:[ currentStatusString := ' Nebraska: ' translated, self server numClients printString, ' clients' translated. currentBacklogString := 'backlog: ' translated, ((previousBacklog := self server backlog) // 1024) printString,'k' ]. ! Item was changed: ----- Method: NetworkTerminalBorderMorph>>toggleFullView (in category 'as yet unclassified') ----- toggleFullView "Toggle the full view for network terminal" | fullExtent priorExtent | fullExtent := self worldIEnclose extent + (2 * self borderWidth). priorExtent := self valueOfProperty: #priorExtent. priorExtent ifNil:[ self setProperty: #priorExtent toValue: self extent. self extent: fullExtent. self position: self position + self borderWidth asPoint negated. ] ifNotNil:[ self removeProperty: #priorExtent. self extent: priorExtent. self position: (self position max: 0@0). ].! Item was changed: ----- Method: NetworkTerminalMorph class>>connectTo:port: (in category 'instance creation') ----- connectTo: serverHost port: serverPort | stringSock | stringSock := self socketConnectedTo: serverHost port: serverPort. ^self new connection: stringSock ! Item was changed: ----- Method: NetworkTerminalMorph class>>openAndConnectTo:port: (in category 'instance creation') ----- openAndConnectTo: serverHost port: serverPort | stringSock me | stringSock := self socketConnectedTo: serverHost port: serverPort. me := self new connection: stringSock. ^me openInStyle: #naked ! Item was changed: ----- Method: NetworkTerminalMorph class>>socketConnectedTo:port: (in category 'instance creation') ----- socketConnectedTo: serverHost port: serverPort | sock | Socket initializeNetwork. sock := Socket new. [sock connectTo: (NetNameResolver addressForName: serverHost) port: serverPort] on: ConnectionTimedOut do: [:ex | self error: 'could not connect to server' ]. ^StringSocket on: sock ! Item was changed: ----- Method: NetworkTerminalMorph>>acceptDroppingMorph:event: (in category 'layout') ----- acceptDroppingMorph: morphToDrop event: evt | myCopy outData null | (morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt. ]. self eToyRejectDropMorph: morphToDrop event: evt. "we don't really want it" "7 mar 2001 - remove #veryDeepCopy" myCopy := morphToDrop. "gradient fills require doing this second" myCopy setProperty: #positionInOriginatingWorld toValue: morphToDrop position. outData := myCopy eToyStreamedRepresentationNotifying: nil. null := String with: 0 asCharacter. EToyPeerToPeer new sendSomeData: { EToyIncomingMessage typeMorph,null. Preferences defaultAuthorName,null. outData } to: (NetNameResolver stringFromAddress: connection remoteAddress) for: self. ! Item was changed: ----- Method: NetworkTerminalMorph>>forceToFront: (in category 'drawing') ----- forceToFront: aRegion | highQuality | "force the given region from the drawing form onto the background form" highQuality := false. "highQuality is slower" self updateBackgroundForm. backgroundForm copy: aRegion from: aRegion topLeft in: decoder drawingForm rule: Form over. self invalidRect: ( highQuality ifTrue: [ bounds ] ifFalse: [ (aRegion expandBy: 4) translateBy: bounds topLeft "try to remove gribblys" ] ) ! Item was changed: ----- Method: NetworkTerminalMorph>>initialize (in category 'initialization') ----- initialize super initialize. backgroundForm := ( (StringMorph contents: '......' font: (TextStyle default fontOfSize: 24)) color: Color white ) imageForm. bounds := backgroundForm boundingBox. ! Item was changed: ----- Method: NetworkTerminalMorph>>openScaled (in category 'initialization') ----- openScaled | window tm | window := NetworkTerminalBorderMorph new minWidth: 100; minHeight: 100; borderWidth: 8; borderColor: Color orange; bounds: (0@0 extent: Display extent * 3 // 4). tm := BOBTransformationMorph new. tm useRegularWarpBlt: true. "try to reduce memory used" window addMorphBack: tm. tm addMorph: self. window openInWorld. NebraskaNavigationMorph new nebraskaBorder: window; nebraskaTerminal: self; openInWorld.! Item was changed: ----- Method: NetworkTerminalMorph>>updateBackgroundForm (in category 'drawing') ----- updateBackgroundForm "make sure that our background form matches what the server has most recently requested" | drawingForm | drawingForm := decoder drawingForm. (drawingForm extent = backgroundForm extent and: [ drawingForm depth = backgroundForm depth ]) ifTrue: [ "they match just fine" ^self ]. backgroundForm := drawingForm deepCopy. "need copy to capture the moment" self extent: backgroundForm extent.! Item was changed: ----- Method: NullTerminalMorph>>extent: (in category 'geometry') ----- extent: newExtent | aPoint | aPoint := 50@50. bounds extent = aPoint ifFalse: [ self changed. bounds := bounds topLeft extent: aPoint. self layoutChanged. self changed ]. eventEncoder sendViewExtent: newExtent! Item was changed: ----- Method: ObjectSocket>>destroy (in category 'as yet unclassified') ----- destroy socket destroy. socket := nil.! Item was changed: ----- Method: RemoteCanvas>>asBufferedCanvas (in category 'initialization') ----- asBufferedCanvas | bufferedCanvas | bufferedCanvas := BufferedCanvas new. connection cachingEnabled: false. bufferedCanvas connection: connection clipRect: NebraskaServer extremelyBigRectangle transform: MorphicTransform identity remoteCanvas: self. ^bufferedCanvas! Item was changed: ----- Method: RemoteCanvas>>clipBy:during: (in category 'drawing-support') ----- clipBy: aRectangle during: aBlock | newCanvas newR | "Set a clipping rectangle active only during the execution of aBlock." newR := transform localBoundsToGlobal: aRectangle. newCanvas := RemoteCanvas connection: connection clipRect: (outerClipRect intersect: newR) transform: transform. newCanvas privateShadowColor: shadowColor. aBlock value: newCanvas. connection shadowColor: shadowColor.! Item was changed: ----- Method: RemoteCanvas>>paragraph:bounds:color: (in category 'drawing') ----- paragraph: paragraph bounds: bounds color: c | scanner | scanner := CanvasCharacterScanner new. scanner canvas: self; text: paragraph text textStyle: paragraph textStyle; textColor: c; defaultTextColor: c. paragraph displayOn: self using: scanner at: bounds topLeft. ! Item was changed: ----- Method: RemoteCanvas>>privateShadowColor: (in category 'drawing-support') ----- privateShadowColor: x shadowColor := x. ! Item was changed: ----- Method: RemoteCanvas>>shadowColor: (in category 'accessing') ----- shadowColor: x connection shadowColor: (shadowColor := x). ! Item was changed: ----- Method: RemoteControlledHandMorph>>nebraskaClient: (in category 'initialization') ----- nebraskaClient: aNebraskaClient nebraskaClient := aNebraskaClient! Item was changed: ----- Method: StringSocket class>>clearRatesSeen (in category 'as yet unclassified') ----- clearRatesSeen " StringSocket clearRatesSeen " MaxRatesSeen := nil ! Item was changed: ----- Method: StringSocket class>>compareFiles (in category 'as yet unclassified') ----- compareFiles " StringSocket compareFiles " | data1 data2 | data1 := (FileStream fileNamed: 'Macintosh HD:bob:nebraska test:58984048.1') contentsOfEntireFile. data2 := (FileStream fileNamed: 'BobsG3:squeak:dsqueak:DSqueak2.7 folder:58795431.3') contentsOfEntireFile. 1 to: (data1 size min: data2 size) do: [ :i | (data1 at: i) = (data2 at: i) ifFalse: [self halt]. ]. ! Item was changed: ----- Method: StringSocket>>addToOutBuf: (in category 'private-IO') ----- addToOutBuf: arrayToWrite | size newAlloc | size := self spaceToEncode: arrayToWrite. newAlloc := size * 2 max: 8000. "gives us room to grow" outBuf ifNil: [ outBuf := String new: newAlloc. outBufIndex := 1. ]. outBuf size - outBufIndex + 1 < size ifTrue: [ outBuf := outBuf , (String new: newAlloc). ]. CanvasEncoder at: 1 count: arrayToWrite size + 1. outBuf putInteger32: arrayToWrite size at: outBufIndex. outBufIndex := outBufIndex + 4. arrayToWrite do: [ :each | outBuf putInteger32: each size at: outBufIndex. outBufIndex := outBufIndex + 4. outBuf replaceFrom: outBufIndex to: outBufIndex + each size - 1 with: each startingAt: 1. outBufIndex := outBufIndex + each size. ]. ^size! Item was changed: ----- Method: StringSocket>>destroy (in category 'as yet unclassified') ----- destroy socketWriterProcess ifNotNil: [socketWriterProcess terminate. socketWriterProcess := nil]. outputQueue := nil. bytesInOutputQueue := 0. socket ifNotNil: [socket destroy. socket := nil.]. ! Item was changed: ----- Method: StringSocket>>inBufNext: (in category 'private-IO') ----- inBufNext: anInteger | answer | answer := inBuf copyFrom: inBufIndex to: inBufIndex + anInteger - 1. inBufIndex := inBufIndex + anInteger. ^answer! Item was changed: ----- Method: StringSocket>>initialize: (in category 'as yet unclassified') ----- initialize: aSocket transmissionError := false. super initialize: aSocket. outputQueue := SharedQueue new. extraUnsentBytes := bytesInOutputQueue := 0. socketWriterProcess := [ [self transmitQueueNext] whileTrue. socketWriterProcess := nil. outputQueue := nil. bytesInOutputQueue := 0. ] forkAt: Processor lowIOPriority.! Item was changed: ----- Method: StringSocket>>processOutput (in category 'private-IO') ----- processOutput | arrayToWrite size bytesSent timeStartSending t itemsSent now timeSlot bucketAgeInMS bytesThisSlot | outBufIndex := 1. itemsSent := bytesSent := 0. timeStartSending := Time millisecondClockValue. [outObjects isEmpty not and: [self isConnected]] whileTrue: [ arrayToWrite := outObjects removeFirst. size := self addToOutBuf: arrayToWrite. bytesSent := bytesSent + size. itemsSent := itemsSent + 1. outBufIndex > 10000 ifTrue: [self queueOutBufContents]. ]. outBufIndex > 1 ifTrue: [self queueOutBufContents]. bytesSent > 0 ifTrue: [ MaxRatesSeen ifNil: [MaxRatesSeen := Dictionary new]. now := Time millisecondClockValue. t := now - timeStartSending. timeSlot := now // 10000. "ten second buckets" bucketAgeInMS := now \\ 10. bytesThisSlot := (MaxRatesSeen at: timeSlot ifAbsent: [0]) + bytesSent. MaxRatesSeen at: timeSlot put: bytesThisSlot. NebraskaDebug at: #SendReceiveStats add: {'put'. bytesSent. t. itemsSent. bytesThisSlot // (bucketAgeInMS max: 100)}. ]. ! Item was changed: ----- Method: StringSocket>>queueOutBufContents (in category 'private-IO') ----- queueOutBufContents bytesInOutputQueue := bytesInOutputQueue + outBufIndex - 1. outputQueue nextPut: {outBuf. outBufIndex - 1}. NebraskaDebug at: #queuedbufferSizes add: {outBufIndex - 1}. outBufIndex := 1. outBuf := String new: 11000. ! Item was changed: ----- Method: StringSocket>>sendDataCautiously:bytesToSend: (in category 'private-IO') ----- sendDataCautiously: aStringOrByteArray bytesToSend: bytesToSend "Send all of the data in the given array, even if it requires multiple calls to send it all. Return the number of bytes sent. Try not to send too much at once since this seemed to cause problems talking to a port on the same machine" | bytesSent count | bytesSent := 0. [bytesSent < bytesToSend] whileTrue: [ extraUnsentBytes := bytesToSend - bytesSent. count := socket sendSomeData: aStringOrByteArray startIndex: bytesSent + 1 count: (bytesToSend - bytesSent min: 6000). bytesSent := bytesSent + count. (Delay forMilliseconds: 1) wait. ]. extraUnsentBytes := 0. ^ bytesSent ! Item was changed: ----- Method: StringSocket>>shrinkInBuf (in category 'private-IO') ----- shrinkInBuf inBuf ifNil: [^self]. inBufLastIndex < inBufIndex ifTrue: [ inBufLastIndex := 0. inBufIndex := 1. inBuf size > 20000 ifTrue: [inBuf := nil]. "if really big, kill it" ^self ]. inBuf := inBuf copyFrom: inBufIndex to: inBufLastIndex. inBufLastIndex := inBuf size. inBufIndex := 1. ! Item was changed: ----- Method: StringSocket>>transmitQueueNext (in category 'private-IO') ----- transmitQueueNext | bufTuple | bufTuple := outputQueue next. bytesInOutputQueue := bytesInOutputQueue - bufTuple second max: 0. [ self sendDataCautiously: bufTuple first bytesToSend: bufTuple second. ] on: Error do: [ :ex | transmissionError := true. ]. ^transmissionError not ! Item was changed: ----- Method: StringSocket>>tryForString (in category 'private-IO') ----- tryForString "try to grab an actual string" self inBufSize >= nextStringSize ifFalse: [^false]. stringsForNextArray at: (stringCounter := stringCounter + 1) put: (self inBufNext: nextStringSize) asString. stringCounter = numStringsInNextArray ifTrue: [ "we have finished another array!!" inObjects addLast: stringsForNextArray. stringCounter := stringsForNextArray := numStringsInNextArray := nextStringSize := nil. ] ifFalse: [ "still need more strings for this array" nextStringSize := nil. ]. ^true !

1 0

The Trunk: MorphicExtras-bf.154.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

Bert Freudenberg uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-bf.154.mcz ==================== Summary ==================== Name: MorphicExtras-bf.154 Author: bf Time: 8 December 2014, 1:54:44.666 am UUID: b83c0228-72c9-47e4-b1c8-af7c988b16da Ancestors: MorphicExtras-nice.153 Restore timestamps lost in assignment conversion. =============== Diff against MorphicExtras-nice.153 =============== Item was changed: ----- Method: AIFFFileReader>>edit (in category '*MorphicExtras-Sound') ----- edit | ed | ed := WaveEditor new. ed data: channelData first. ed loopEnd: markers last last. ed loopLength: (markers last last - markers first last) + 1. ed openInWorld. ! Item was changed: ----- Method: AbstractMediaEventMorph>>justDroppedIntoPianoRoll:event: (in category 'piano rolls') ----- justDroppedIntoPianoRoll: pianoRoll event: evt | ambientEvent | startTimeInScore := pianoRoll timeForX: self left. ambientEvent := AmbientEvent new morph: self; time: startTimeInScore. pianoRoll score addAmbientEvent: ambientEvent. "self endTime > pianoRoll scorePlayer durationInTicks ifTrue: [pianoRoll scorePlayer updateDuration]" ! Item was changed: ----- Method: EventRecorderMorph>>addMorphsTo:pianoRoll:eventTime:betweenTime:and: (in category 'sound-piano rolls') ----- addMorphsTo: morphList pianoRoll: pianoRoll eventTime: t betweenTime: leftTime and: rightTime | startX myDurationInTicks endX | startX := pianoRoll xForTime: t. myDurationInTicks := pianoRoll scorePlayer ticksForMSecs: self myDurationInMS. t > rightTime ifTrue: [^ self]. (t + myDurationInTicks) < leftTime ifTrue: [^ self]. endX := pianoRoll xForTime: t + myDurationInTicks. morphList add: (self hResizing: #spaceFill; left: startX; width: endX - startX). ! Item was changed: ----- Method: EventRecorderMorph>>addVoiceControls (in category 'sound') ----- addVoiceControls | levelSlider r meterBox | voiceRecorder := SoundRecorder new desiredSampleRate: 11025.0; "<==try real hard to get the low rate" codec: (GSMCodec new). "<--this should compress better than ADPCM.. is it too slow?" "codec: (ADPCMCodec new initializeForBitsPerSample: 4 samplesPerFrame: 0)." levelSlider := SimpleSliderMorph new color: color; extent: 100@2; target: voiceRecorder; actionSelector: #recordLevel:; adjustToValue: voiceRecorder recordLevel. r := AlignmentMorph newRow color: color; layoutInset: 0; wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #rigid; height: 24. r addMorphBack: (StringMorph contents: '0 '). r addMorphBack: levelSlider. r addMorphBack: (StringMorph contents: ' 10'). self addMorphBack: r. meterBox := Morph new extent: 102@18; color: Color gray. recordMeter := Morph new extent: 1@16; color: Color yellow. recordMeter position: meterBox topLeft + (1@1). meterBox addMorph: recordMeter. r := AlignmentMorph newRow vResizing: #shrinkWrap. r addMorphBack: meterBox. self addMorphBack: r. ! Item was changed: ----- Method: EventRecorderMorph>>justDroppedIntoPianoRoll:event: (in category 'sound-piano rolls') ----- justDroppedIntoPianoRoll: newOwner event: evt | startX lengthInTicks endX startTimeInScore endTimeInScore | super justDroppedIntoPianoRoll: newOwner event: evt. startTimeInScore := newOwner timeForX: self left. lengthInTicks := newOwner scorePlayer ticksForMSecs: self myDurationInMS. endTimeInScore := startTimeInScore + lengthInTicks. endTimeInScore > newOwner scorePlayer durationInTicks ifTrue: [newOwner scorePlayer updateDuration]. startX := newOwner xForTime: startTimeInScore. endX := newOwner xForTime: endTimeInScore. self width: endX - startX. ! Item was changed: ----- Method: GraphMorph>>openWaveEditor (in category 'sound') ----- openWaveEditor | scaleFactor scaledData editor | self data: data. "make sure maxVal and minVal are current" scaleFactor := 32767 // ((minVal abs max: maxVal abs) max: 1). scaledData := SoundBuffer newMonoSampleCount: data size. 1 to: data size do: [:i | scaledData at: i put: (scaleFactor * (data at: i)) truncated]. editor := WaveEditor new data: scaledData; samplingRate: 11025; perceivedFrequency: 220.0. editor openInWorld. ! Item was changed: ----- Method: KeyboardMorphForInput>>addRecordingControls (in category 'initialization') ----- addRecordingControls | button switch playRow durRow articRow modRow | "Add chord, rest and delete buttons" playRow := AlignmentMorph newRow. playRow color: color; borderWidth: 0; layoutInset: 0. playRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. playRow addMorphBack: (switch label: 'chord' translated; actionSelector: #buildChord:). button := SimpleButtonMorph new target: self; borderColor: #raised; borderWidth: 2; color: color. playRow addMorphBack: (button label: ' rest ' translated; actionSelector: #emitRest). button := SimpleButtonMorph new target: self; borderColor: #raised; borderWidth: 2; color: color. playRow addMorphBack: (button label: 'del' translated; actionSelector: #deleteNotes). self addMorph: playRow. playRow align: playRow fullBounds topCenter with: self fullBounds bottomCenter. "Add note duration buttons" durRow := AlignmentMorph newRow. durRow color: color; borderWidth: 0; layoutInset: 0. durRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. durRow addMorphBack: (switch label: 'whole' translated; actionSelector: #duration:onOff:; arguments: #(1)). switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. durRow addMorphBack: (switch label: 'half' translated; actionSelector: #duration:onOff:; arguments: #(2)). switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. durRow addMorphBack: (switch label: 'quarter' translated; actionSelector: #duration:onOff:; arguments: #(4)). switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. durRow addMorphBack: (switch label: 'eighth' translated; actionSelector: #duration:onOff:; arguments: #(8)). switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. durRow addMorphBack: (switch label: 'sixteenth' translated; actionSelector: #duration:onOff:; arguments: #(16)). self addMorph: durRow. durRow align: durRow fullBounds topCenter with: playRow fullBounds bottomCenter. "Add note duration modifier buttons" modRow := AlignmentMorph newRow. modRow color: color; borderWidth: 0; layoutInset: 0. modRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. modRow addMorphBack: (switch label: 'dotted' translated; actionSelector: #durMod:onOff:; arguments: #(dotted)). switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. modRow addMorphBack: (switch label: 'normal' translated; actionSelector: #durMod:onOff:; arguments: #(normal)). switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. modRow addMorphBack: (switch label: 'triplets' translated; actionSelector: #durMod:onOff:; arguments: #(triplets)). switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. modRow addMorphBack: (switch label: 'quints' translated; actionSelector: #durMod:onOff:; arguments: #(quints)). self addMorph: modRow. modRow align: modRow fullBounds topCenter with: durRow fullBounds bottomCenter. "Add articulation buttons" articRow := AlignmentMorph newRow. articRow color: color; borderWidth: 0; layoutInset: 0. articRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. articRow addMorphBack: (switch label: 'legato' translated; actionSelector: #articulation:onOff:; arguments: #(legato)). switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. articRow addMorphBack: (switch label: 'normal' translated; actionSelector: #articulation:onOff:; arguments: #(normal)). switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. articRow addMorphBack: (switch label: 'staccato' translated; actionSelector: #articulation:onOff:; arguments: #(staccato)). self addMorph: articRow. articRow align: articRow fullBounds topCenter with: modRow fullBounds bottomCenter. self bounds: (self fullBounds expandBy: (0@0 extent: 0@borderWidth)) ! Item was changed: ----- Method: KeyboardMorphForInput>>articulation:onOff: (in category 'note controls') ----- articulation: artic onOff: ignored "artic = eg, #legato, #normal, #staccato." "Set the articulation of notes to be emitted when a key is pressed." self allMorphsDo: [:m | ((m isMemberOf: SimpleSwitchMorph) and: [m actionSelector == #articulation:onOff:]) ifTrue: [m setSwitchState: m arguments first == artic]]. articulation := artic! Item was changed: ----- Method: KeyboardMorphForInput>>durMod:onOff: (in category 'note controls') ----- durMod: durMod onOff: ignored "durMod = eg, #dotted, #normal, #triplets, #quints" "Set the duration of notes to be emitted when a key is pressed." self allMorphsDo: [:m | ((m isMemberOf: SimpleSwitchMorph) and: [m actionSelector == #durMod:onOff:]) ifTrue: [m setSwitchState: m arguments first = durMod]]. durationModifier := durMod! Item was changed: ----- Method: KeyboardMorphForInput>>duration:onOff: (in category 'note controls') ----- duration: denom onOff: ignored "denom = eg, 1, 2, 4, 8, 16" "Set the duration of notes to be emitted when a key is pressed." self allMorphsDo: [:m | ((m isMemberOf: SimpleSwitchMorph) and: [m actionSelector == #duration:onOff:]) ifTrue: [m setSwitchState: m arguments first = denom]]. duration := denom. self durMod: #normal onOff: true! Item was changed: ----- Method: KeyboardMorphForInput>>emitRest (in category 'note controls') ----- emitRest | sel noteEvent | "All this selection logic should be shared with mouseDown..." (sel := pianoRoll selection) ifNil: [^ self]. insertMode ifTrue: [sel := pianoRoll selectionForInsertion. insertMode := false]. sel = prevSelection ifFalse: ["This is a new selection -- need to determine start time" sel third = 0 ifTrue: [startOfNextNote := 0] ifFalse: [startOfNextNote := ((pianoRoll score tracks at: sel first) at: sel third) endTime. startOfNextNote := startOfNextNote + self fullDuration - 1 truncateTo: self fullDuration]]. noteEvent := NoteEvent new time: startOfNextNote; duration: self noteDuration; key: -1 "my flag for rest" velocity: self velocity channel: 1. pianoRoll appendEvent: noteEvent fullDuration: self fullDuration. soundPlaying ifNotNil: [soundPlaying stopGracefully]. prevSelection := pianoRoll selection. startOfNextNote := startOfNextNote + self fullDuration.! Item was changed: ----- Method: KeyboardMorphForInput>>fullDuration (in category 'note controls') ----- fullDuration | num denom | num := denom := 1. durationModifier == #dotted ifTrue: [num := 3. denom := 2]. durationModifier == #triplets ifTrue: [num := 2. denom := 3]. durationModifier == #quints ifTrue: [num := 2. denom := 5]. ^ pianoRoll score ticksPerQuarterNote * 4 * num // duration // denom! Item was changed: ----- Method: KeyboardMorphForInput>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" buildingChord := false. self addRecordingControls. self duration: 4 onOff: true. self durMod: #normal onOff: true. self articulation: #normal onOff: true. insertMode := false! Item was changed: ----- Method: KeyboardMorphForInput>>mouseDownPitch:event:noteMorph: (in category 'simple keyboard') ----- mouseDownPitch: midiKey event: event noteMorph: keyMorph | sel noteEvent | event hand hasSubmorphs ifTrue: [^ self "no response if drag something over me"]. keyMorph color: playingKeyColor. (sel := pianoRoll selection) ifNil: [^ self]. insertMode ifTrue: [sel := pianoRoll selectionForInsertion. insertMode := false]. sel = prevSelection ifFalse: ["This is a new selection -- need to determine start time" sel third = 0 ifTrue: [startOfNextNote := 0] ifFalse: [startOfNextNote := ((pianoRoll score tracks at: sel first) at: sel third) endTime. startOfNextNote := startOfNextNote + self fullDuration - 1 truncateTo: self fullDuration]]. noteEvent := NoteEvent new time: startOfNextNote; duration: self noteDuration; key: midiKey + 23 velocity: self velocity channel: 1. pianoRoll appendEvent: noteEvent fullDuration: self fullDuration. soundPlaying ifNotNil: [soundPlaying stopGracefully]. (soundPlaying := self soundForEvent: noteEvent inTrack: sel first) play. prevSelection := pianoRoll selection. startOfNextNote := startOfNextNote + self fullDuration.! Item was changed: ----- Method: KeyboardMorphForInput>>pianoRoll: (in category 'initialization') ----- pianoRoll: prMorph pianoRoll := prMorph! Item was changed: ----- Method: KeyboardMorphForInput>>soundForEvent:inTrack: (in category 'events') ----- soundForEvent: noteEvent inTrack: trackIndex | sound player | player := pianoRoll scorePlayer. sound := MixedSound new. sound add: ((player instrumentForTrack: trackIndex) soundForMidiKey: noteEvent midiKey dur: noteEvent duration / (pianoRoll scorePlayer ticksForMSecs: 1000) loudness: (noteEvent velocity asFloat / 127.0)) pan: (player panForTrack: trackIndex) volume: player overallVolume * (player volumeForTrack: trackIndex). ^ sound ! Item was changed: ----- Method: LoopedSampledSound>>edit (in category '*MorphicExtras-Sound') ----- edit "Open a WaveEditor on this sound." | loopLen ed | loopLen := scaledLoopLength asFloat / LoopIndexScaleFactor. ed := WaveEditor new data: leftSamples; samplingRate: originalSamplingRate; loopEnd: loopEnd; loopLength: loopLen; loopCycles: (loopLen / (originalSamplingRate asFloat / perceivedPitch)) rounded. ed openInWorld. ! Item was changed: ----- Method: ObjectOut>>xxxFixup (in category 'fetch from disk') ----- xxxFixup "There is already an object in memory for my url. All pointers to me need to be pointers to him. Can't use become, because other pointers to him must stay valid." | real temp list | real := page contentsMorph. real == self ifTrue: [page error: 'should be converted by now']. temp := self. list := (PointerFinder pointersTo: temp) asOrderedCollection. list add: thisContext. list add: thisContext sender. list do: [:holder | 1 to: holder class instSize do: [:i | (holder instVarAt: i) == temp ifTrue: [holder instVarAt: i put: real]]. 1 to: holder basicSize do: [:i | (holder basicAt: i) == temp ifTrue: [holder basicAt: i put: real]]. ]. ^ real! Item was changed: ----- Method: PianoRollScoreMorph>>appendEvent:fullDuration: (in category 'editing') ----- appendEvent: noteEvent fullDuration: fullDuration | sel x | score appendEvent: noteEvent fullDuration: fullDuration at: (sel := self selection). noteEvent midiKey = -1 ifFalse: "Unless it is a rest..." ["Advance the selection to the note just entered" selection := Array with: sel first with: sel third + 1 with: sel third + 1]. "This is all horribly inefficient..." scorePlayer updateDuration. (x := self xForTime: noteEvent endTime) > (self right - 30) ifTrue: [self autoScrollForX: x + (30 + self width // 4)]. self updateLowestNote. self rebuildFromScore! Item was changed: ----- Method: PianoRollScoreMorph>>autoScrollForX: (in category 'scrolling') ----- autoScrollForX: x "Scroll by the amount x lies outside of my innerBounds. Return true if this happens." | d ticks | ((d := x - self innerBounds right) > 0 or: [(d := x - self innerBounds left) < 0]) ifTrue: [ticks := (self timeForX: self bounds center x + d+1) min: score durationInTicks max: 0. self moveCursorToTime: ticks. scorePlayer ticksSinceStart: ticks. ^ true]. ^ false ! Item was changed: ----- Method: PianoRollScoreMorph>>beatLinesOnOff (in category 'menu') ----- beatLinesOnOff showBeatLines := showBeatLines not. self changed! Item was changed: ----- Method: PianoRollScoreMorph>>contractTime (in category 'geometry') ----- contractTime timeScale := timeScale / 1.5. self rebuildFromScore. ! Item was changed: ----- Method: PianoRollScoreMorph>>drawMeasureLinesOn: (in category 'drawing') ----- drawMeasureLinesOn: aCanvas | ticksPerMeas x measureLineColor inner | showBeatLines ifNil: [showBeatLines := false]. showMeasureLines ifNil: [showMeasureLines := true]. notePerBeat ifNil: [self timeSignature: 4 over: 4]. showBeatLines ifTrue: [measureLineColor := Color gray: 0.8. ticksPerMeas := score ticksPerQuarterNote. inner := self innerBounds. (leftEdgeTime + ticksPerMeas truncateTo: ticksPerMeas) to: ((self timeForX: self right - borderWidth) truncateTo: ticksPerMeas) by: ticksPerMeas do: [:tickTime | x := self xForTime: tickTime. aCanvas fillRectangle: (x @ inner top extent: 1 @ inner height) color: measureLineColor]]. showMeasureLines ifTrue: [measureLineColor := Color gray: 0.7. ticksPerMeas := beatsPerMeasure*score ticksPerQuarterNote*4//notePerBeat. inner := self innerBounds. (leftEdgeTime + ticksPerMeas truncateTo: ticksPerMeas) to: ((self timeForX: self right - borderWidth) truncateTo: ticksPerMeas) by: ticksPerMeas do: [:tickTime | x := self xForTime: tickTime. aCanvas fillRectangle: (x @ inner top extent: 1 @ inner height) color: (tickTime = 0 ifTrue: [Color black] ifFalse: [measureLineColor])]]. ! Item was changed: ----- Method: PianoRollScoreMorph>>drawStaffOn: (in category 'drawing') ----- drawStaffOn: aCanvas | blackKeyColor l r topEdge y | self drawMeasureLinesOn: aCanvas. blackKeyColor := Color gray: 0.5. l := self left + borderWidth. r := self right - borderWidth. topEdge := self top + borderWidth + 3. lowestNote to: 127 do: [:k | y := self yForMidiKey: k. y <= topEdge ifTrue: [^ self]. "over the top!!" (self isBlackKey: k) ifTrue: [ aCanvas fillRectangle: (l@y corner: r@(y + 1)) color: blackKeyColor]]. ! Item was changed: ----- Method: PianoRollScoreMorph>>expandTime (in category 'geometry') ----- expandTime timeScale := timeScale * 1.5. self rebuildFromScore. ! Item was changed: ----- Method: PianoRollScoreMorph>>fullBounds (in category 'layout') ----- fullBounds "Overridden to clip submorph hit detection to my bounds." fullBounds ifNil: [fullBounds := bounds]. ^ bounds ! Item was changed: ----- Method: PianoRollScoreMorph>>goToTime: (in category 'scrolling') ----- goToTime: scoreTime | track trackSize index newLeftEdgeTime | newLeftEdgeTime := scoreTime asInteger. newLeftEdgeTime < leftEdgeTime ifTrue: [indexInTrack := Array new: score tracks size+1 withAll: 1]. leftEdgeTime := newLeftEdgeTime. 1 to: score tracks size do: [:trackIndex | track := score tracks at: trackIndex. index := indexInTrack at: trackIndex. trackSize := track size. [(index < trackSize) and: [(track at: index) endTime < leftEdgeTime]] whileTrue: [index := index + 1]. indexInTrack at: trackIndex put: index]. self addNotes. ! Item was changed: ----- Method: PianoRollScoreMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" self extent: 400 @ 300. showMeasureLines := true. showBeatLines := false. self timeSignature: 4 over: 4. self clipSubmorphs: true! Item was changed: ----- Method: PianoRollScoreMorph>>invokeScoreMenu: (in category 'menu') ----- invokeScoreMenu: evt "Invoke the score's edit menu." | menu subMenu | menu := MenuMorph new defaultTarget: self. menu addList: {{'cut' translated. #cutSelection}. {'copy' translated. #copySelection}. {'paste' translated. #insertSelection}. {'paste...' translated. #insertTransposed}}. menu addLine. menu addList: {{'legato' translated. #selectionBeLegato}. {'staccato' translated. #selectionBeStaccato}. {'normal' translated. #selectionBeNormal}}. menu addLine. menu addList: {{'expand time' translated. #expandTime}. {'contract time' translated. #contractTime}}. menu addLine. subMenu := MenuMorph new defaultTarget: self. (2 to: 12) do: [:i | subMenu add: i printString selector: #beatsPerMeasure: argument: i]. menu add: 'time ' translated, beatsPerMeasure printString subMenu: subMenu. subMenu := MenuMorph new defaultTarget: self. #(2 4 8) do: [:i | subMenu add: i printString selector: #notePerBeat: argument: i]. menu add: 'sig ' translated, notePerBeat printString subMenu: subMenu. menu addLine. showMeasureLines ifTrue: [menu add: 'hide measure lines' translated action: #measureLinesOnOff] ifFalse: [menu add: 'show measure lines' translated action: #measureLinesOnOff]. showBeatLines ifTrue: [menu add: 'hide beat lines' translated action: #beatLinesOnOff] ifFalse: [menu add: 'show beat lines' translated action: #beatLinesOnOff]. menu addLine. menu add: 'add keyboard' translated action: #addKeyboard. menu popUpEvent: evt in: self world. ! Item was changed: ----- Method: PianoRollScoreMorph>>isBlackKey: (in category 'drawing') ----- isBlackKey: midiKey "Answer true if the given MIDI key corresponds to a black key on the piano keyboard." | note | note := midiKey \\ 12. note = 1 ifTrue: [^ true]. note = 3 ifTrue: [^ true]. note = 6 ifTrue: [^ true]. note = 8 ifTrue: [^ true]. note = 10 ifTrue: [^ true]. ^ false ! Item was changed: ----- Method: PianoRollScoreMorph>>measureLinesOnOff (in category 'menu') ----- measureLinesOnOff showMeasureLines := showMeasureLines not. self changed! Item was changed: ----- Method: PianoRollScoreMorph>>mouseUp: (in category 'event handling') ----- mouseUp: evt soundsPlayingMorph ifNotNil: [soundsPlayingMorph delete]. soundsPlaying ifNotNil: [soundsPlaying do: [:s | s stopGracefully]]. soundsPlayingMorph := soundsPlaying := nil ! Item was changed: ----- Method: PianoRollScoreMorph>>moveCursorToTime: (in category 'scrolling') ----- moveCursorToTime: scoreTime | cursorOffset desiredCursorHeight | scorePlayer isPlaying ifTrue: [cursorOffset := ((scoreTime - leftEdgeTime) asFloat * timeScale) asInteger. (cursorOffset < 0 or: [cursorOffset > (self width-20)]) ifTrue: [self goToTime: scoreTime - (20/timeScale). cursorOffset := ((scoreTime - leftEdgeTime) asFloat * timeScale) asInteger]] ifFalse: [self goToTime: (scoreTime - (self width//2 / timeScale) max: (self width//10 / timeScale) negated). cursorOffset := ((scoreTime - leftEdgeTime) asFloat * timeScale) asInteger]. cursor position: (self left + borderWidth + cursorOffset)@(self top + borderWidth). desiredCursorHeight := self height. cursor height ~= desiredCursorHeight ifTrue: [cursor extent: 1@desiredCursorHeight]. ! Item was changed: ----- Method: PianoRollScoreMorph>>movieClipPlayer: (in category 'accessing') ----- movieClipPlayer: moviePlayer movieClipPlayer := moviePlayer ! Item was changed: ----- Method: PianoRollScoreMorph>>on: (in category 'initialization') ----- on: aScorePlayer scorePlayer := aScorePlayer. score := aScorePlayer score. colorForTrack := Color wheel: score tracks size. leftEdgeTime := 0. timeScale := 0.1. indexInTrack := Array new: score tracks size withAll: 1. lastUpdateTick := -1. self updateLowestNote ! Item was changed: ----- Method: PianoRollScoreMorph>>removedMorph: (in category 'private') ----- removedMorph: aMorph | trackSize | trackSize := score ambientTrack size. score removeAmbientEventWithMorph: aMorph. trackSize = score ambientTrack size ifFalse: ["Update duration if we removed an event" scorePlayer updateDuration]. ^super removedMorph: aMorph! Item was changed: ----- Method: PianoRollScoreMorph>>selection (in category 'accessing') ----- selection "Returns an array of 3 elements: trackIndex indexInTrack of first note indexInTrack of last note" | trackIndex track | selection ifNil: "If no selection, return last event of 1st non-muted track (or nil)" [trackIndex := (1 to: score tracks size) detect: [:i | (scorePlayer mutedForTrack: i) not] ifNone: [^ nil]. track := score tracks at: trackIndex. ^ Array with: trackIndex with: track size with: track size]. (scorePlayer mutedForTrack: selection first) ifTrue: [selection := nil. ^ self selection]. ^ selection! Item was changed: ----- Method: PianoRollScoreMorph>>selection: (in category 'accessing') ----- selection: anArray selection := anArray! Item was changed: ----- Method: PianoRollScoreMorph>>step (in category 'stepping and presenter') ----- step | t | score ifNil: [^ self]. lastMutedState ~= scorePlayer mutedState ifTrue: [ self rebuildFromScore. lastMutedState := scorePlayer mutedState copy]. t := scorePlayer ticksSinceStart. t = lastUpdateTick ifFalse: [ self moveCursorToTime: t. lastUpdateTick := t]. ! Item was changed: ----- Method: PianoRollScoreMorph>>timeSignature:over: (in category 'accessing') ----- timeSignature: num over: denom beatsPerMeasure := num. notePerBeat := denom. "a number like 2, 4, 8" self changed! Item was changed: ----- Method: ProjectNavigationMorph>>buttonSound (in category '*MorphicExtras-Sound') ----- buttonSound | myButton m | myButton := RectangleMorph new borderWidth: 1; cornerStyle: #rounded; borderColor: #raised; color: self colorForButtons; setBalloonText: 'Change sound volume' translated; on: #mouseDown send: #soundDownEvt:morph: to: self; on: #mouseStillDown send: #soundStillDownEvt:morph: to: self; on: #mouseUp send: #soundUpEvt:morph: to: self; yourself. myButton addMorph: (m := self speakerIcon lock). myButton extent: m extent + (myButton borderWidth + 6). m position: myButton center - (m extent // 2). ^myButton ! Item was changed: ----- Method: ProjectNavigationMorph>>soundDownEvt:morph: (in category '*MorphicExtras-Sound') ----- soundDownEvt: a morph: b soundSlider ifNotNil: [soundSlider delete]. (soundSlider := RectangleMorph new) setProperty: #morphicLayerNumber toValue: 1; extent: b width @ (b width * 3); color: self colorForButtons; borderColor: #raised; bottomLeft: b boundsInWorld origin. soundSlider addMorph: ( RectangleMorph new color: self colorForButtons; borderColor: #raised; extent: b width @ 8; center: soundSlider center x @ (soundSlider bottom - (soundSlider height * self getSoundVolume) asInteger) ). soundSlider openInWorld.! Item was changed: ----- Method: ProjectNavigationMorph>>soundStillDownEvt:morph: (in category '*MorphicExtras-Sound') ----- soundStillDownEvt: evt morph: b | y pct | soundSlider ifNil: [^self]. y := evt hand position y. (y between: soundSlider top and: soundSlider bottom) ifTrue: [ pct := (soundSlider bottom - y) asFloat / soundSlider height. self setSoundVolume: pct. soundSlider firstSubmorph top: y - 5. ]. ! Item was changed: ----- Method: ProjectNavigationMorph>>soundUpEvt:morph: (in category '*MorphicExtras-Sound') ----- soundUpEvt: a morph: b soundSlider ifNotNil: [soundSlider delete]. soundSlider := nil. Beeper beep ! Item was changed: ----- Method: String>>asPostscript (in category '*MorphicExtras-*morphic-Postscript Canvases') ----- asPostscript | temp | temp := self asString copyReplaceAll: '(' with: '$'. temp := temp copyReplaceAll: ')' with: '$'. temp := temp copyReplaceAll: ' ' with: ''. ^ PostscriptEncoder mapMacStringToPS: temp! Item was changed: ----- Method: ZASMCameraMarkMorph>>addMorphsTo:pianoRoll:eventTime:betweenTime:and: (in category 'piano rolls') ----- addMorphsTo: morphList pianoRoll: pianoRoll eventTime: t betweenTime: leftTime and: rightTime | startX pseudoEndTime | startX := pianoRoll xForTime: startTimeInScore. pseudoEndTime := pianoRoll timeForX: startX + self width. startTimeInScore > rightTime ifTrue: [^ self]. pseudoEndTime < leftTime ifTrue: [^ self]. morphList add: (self align: self bottomLeft with: startX @ self bottom). ! Item was changed: ----- Method: ZASMCameraMarkMorph>>encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: (in category 'piano rolls') ----- encounteredAtTime: ticks inScorePlayer: scorePlayer atIndex: index inEventTrack: track secsPerTick: secsPerTick | nextAmbient m nextDurationInMs program now finalMark thisPage nextPage | self gotoMark. nextAmbient := nil. index to: track size do: [ :i | (nextAmbient isNil and: [((m := track at: i) morph) isKindOf: self class]) ifTrue: [ nextAmbient := m. ]. ]. nextAmbient ifNil: [^self]. nextDurationInMs := (nextAmbient time - ticks * secsPerTick * 1000) rounded. finalMark := nextAmbient morph. thisPage := self valueOfProperty: #bookPage. nextPage := finalMark valueOfProperty: #bookPage. (thisPage = nextPage or: [thisPage isNil | nextPage isNil]) ifFalse: [^finalMark gotoMark]. now := Time millisecondClockValue. program := Dictionary new. program at: #startTime put: now; at: #endTime put: now + nextDurationInMs; at: #startPoint put: (self valueOfProperty: #cameraPoint); at: #endPoint put: (finalMark valueOfProperty: #cameraPoint); at: #startZoom put: (self valueOfProperty: #cameraScale); at: #endZoom put: (finalMark valueOfProperty: #cameraScale). self cameraController setProgrammedMoves: {program}. !

1 0

The Trunk: Morphic-bf.753.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

Bert Freudenberg uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-bf.753.mcz ==================== Summary ==================== Name: Morphic-bf.753 Author: bf Time: 8 December 2014, 1:52:24.579 am UUID: 6e72a684-dce4-4de0-a012-cf80ce30a3eb Ancestors: Morphic-eem.752 Restore timestamps lost in assignment conversion. =============== Diff against Morphic-eem.752 =============== Item was changed: ----- Method: AbstractSound class>>updateScorePlayers (in category '*Morphic-Sounds-sound library-file in/out') ----- updateScorePlayers | soundsBeingEdited | "Force all ScorePlayers to update their instrument list from the sound library. This may done after loading, unloading, or replacing a sound to make all ScorePlayers feel the change." ScorePlayer allSubInstancesDo: [:p | p pause]. SoundPlayer shutDown. soundsBeingEdited := EnvelopeEditorMorph allSubInstances collect: [:ed | ed soundBeingEdited]. ScorePlayerMorph allSubInstancesDo: [:p | p updateInstrumentsFromLibraryExcept: soundsBeingEdited]. ! Item was changed: ----- Method: MIDIFileReader class>>playURLNamed: (in category '*Morphic-Sounds') ----- playURLNamed: urlString | titleString | titleString := urlString copyFrom: (urlString findLast: [:c | c=$/]) + 1 to: urlString size. ScorePlayerMorph openOn: (self scoreFromURL: urlString) title: titleString. ! Item was changed: ----- Method: Morph>>justDroppedIntoPianoRoll:event: (in category '*Morphic-Sound-piano rolls') ----- justDroppedIntoPianoRoll: pianoRoll event: evt | ambientEvent startTimeInScore | startTimeInScore := pianoRoll timeForX: self left. ambientEvent := AmbientEvent new morph: self; time: startTimeInScore. pianoRoll score addAmbientEvent: ambientEvent. "self endTime > pianoRoll scorePlayer durationInTicks ifTrue: [pianoRoll scorePlayer updateDuration]" ! Item was changed: ----- Method: Morph>>privateExtension: (in category 'accessing - extension') ----- privateExtension: aMorphExtension "private - change the receiver's extension" extension := aMorphExtension! Item was changed: ----- Method: Morph>>triggerActionFromPianoRoll (in category '*Morphic-Sound-piano rolls') ----- triggerActionFromPianoRoll | evt | "a hack to allow for abitrary morphs to be dropped into piano roll" self world ifNil: [^self]. evt := MouseEvent new setType: nil position: self center buttons: 0 hand: self world activeHand. self programmedMouseUp: evt for: self. ! Item was changed: ----- Method: PianoRollNoteMorph>>deselect (in category 'selecting') ----- deselect selected ifFalse: [^ self]. self changed. selected := false. ! Item was changed: ----- Method: PianoRollNoteMorph>>editPitch: (in category 'editing') ----- editPitch: evt | mk note | mk := owner midiKeyForY: evt cursorPoint y. note := (owner score tracks at: trackIndex) at: indexInTrack. note midiKey = mk ifTrue: [^ self]. note midiKey: mk. self playSound: (self soundOfDuration: 999.0). self position: self position x @ ((owner yForMidiKey: mk) - 1) ! Item was changed: ----- Method: PianoRollNoteMorph>>invokeNoteMenu: (in category 'menu') ----- invokeNoteMenu: evt "Invoke the note's edit menu." | menu | menu := MenuMorph new defaultTarget: self. menu addList: #(('grid to next quarter' gridToNextQuarter) ('grid to prev quarter' gridToPrevQuarter)). menu popUpEvent: evt in: self world. ! Item was changed: ----- Method: PianoRollNoteMorph>>mouseDown: (in category 'event handling') ----- mouseDown: evt hitLoc := evt cursorPoint. editMode := nil. owner submorphsDo: [:m | (m isKindOf: PianoRollNoteMorph) ifTrue: [m deselect]]. selected := true. self changed. owner selection: (Array with: trackIndex with: indexInTrack with: indexInTrack). self playSound! Item was changed: ----- Method: PianoRollNoteMorph>>noteOfDuration: (in category 'note playing') ----- noteOfDuration: duration | note | note := self noteInScore. ^ (owner scorePlayer instrumentForTrack: trackIndex) soundForMidiKey: note midiKey dur: duration loudness: (note velocity asFloat / 127.0) ! Item was changed: ----- Method: PianoRollNoteMorph>>playSound: (in category 'note playing') ----- playSound: aSoundOrNil SoundPlaying ifNotNil: [SoundPlaying stopGracefully]. SoundPlaying := aSoundOrNil. SoundPlaying ifNotNil: [SoundPlaying play].! Item was changed: ----- Method: PianoRollNoteMorph>>select (in category 'selecting') ----- select selected ifTrue: [^ self]. selected := true. self changed! Item was changed: ----- Method: PianoRollNoteMorph>>selectNotes: (in category 'selecting') ----- selectNotes: evt | lastMorph oldEnd saveOwner | saveOwner := owner. (owner autoScrollForX: evt cursorPoint x) ifTrue: ["If scroll talkes place I will be deleted and my x-pos will become invalid." owner := saveOwner. bounds := bounds withLeft: (owner xForTime: self noteInScore time)]. oldEnd := owner selection last. (owner notesInRect: (evt cursorPoint x @ owner top corner: owner bottomRight)) do: [:m | m trackIndex = trackIndex ifTrue: [m deselect]]. self select. lastMorph := self. (owner notesInRect: (self left @ owner top corner: evt cursorPoint x @ owner bottom)) do: [:m | m trackIndex = trackIndex ifTrue: [m select. lastMorph := m]]. owner selection: (Array with: trackIndex with: indexInTrack with: lastMorph indexInTrack). lastMorph indexInTrack ~= oldEnd ifTrue: ["Play last note as selection grows or shrinks" owner ifNotNil: [lastMorph playSound]] ! Item was changed: ----- Method: PianoRollNoteMorph>>soundOfDuration: (in category 'note playing') ----- soundOfDuration: duration | sound | sound := MixedSound new. sound add: (self noteOfDuration: duration) pan: (owner scorePlayer panForTrack: trackIndex) volume: owner scorePlayer overallVolume * (owner scorePlayer volumeForTrack: trackIndex). ^ sound reset ! Item was changed: ----- Method: PianoRollNoteMorph>>trackIndex:indexInTrack: (in category 'initialization') ----- trackIndex: ti indexInTrack: i trackIndex := ti. indexInTrack := i. selected := false! Item was changed: ----- Method: ScorePlayerMorph class>>onMIDIFileNamed: (in category 'system hookup') ----- onMIDIFileNamed: fileName "Return a ScorePlayerMorph on the score from the MIDI file of the given name." | score player | score := MIDIFileReader scoreFromFileNamed: fileName . player := ScorePlayer onScore: score. ^ self new onScorePlayer: player title: fileName ! Item was changed: ----- Method: ScorePlayerMorph class>>openOn:title: (in category 'system hookup') ----- openOn: aScore title: aString | player | player := ScorePlayer onScore: aScore. (self new onScorePlayer: player title: aString) openInWorld. ! Item was changed: ----- Method: ScorePlayerMorph>>closeMIDIPort (in category 'initialization') ----- closeMIDIPort scorePlayer closeMIDIPort. LastMIDIPort := nil. ! Item was changed: ----- Method: ScorePlayerMorph>>invokeMenu (in category 'menu') ----- invokeMenu "Invoke a menu of additonal functions for this ScorePlayer." | aMenu | aMenu := MenuMorph new defaultTarget: self. aMenu add: 'open a MIDI file' translated action: #openMIDIFile. aMenu addList: { #-. {'save as AIFF file' translated. #saveAsAIFF}. {'save as WAV file' translated. #saveAsWAV}. {'save as Sun AU file' translated. #saveAsSunAudio}. #-}. aMenu add: 'reload instruments' translated target: AbstractSound selector: #updateScorePlayers. aMenu addLine. scorePlayer midiPort ifNil: [ aMenu add: 'play via MIDI' translated action: #openMIDIPort] ifNotNil: [ aMenu add: 'play via built in synth' translated action: #closeMIDIPort. aMenu add: 'new MIDI controller' translated action: #makeMIDIController:]. aMenu addLine. aMenu add: 'make a pause marker' translated action: #makeAPauseEvent:. aMenu popUpInWorld: self world. ! Item was changed: ----- Method: ScorePlayerMorph>>makeAPauseEvent: (in category 'menu') ----- makeAPauseEvent: evt | newWidget | newWidget := AlignmentMorph newRow. newWidget color: Color orange; borderWidth: 0; layoutInset: 0; hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5; addMorph: (StringMorph contents: '[pause]' translated) lock; addMouseUpActionWith: ( MessageSend receiver: self selector: #showResumeButtonInTheWorld ). evt hand attachMorph: newWidget.! Item was changed: ----- Method: ScorePlayerMorph>>makeControls (in category 'layout') ----- makeControls | bb r reverbSwitch repeatSwitch | r := AlignmentMorph newRow. r color: color; borderWidth: 0; layoutInset: 0. r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. bb := SimpleButtonMorph new target: self; borderColor: #raised; borderWidth: 2; color: color. r addMorphBack: (bb label: '<>'; actWhen: #buttonDown; actionSelector: #invokeMenu). bb := SimpleButtonMorph new target: self; borderColor: #raised; borderWidth: 2; color: color. r addMorphBack: (bb label: 'Piano Roll' translated; actionSelector: #makePianoRoll). bb := SimpleButtonMorph new target: self; borderColor: #raised; borderWidth: 2; color: color. r addMorphBack: (bb label: 'Rewind' translated; actionSelector: #rewind). bb := SimpleButtonMorph new target: scorePlayer; borderColor: #raised; borderWidth: 2; color: color. r addMorphBack: (bb label: 'Play' translated; actionSelector: #resumePlaying). bb := SimpleButtonMorph new target: scorePlayer; borderColor: #raised; borderWidth: 2; color: color. r addMorphBack: (bb label: 'Pause' translated; actionSelector: #pause). reverbSwitch := SimpleSwitchMorph new offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); borderWidth: 2; label: 'Reverb Disable' translated; actionSelector: #disableReverb:; target: scorePlayer; setSwitchState: SoundPlayer isReverbOn not. r addMorphBack: reverbSwitch. scorePlayer ifNotNil: [repeatSwitch := SimpleSwitchMorph new offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); borderWidth: 2; label: 'Repeat' translated; actionSelector: #repeat:; target: scorePlayer; setSwitchState: scorePlayer repeat. r addMorphBack: repeatSwitch]. ^ r ! Item was changed: ----- Method: ScorePlayerMorph>>makePianoRoll (in category 'layout') ----- makePianoRoll "Create a piano roll viewer for this score player." | pianoRoll hand | pianoRoll := PianoRollScoreMorph new on: scorePlayer. hand := self world activeHand. hand ifNil: [self world addMorph: pianoRoll] ifNotNil: [hand attachMorph: pianoRoll. hand lastEvent shiftPressed ifTrue: ["Special case for NOBM demo" pianoRoll contractTime; contractTime; enableDragNDrop]]. pianoRoll startStepping. ! Item was changed: ----- Method: ScorePlayerMorph>>onScorePlayer:title: (in category 'initialization') ----- onScorePlayer: aScorePlayer title: scoreName | divider col r | scorePlayer := aScorePlayer. scorePlayer ifNotNil: [scorePlayer reset. instrumentSelector := Array new: scorePlayer score tracks size]. self removeAllMorphs. self addMorphBack: self makeControls. scorePlayer ifNil: [^ self]. r := self makeRow hResizing: #shrinkWrap; vResizing: #shrinkWrap. r addMorphBack: self rateControl; addMorphBack: (Morph newBounds: (0@0 extent: 20@0) color: Color transparent); addMorphBack: self volumeControl. self addMorphBack: r. self addMorphBack: self scrollControl. col := AlignmentMorph newColumn color: color; layoutInset: 0. self addMorphBack: col. 1 to: scorePlayer trackCount do: [:trackIndex | divider := AlignmentMorph new extent: 10@1; borderWidth: 1; layoutInset: 0; borderColor: #raised; color: color; hResizing: #spaceFill; vResizing: #rigid. col addMorphBack: divider. col addMorphBack: (self trackControlsFor: trackIndex)]. LastMIDIPort ifNotNil: [ "use the most recently set MIDI port" scorePlayer openMIDIPort: LastMIDIPort]. ! Item was changed: ----- Method: ScorePlayerMorph>>openMIDIFile (in category 'initialization') ----- openMIDIFile "Open a MIDI score and re-init controls..." | score fileName f player | fileName := Utilities chooseFileWithSuffixFromList: #('.mid' '.midi') withCaption: 'Choose a MIDI file to open' translated. (fileName isNil or: [ fileName == #none ]) ifTrue: [^ self inform: 'No .mid/.midi files found in the Squeak directory' translated]. f := FileStream readOnlyFileNamed: fileName. score := (MIDIFileReader new readMIDIFrom: f binary) asScore. f close. player := ScorePlayer onScore: score. self onScorePlayer: player title: fileName! Item was changed: ----- Method: ScorePlayerMorph>>openMIDIPort (in category 'initialization') ----- openMIDIPort | portNum | portNum := SimpleMIDIPort outputPortNumFromUser. portNum ifNil: [^ self]. scorePlayer openMIDIPort: portNum. LastMIDIPort := portNum. ! Item was changed: ----- Method: ScorePlayerMorph>>panAndVolControlsFor: (in category 'layout') ----- panAndVolControlsFor: trackIndex | volSlider panSlider c r middleLine pianoRollColor | pianoRollColor := (Color wheel: scorePlayer score tracks size) at: trackIndex. volSlider := SimpleSliderMorph new color: color; sliderColor: pianoRollColor; extent: 101@2; target: scorePlayer; arguments: (Array with: trackIndex); actionSelector: #volumeForTrack:put:; minVal: 0.0; maxVal: 1.0; adjustToValue: (scorePlayer volumeForTrack: trackIndex). panSlider := SimpleSliderMorph new color: color; sliderColor: pianoRollColor; extent: 101@2; target: scorePlayer; arguments: (Array with: trackIndex); actionSelector: #panForTrack:put:; minVal: 0.0; maxVal: 1.0; adjustToValue: (scorePlayer panForTrack: trackIndex). c := AlignmentMorph newColumn color: color; layoutInset: 0; wrapCentering: #center; cellPositioning: #topCenter; hResizing: #spaceFill; vResizing: #shrinkWrap. middleLine := Morph new "center indicator for pan slider" color: (Color r: 0.4 g: 0.4 b: 0.4); extent: 1@(panSlider height - 4); position: panSlider center x@(panSlider top + 2). panSlider addMorphBack: middleLine. r := self makeRow. r addMorphBack: (StringMorph contents: '0'). r addMorphBack: volSlider. r addMorphBack: (StringMorph contents: '10'). c addMorphBack: r. r := self makeRow. r addMorphBack: (StringMorph contents: 'L' translated). r addMorphBack: panSlider. r addMorphBack: (StringMorph contents: 'R' translated). c addMorphBack: r. ^ c ! Item was changed: ----- Method: ScorePlayerMorph>>rateControl (in category 'layout') ----- rateControl | rateSlider middleLine r | rateSlider := SimpleSliderMorph new color: color; sliderColor: Color gray; extent: 180@2; target: self; actionSelector: #setLogRate:; minVal: -1.0; maxVal: 1.0; adjustToValue: 0.0. middleLine := Morph new "center indicator for pan slider" color: (Color r: 0.4 g: 0.4 b: 0.4); extent: 1@(rateSlider height - 4); position: rateSlider center x@(rateSlider top + 2). rateSlider addMorphBack: middleLine. r := self makeRow hResizing: #shrinkWrap; vResizing: #rigid; height: 24. r addMorphBack: (StringMorph contents: 'slow ' translated). r addMorphBack: rateSlider. r addMorphBack: (StringMorph contents: ' fast' translated). ^ r ! Item was changed: ----- Method: ScorePlayerMorph>>scrollControl (in category 'layout') ----- scrollControl | r | scrollSlider := SimpleSliderMorph new color: color; sliderColor: Color gray; extent: 360@2; target: scorePlayer; actionSelector: #positionInScore:; adjustToValue: scorePlayer positionInScore. r := self makeRow hResizing: #shrinkWrap; vResizing: #rigid; height: 24. r addMorphBack: (StringMorph contents: 'start ' translated). r addMorphBack: scrollSlider. r addMorphBack: (StringMorph contents: ' end' translated). ^ r ! Item was changed: ----- Method: ScorePlayerMorph>>standaloneResumeButton (in category 'layout') ----- standaloneResumeButton | r | r := AlignmentMorph newRow. r color: Color red; borderWidth: 0; layoutInset: 6; useRoundedCorners. r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. r addMorphBack: ( SimpleButtonMorph new target: [ scorePlayer resumePlaying. r delete ]; borderColor: #raised; borderWidth: 2; color: Color green; label: 'Continue' translated; actionSelector: #value ). r setBalloonText: 'Continue playing a paused presentation' translated. ^r ! Item was changed: ----- Method: ScorePlayerMorph>>trackControlsFor: (in category 'layout') ----- trackControlsFor: trackIndex | r | r := self makeRow hResizing: #shrinkWrap; vResizing: #shrinkWrap. r addMorphBack: (self trackNumAndMuteButtonFor: trackIndex). r addMorphBack: (Morph new extent: 10@5; color: color). "spacer" r addMorphBack: (self panAndVolControlsFor: trackIndex). ^ r ! Item was changed: ----- Method: ScorePlayerMorph>>trackNumAndMuteButtonFor: (in category 'layout') ----- trackNumAndMuteButtonFor: trackIndex | muteButton instSelector pianoRollColor r | muteButton := SimpleSwitchMorph new onColor: (Color r: 1.0 g: 0.6 b: 0.6); offColor: color; color: color; label: 'Mute' translated; target: scorePlayer; actionSelector: #mutedForTrack:put:; arguments: (Array with: trackIndex). instSelector := PopUpChoiceMorph new extent: 95@14; contentsClipped: 'oboe1'; target: self; actionSelector: #atTrack:from:selectInstrument:; getItemsSelector: #instrumentChoicesForTrack:; getItemsArgs: (Array with: trackIndex). instSelector arguments: (Array with: trackIndex with: instSelector). instrumentSelector at: trackIndex put: instSelector. "select track color using same color list as PianoRollScoreMorph" pianoRollColor := (Color wheel: scorePlayer score tracks size) at: trackIndex. r := self makeRow hResizing: #rigid; vResizing: #spaceFill; extent: 70@10. r addMorphBack: ((StringMorph contents: trackIndex printString font: (TextStyle default fontOfSize: 24)) color: pianoRollColor). trackIndex < 10 ifTrue: [r addMorphBack: (Morph new color: color; extent: 19@8)] "spacer" ifFalse: [r addMorphBack: (Morph new color: color; extent: 8@8)]. "spacer" r addMorphBack: (StringMorph new extent: 140@14; contentsClipped: (scorePlayer infoForTrack: trackIndex)). r addMorphBack: (Morph new color: color; extent: 8@8). "spacer" r addMorphBack: instSelector. r addMorphBack: (AlignmentMorph newRow color: color). "spacer" r addMorphBack: muteButton. ^ r ! Item was changed: ----- Method: ScorePlayerMorph>>updateInstrumentsFromLibraryExcept: (in category 'menu') ----- updateInstrumentsFromLibraryExcept: soundsBeingEdited "The instrument library has been modified. Update my instruments with the new versions from the library. Use a single instrument prototype for all parts with the same name; this allows the envelope editor to edit all the parts by changing a single sound prototype." "soundsBeingEdited is a collection of sounds being edited (by an EnvelopeEditor). If any of my instruments share one of these, then they will be left alone so as not to disturb that dynamic linkage." | unloadPostfix myInstruments name displaysAsUnloaded isUnloaded | unloadPostfix := '(out)'. myInstruments := Dictionary new. 1 to: instrumentSelector size do: [:i | name := (instrumentSelector at: i) contents. displaysAsUnloaded := name endsWith: unloadPostfix. displaysAsUnloaded ifTrue: [ name := name copyFrom: 1 to: name size - unloadPostfix size]. (myInstruments includesKey: name) ifFalse: [ myInstruments at: name put: (name = 'clink' ifTrue: [ (SampledSound samples: SampledSound coffeeCupClink samplingRate: 11025) copy] ifFalse: [ (AbstractSound soundNamed: name ifAbsent: [ (instrumentSelector at: i) contentsClipped: 'default'. FMSound default]) copy])]. (soundsBeingEdited includes: (scorePlayer instrumentForTrack: i)) ifFalse: ["Do not update any instrument that is currently being edited" scorePlayer instrumentForTrack: i put: (myInstruments at: name)]. "update loaded/unloaded status in instrumentSelector if necessary" isUnloaded := (myInstruments at: name) isKindOf: UnloadedSound. (displaysAsUnloaded and: [isUnloaded not]) ifTrue: [(instrumentSelector at: i) contentsClipped: name]. (displaysAsUnloaded not and: [isUnloaded]) ifTrue: [(instrumentSelector at: i) contentsClipped: name, unloadPostfix]]. ! Item was changed: ----- Method: ScorePlayerMorph>>volumeControl (in category 'layout') ----- volumeControl | volumeSlider r | volumeSlider := SimpleSliderMorph new color: color; sliderColor: Color gray; extent: 80@2; target: scorePlayer; actionSelector: #overallVolume:; adjustToValue: scorePlayer overallVolume. r := self makeRow hResizing: #shrinkWrap; vResizing: #rigid; height: 24. r addMorphBack: (StringMorph contents: 'soft ' translated). r addMorphBack: volumeSlider. r addMorphBack: (StringMorph contents: ' loud' translated). ^ r ! Item was changed: ----- Method: Sonogram>>extent: (in category 'geometry') ----- extent: newExtent super image: (Form extent: newExtent depth: Display depth). lastX := -1. columnForm := Form extent: (32//image depth)@(image height) depth: image depth. pixValMap := ((1 to: 256) collect: [:i | columnForm pixelValueFor: (Color gray: (256-i)/255.0)]) as: Bitmap. ! Item was changed: ----- Method: Sonogram>>extent:minVal:maxVal:scrollDelta: (in category 'all') ----- extent: extent minVal: min maxVal: max scrollDelta: d minVal := min. maxVal := max. scrollDelta := d. self extent: extent. " try following with scrolldelta = 1, 20, 200 | s data | s := Sonogram new extent: 200@50 minVal: 0.0 maxVal: 1.0 scrollDelta: 20. World addMorph: s. data := (1 to: 133) collect: [:i | 0.0]. 1 to: 300 do: [:i | data at: (i\\133)+1 put: 1.0. s plotColumn: data. data at: (i\\133)+1 put: 0.0. World doOneCycleNow]. s delete "! Item was changed: ----- Method: Sonogram>>scroll (in category 'all') ----- scroll image copy: (scrollDelta@0 extent: (image width-scrollDelta)@image height) from: image to: 0@0 rule: Form over. lastX := lastX - scrollDelta. self changed! Item was changed: ----- Method: String>>asStringMorph (in category '*Morphic') ----- asStringMorph "Answer the receiver as a StringMorph" ^ StringMorph contents: self "'bugs black blood' asStringMorph openInHand"! Item was changed: ----- Method: String>>hasContentsInExplorer (in category '*Morphic-Explorer') ----- hasContentsInExplorer ^false! Item was changed: ----- Method: SyntaxError class>>buildMorphicViewOn: (in category '*Morphic-Support') ----- buildMorphicViewOn: aSyntaxError "Answer an Morphic view on the given SyntaxError." | window | window := (SystemWindow labelled: 'Syntax Error') model: aSyntaxError. window addMorph: (PluggableListMorph on: aSyntaxError list: #list selected: #listIndex changeSelected: nil menu: #listMenu:) frame: (0@0 corner: 1(a)0.15). window addMorph: (PluggableTextMorph on: aSyntaxError text: #contents accept: #contents:notifying: readSelection: #contentsSelection menu: #codePaneMenu:shifted:) frame: (0(a)0.15 corner: 1@1). ^ window openInWorldExtent: 380@220! Item was changed: ----- Method: TextContainer>>paragraphClass (in category 'access') ----- paragraphClass ^ NewParagraph! Item was changed: ----- Method: TextMorph>>paragraphClass (in category 'private') ----- paragraphClass container ifNil: [^ NewParagraph]. ^ container paragraphClass! Item was changed: ----- Method: TheWorldMenu>>saveAndQuit (in category 'commands') ----- saveAndQuit Smalltalk snapshot: true andQuit: true! Item was changed: ----- Method: UpdatingStringMorph>>acceptValue: (in category 'editing') ----- acceptValue: aValue self updateContentsFrom: (self acceptValueFromTarget: aValue). ! Item was changed: ----- Method: WorldState>>releaseRemoteServer (in category 'Nebraska support') ----- releaseRemoteServer "My server has been transferred to some other world. Release pending references" remoteServer := nil. self canvas: nil.! Item was changed: ----- Method: WorldState>>remoteServer: (in category 'Nebraska support') ----- remoteServer: aNebraskaServer remoteServer ifNotNil:[remoteServer destroy]. remoteServer := aNebraskaServer. self canvas: nil.!

1 0

The Trunk: Monticello-bf.607.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

Bert Freudenberg uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-bf.607.mcz ==================== Summary ==================== Name: Monticello-bf.607 Author: bf Time: 8 December 2014, 1:50:25.234 am UUID: 81a1a240-6885-485d-a146-3de727e5d1eb Ancestors: Monticello-eem.606 Restore timestamps lost in assignment conversion. =============== Diff against Monticello-eem.606 =============== Item was changed: ----- Method: ChangeList>>changeTo: (in category '*monticello') ----- changeTo: changeSubset | newList newChangeList | newChangeList := OrderedCollection new. newList := OrderedCollection new. 1 to: changeList size do: [:i | (changeSubset includes: (changeList at: i)) ifTrue: [newChangeList add: (changeList at: i). newList add: (list at: i)]]. newChangeList size < changeList size ifTrue: [changeList := newChangeList. list := newList. listIndex := 0. listSelections := Array new: list size withAll: false]. self changed: #list ! Item was changed: ----- Method: CrLfFileStream>>lineEndingConvention: (in category '*monticello') ----- lineEndingConvention: aSymbol lineEndConvention := aSymbol! Item was changed: ----- Method: MCAddition>>intializeWithDefinition: (in category 'initializing') ----- intializeWithDefinition: aDefinition definition := aDefinition! Item was changed: ----- Method: MCAncestry>>commonAncestorWith: (in category 'ancestry') ----- commonAncestorWith: aNode | commonAncestors | commonAncestors := self commonAncestorsWith: aNode. ^ commonAncestors at: 1 ifAbsent: [nil]! Item was changed: ----- Method: MCAncestry>>commonAncestorsWith: (in category 'ancestry') ----- commonAncestorsWith: aVersionInfo | sharedAncestors mergedOrder sorter | sorter := MCVersionSorter new addVersionInfo: self; addVersionInfo: aVersionInfo. mergedOrder := sorter sortedVersionInfos. sharedAncestors := (sorter allAncestorsOf: self) intersection: (sorter allAncestorsOf: aVersionInfo). ^ mergedOrder select: [:ea | sharedAncestors includes: ea]! Item was changed: ----- Method: MCAncestry>>initialize (in category 'initialize-release') ----- initialize ancestors := #(). stepChildren := #()! Item was changed: ----- Method: MCCacheRepository>>cacheForPackage: (in category 'as yet unclassified') ----- cacheForPackage: aPackage packageCaches ifNil: [packageCaches := Dictionary new]. ^ packageCaches at: aPackage ifAbsentPut: [MCPackageCache new]! Item was changed: ----- Method: MCCacheRepository>>seenFileNames (in category 'as yet unclassified') ----- seenFileNames ^ seenFiles ifNil: [seenFiles := OrderedCollection new]! Item was changed: ----- Method: MCChangeSelectionRequest>>label: (in category 'accessing') ----- label: aString label := aString! Item was changed: ----- Method: MCChangeSelectionRequest>>patch: (in category 'accessing') ----- patch: aPatch patch := aPatch! Item was changed: ----- Method: MCChangeSelector>>kept (in category 'as yet unclassified') ----- kept ^ kept ifNil: [kept := Set new]! Item was changed: ----- Method: MCChangeSelector>>listSelectionAt:put: (in category 'as yet unclassified') ----- listSelectionAt: aNumber put: aBoolean | item | item := self items at: aNumber. aBoolean ifTrue: [self kept add: item ] ifFalse: [self kept remove: item ifAbsent: []]! Item was changed: ----- Method: MCChangeSelector>>selectNone (in category 'as yet unclassified') ----- selectNone kept := Set new. self changed: #list! Item was changed: ----- Method: MCCodeTool>>browseVersions (in category 'menus') ----- browseVersions "Create and schedule a message set browser on all versions of the currently selected message selector." | class selector compiledMethod | class := self selectedClassOrMetaClass. selector := self selectedMessageName. compiledMethod := class compiledMethodAt: selector ifAbsent: [ ^self ]. VersionsBrowser browseVersionsOf: compiledMethod class: class theNonMetaClass meta: class isMeta category: self selectedMessageCategoryName selector: selector! Item was changed: ----- Method: MCCodeTool>>copySelector (in category 'menus') ----- copySelector "Copy the selected selector to the clipboard" | selector | (selector := self selectedMessageName) ifNotNil: [Clipboard clipboardText: selector asString]! Item was changed: ----- Method: MCCodeTool>>findMethodInChangeSets (in category 'menus') ----- findMethodInChangeSets "Find and open a changeSet containing the current method." | aName | (aName := self selectedMessageName) ifNotNil: [ ChangeSorter browseChangeSetsWithClass: self selectedClassOrMetaClass selector: aName]! Item was changed: ----- Method: MCConflict>>chooseLocal (in category 'as yet unclassified') ----- chooseLocal chooseRemote := false! Item was changed: ----- Method: MCConflict>>chooseRemote (in category 'as yet unclassified') ----- chooseRemote chooseRemote := true! Item was changed: ----- Method: MCConflict>>clearChoice (in category 'as yet unclassified') ----- clearChoice chooseRemote := nil! Item was changed: ----- Method: MCConflict>>operation: (in category 'as yet unclassified') ----- operation: anOperation operation := anOperation! Item was changed: ----- Method: MCConflict>>summary (in category 'as yet unclassified') ----- summary | attribute | attribute := self isResolved ifTrue: [self remoteChosen ifTrue: [#underlined] ifFalse: [#struckOut]] ifFalse: [#bold]. ^ Text string: operation summary attribute: (TextEmphasis perform: attribute)! Item was changed: ----- Method: MCDefinitionIndex>>definitionLike:ifPresent:ifAbsent: (in category 'as yet unclassified') ----- definitionLike: aDefinition ifPresent: foundBlock ifAbsent: errorBlock | definition | definition := definitions at: aDefinition description ifAbsent: []. ^ definition ifNil: errorBlock ifNotNil: [foundBlock value: definition]! Item was changed: ----- Method: MCDefinitionIndex>>initialize (in category 'as yet unclassified') ----- initialize definitions := Dictionary new! Item was changed: ----- Method: MCDependencySorter class>>sortItems: (in category 'as yet unclassified') ----- sortItems: aCollection | sorter | sorter := self items: aCollection. sorter externalRequirements do: [:req | sorter addProvision: req]. ^ sorter orderedItems.! Item was changed: ----- Method: MCDependencySorter>>addProvision: (in category 'private') ----- addProvision: anObject | newlySatisfied | provided add: anObject. newlySatisfied := required removeKey: anObject ifAbsent: [#()]. self addAll: newlySatisfied.! Item was changed: ----- Method: MCDependencySorter>>initialize (in category 'initialize-release') ----- initialize provided := Set new. required := Dictionary new. orderedItems := OrderedCollection new.! Item was changed: ----- Method: MCDependencySorter>>itemsWithMissingRequirements (in category 'accessing') ----- itemsWithMissingRequirements | items | items := Set new. required do: [:ea | items addAll: ea]. ^ items ! Item was changed: ----- Method: MCDictionaryRepository>>description: (in category 'as yet unclassified') ----- description: aString description := aString ! Item was changed: ----- Method: MCDictionaryRepository>>dictionary: (in category 'as yet unclassified') ----- dictionary: aDictionary dict := aDictionary! Item was changed: ----- Method: MCDictionaryRepository>>initialize (in category 'as yet unclassified') ----- initialize dict := Dictionary new. ! Item was changed: ----- Method: MCDictionaryRepository>>sortedVersionInfos (in category 'as yet unclassified') ----- sortedVersionInfos | sorter | sorter := MCVersionSorter new. self allVersionInfos do: [:ea | sorter addVersionInfo: ea]. ^ sorter sortedVersionInfos ! Item was changed: ----- Method: MCDiffyVersion>>initializeWithPackage:info:dependencies:baseInfo:patch: (in category 'as yet unclassified') ----- initializeWithPackage: aPackage info: aVersionInfo dependencies: aCollection baseInfo: baseVersionInfo patch: aPatch patch := aPatch. base := baseVersionInfo. super initializeWithPackage: aPackage info: aVersionInfo snapshot: nil dependencies: aCollection. ! Item was changed: ----- Method: MCDiffyVersion>>snapshot (in category 'as yet unclassified') ----- snapshot ^ snapshot ifNil: [snapshot := MCPatcher apply: patch to: self baseSnapshot]! Item was changed: ----- Method: MCDirectoryRepository>>directory: (in category 'accessing') ----- directory: aDirectory directory := aDirectory! Item was changed: ----- Method: MCDirectoryRepository>>initialize (in category 'accessing') ----- initialize directory := FileDirectory default! Item was changed: ----- Method: MCDirectoryRepository>>readStreamForFileNamed:do: (in category 'accessing') ----- readStreamForFileNamed: aString do: aBlock | file val | file := FileStream readOnlyFileNamed: (directory fullNameFor: aString). val := aBlock value: file. file close. ^ val! Item was changed: ----- Method: MCDirectoryRepository>>writeStreamForFileNamed:replace:do: (in category 'accessing') ----- writeStreamForFileNamed: aString replace: aBoolean do: aBlock | file sel | sel := aBoolean ifTrue: [#forceNewFileNamed:] ifFalse: [#newFileNamed:]. file := FileStream perform: sel with: (directory fullNameFor: aString). aBlock value: file. file close.! Item was changed: ----- Method: MCDoItParser>>source: (in category 'as yet unclassified') ----- source: aString source := aString! Item was changed: ----- Method: MCFileBasedRepository>>canReadFileNamed: (in category 'private-files') ----- canReadFileNamed: aString | reader | reader := MCVersionReader readerClassForFileNamed: aString. ^ reader notNil! Item was changed: ----- Method: MCFilteredVersionSorter>>target: (in category 'as yet unclassified') ----- target: aVersionInfo target := aVersionInfo! Item was changed: ----- Method: MCFtpRepository>>clientDo: (in category 'as yet unclassified') ----- clientDo: aBlock | client | client := FTPClient openOnHostNamed: host. client loginUser: user password: password. directory isEmpty ifFalse: [client changeDirectoryTo: directory]. ^ [aBlock value: client] ensure: [client close]! Item was changed: ----- Method: MCFtpRepository>>directory: (in category 'as yet unclassified') ----- directory: dirPath directory := dirPath! Item was changed: ----- Method: MCFtpRepository>>host: (in category 'as yet unclassified') ----- host: hostname host := hostname! Item was changed: ----- Method: MCFtpRepository>>password: (in category 'as yet unclassified') ----- password: passwordString password := passwordString! Item was changed: ----- Method: MCFtpRepository>>user: (in category 'as yet unclassified') ----- user: userString user := userString! Item was changed: ----- Method: MCFtpRepository>>writeStreamForFileNamed:replace:do: (in category 'required') ----- writeStreamForFileNamed: aString replace: ignoreBoolean do: aBlock | stream | stream := RWBinaryOrTextStream on: String new. aBlock value: stream. self clientDo: [:client | client binary. client putFileStreamContents: stream reset as: aString]! Item was changed: ----- Method: MCGOODSRepository>>host: (in category 'as yet unclassified') ----- host: aString hostname := aString! Item was changed: ----- Method: MCGOODSRepository>>port: (in category 'as yet unclassified') ----- port: aNumber port := aNumber! Item was changed: ----- Method: MCHttpRepository>>location: (in category 'accessing') ----- location: aUrlString location := aUrlString! Item was changed: ----- Method: MCHttpRepository>>password: (in category 'accessing') ----- password: passwordString password := passwordString! Item was changed: ----- Method: MCHttpRepository>>user: (in category 'accessing') ----- user: userString user := userString! Item was changed: ----- Method: MCMcdReader>>loadBaseInfo (in category 'as yet unclassified') ----- loadBaseInfo ^ baseInfo := self extractInfoFrom: (self parseMember: 'base')! Item was changed: ----- Method: MCMczReader>>infoCache (in category 'as yet unclassified') ----- infoCache ^ infoCache ifNil: [infoCache := Dictionary new]! Item was changed: ----- Method: MCMczReader>>loadDependencies (in category 'loading') ----- loadDependencies dependencies := (self zip membersMatching: 'dependencies/*') collect: [:m | self extractDependencyFrom: m]. dependencies := dependencies asArray. ! Item was changed: ----- Method: MCMczReader>>loadPackage (in category 'loading') ----- loadPackage | dict | dict := self parseMember: 'package'. package := MCPackage named: (dict at: #name)! Item was changed: ----- Method: MCMczReader>>loadVersionInfo (in category 'loading') ----- loadVersionInfo info := self extractInfoFrom: (self parseMember: 'version')! Item was changed: ----- Method: MCMczReader>>zip (in category 'as yet unclassified') ----- zip zip ifNil: [zip := ZipArchive new. zip readFrom: stream]. ^ zip! Item was changed: ----- Method: MCMczWriter class>>fileOut:on: (in category 'as yet unclassified') ----- fileOut: aVersion on: aStream | inst | inst := self on: aStream. inst writeVersion: aVersion. inst flush. ! Item was changed: ----- Method: MCMczWriter>>addString:at: (in category 'writing') ----- addString: string at: path | member | member := zip addString: string as: path. member desiredCompressionMethod: ZipArchive compressionDeflated ! Item was changed: ----- Method: MCMczWriter>>initialize (in category 'initializing') ----- initialize zip := ZipArchive new. ! Item was changed: ----- Method: MCMczWriter>>serializeInBinary: (in category 'serializing') ----- serializeInBinary: aSnapshot | writer s | s := RWBinaryOrTextStream on: String new. writer := DataStream on: s. writer nextPut: aSnapshot. ^ s contents! Item was changed: ----- Method: MCMczWriter>>serializeVersionInfo: (in category 'serializing') ----- serializeVersionInfo: aVersionInfo infoWriter ifNil: [infoWriter := MCVersionInfoWriter new]. ^ String streamContents: [:s | infoWriter stream: s. infoWriter writeVersionInfo: aVersionInfo]! Item was changed: ----- Method: MCMergeBrowser class>>resolveConflictsInMerger: (in category 'as yet unclassified') ----- resolveConflictsInMerger: aMerger | inst | inst := self new merger: aMerger. ^ inst showModally ifNil: [false]! Item was changed: ----- Method: MCMergeRecord>>ancestorInfo (in category 'as yet unclassified') ----- ancestorInfo ^ ancestorInfo ifNil: [ancestorInfo := version info commonAncestorWith: version workingCopy ancestry]! Item was changed: ----- Method: MCMergeRecord>>ancestorSnapshot (in category 'as yet unclassified') ----- ancestorSnapshot ^ ancestorSnapshot ifNil: [ancestorSnapshot := version workingCopy findSnapshotWithVersionInfo: self ancestorInfo]! Item was changed: ----- Method: MCMergeRecord>>imagePatch (in category 'as yet unclassified') ----- imagePatch ^ imagePatch ifNil: [imagePatch := self packageSnapshot patchRelativeToBase: self ancestorSnapshot]! Item was changed: ----- Method: MCMergeRecord>>initializeWithVersion: (in category 'as yet unclassified') ----- initializeWithVersion: aVersion version := aVersion! Item was changed: ----- Method: MCMergeRecord>>mergePatch (in category 'as yet unclassified') ----- mergePatch ^ mergePatch ifNil: [mergePatch := version snapshot patchRelativeToBase: self ancestorSnapshot]! Item was changed: ----- Method: MCMergeRecord>>packageSnapshot (in category 'as yet unclassified') ----- packageSnapshot ^ packageSnapshot ifNil: [packageSnapshot := version package snapshot]! Item was changed: ----- Method: MCMergeResolutionRequest>>merger: (in category 'accessing') ----- merger: aMerger merger := aMerger! Item was changed: ----- Method: MCMerger>>conflicts (in category 'as yet unclassified') ----- conflicts ^ conflicts ifNil: [conflicts := OrderedCollection new]! Item was changed: ----- Method: MCMerger>>load (in category 'as yet unclassified') ----- load | loader | loader := MCPackageLoader new. loader provisions addAll: self provisions. self applyTo: loader. loader load! Item was changed: ----- Method: MCModification>>initializeWithBase:target: (in category 'initializing') ----- initializeWithBase: base target: target obsoletion := base. modification := target.! Item was changed: ----- Method: MCOrganizationDefinition>>categories: (in category 'accessing') ----- categories: anArray categories := anArray! Item was changed: ----- Method: MCOrganizationDefinition>>commonPrefix (in category 'accessing') ----- commonPrefix | stream | categories isEmpty ifTrue: [^ '']. stream := String new writeStream. categories first withIndexDo: [:c :i| categories do: [:ea | (ea at: i ifAbsent: []) = c ifFalse: [^ stream contents]]. stream nextPut: c]. ^ stream contents! Item was changed: ----- Method: MCPackage>>name: (in category 'accessing') ----- name: aString name := aString! Item was changed: ----- Method: MCPackageCache>>initialize (in category 'as yet unclassified') ----- initialize sorter := MCVersionSorter new. fileNames := Dictionary new.! Item was changed: ----- Method: MCPackageLoader>>analyze (in category 'private') ----- analyze | sorter | sorter := self sorterForItems: additions. additions := sorter orderedItems. requirements := sorter externalRequirements. unloadableDefinitions := sorter itemsWithMissingRequirements asSortedCollection. sorter := self sorterForItems: removals. removals := sorter orderedItems reversed.! Item was changed: ----- Method: MCPackageLoader>>installSnapshot: (in category 'public') ----- installSnapshot: aSnapshot | patch | patch := aSnapshot patchRelativeToBase: MCSnapshot empty. patch applyTo: self. ! Item was changed: ----- Method: MCPackageLoader>>sorterForItems: (in category 'private') ----- sorterForItems: aCollection | sorter | sorter := MCDependencySorter items: aCollection. sorter addExternalProvisions: self provisions. ^ sorter! Item was changed: ----- Method: MCPackageLoader>>updatePackage:withSnapshot: (in category 'public') ----- updatePackage: aPackage withSnapshot: aSnapshot | patch packageSnap | packageSnap := aPackage snapshot. patch := aSnapshot patchRelativeToBase: packageSnap. patch applyTo: self. packageSnap definitions do: [:ea | self provisions addAll: ea provisions] ! Item was changed: ----- Method: MCPackageManager class>>forPackage: (in category 'as yet unclassified') ----- forPackage: aPackage ^ self registry at: aPackage ifAbsent: [|mgr| mgr := self new initializeWithPackage: aPackage. self registry at: aPackage put: mgr. self changed: #allManagers. mgr]! Item was changed: ----- Method: MCPackageManager class>>registry (in category 'as yet unclassified') ----- registry ^ registry ifNil: [registry := Dictionary new]! Item was changed: ----- Method: MCPackageManager>>initialize (in category 'initialize-release') ----- initialize modified := false. self registerForNotifications.! Item was changed: ----- Method: MCPackageManager>>initializeWithPackage: (in category 'initialize-release') ----- initializeWithPackage: aPackage package := aPackage. self initialize.! Item was changed: ----- Method: MCPatch>>initializeWithBase:target: (in category 'initialize-release') ----- initializeWithBase: baseSnapshot target: targetSnapshot | base target | operations := OrderedCollection new. base := MCDefinitionIndex definitions: baseSnapshot definitions. target := MCDefinitionIndex definitions: targetSnapshot definitions. target definitions do: [:t | base definitionLike: t ifPresent: [:b | (b isSameRevisionAs: t) ifFalse: [operations add: (MCModification of: b to: t)]] ifAbsent: [operations add: (MCAddition of: t)]] displayingProgress: 'Diffing...'. base definitions do: [:b | target definitionLike: b ifPresent: [:t] ifAbsent: [operations add: (MCRemoval of: b)]] ! Item was changed: ----- Method: MCPatchBrowser>>patch: (in category 'initialize-release') ----- patch: aPatch items := aPatch operations asSortedCollection! Item was changed: ----- Method: MCPatcher class>>apply:to: (in category 'as yet unclassified') ----- apply: aPatch to: aSnapshot | loader | loader := self snapshot: aSnapshot. aPatch applyTo: loader. ^ loader patchedSnapshot! Item was changed: ----- Method: MCPatcher>>initializeWithSnapshot: (in category 'as yet unclassified') ----- initializeWithSnapshot: aSnapshot definitions := MCDefinitionIndex definitions: aSnapshot definitions! Item was changed: ----- Method: MCReader class>>on:name: (in category 'instance creation') ----- on: aStream name: aFileName | class | class := self readerClassForFileNamed: aFileName. ^ class ifNil: [self error: 'Unsupported format: ', aFileName] ifNotNil: [class on: aStream]! Item was changed: ----- Method: MCReader>>stream: (in category 'accessing') ----- stream: aStream stream := aStream! Item was changed: ----- Method: MCRemoval>>intializeWithDefinition: (in category 'initializing') ----- intializeWithDefinition: aDefinition definition := aDefinition! Item was changed: ----- Method: MCRepository>>doAlwaysStoreDiffs (in category 'accessing') ----- doAlwaysStoreDiffs storeDiffs := true! Item was changed: ----- Method: MCRepository>>doNotAlwaysStoreDiffs (in category 'accessing') ----- doNotAlwaysStoreDiffs storeDiffs := false! Item was changed: ----- Method: MCRepository>>sendNotificationsForVersion: (in category 'accessing') ----- sendNotificationsForVersion: aVersion | notification notifyList | notifyList := self notifyList. notifyList isEmpty ifFalse: [notification := self notificationForVersion: aVersion. notifyList do: [:ea | notification notify: ea]]! Item was changed: ----- Method: MCRepositoryGroup class>>default (in category 'accessing') ----- default ^ default ifNil: [default := self new]! Item was changed: ----- Method: MCRepositoryInspector class>>repository:workingCopy: (in category 'instance creation') ----- repository: aFileBasedRepository workingCopy: aWorkingCopy ^self new setRepository: aFileBasedRepository workingCopy: aWorkingCopy; yourself! Item was changed: ----- Method: MCRepositoryInspector>>defaultExtent (in category 'morphic ui') ----- defaultExtent ^450@300! Item was changed: ----- Method: MCRepositoryInspector>>defaultLabel (in category 'morphic ui') ----- defaultLabel ^'Repository: ' , repository description! Item was changed: ----- Method: MCRepositoryInspector>>hasVersion (in category 'morphic ui') ----- hasVersion ^ selectedVersion notNil! Item was changed: ----- Method: MCRepositoryInspector>>packageListMenu: (in category 'morphic ui') ----- packageListMenu: aMenu ^aMenu! Item was changed: ----- Method: MCRepositoryInspector>>widgetSpecs (in category 'morphic ui') ----- widgetSpecs ^#( ((buttonRow) (0 0 1 0) (0 0 0 30)) ((listMorph: package) (0 0 0.5 0.6) (0 30 0 0)) ((listMorph: version) (0.5 0 1 0.6) (0 30 0 0)) ((textMorph: summary) (0 0.6 1 1) (0 0 0 0)) )! Item was changed: ----- Method: MCSMCacheRepository>>allFullFileNames (in category 'accessing') ----- allFullFileNames | cachedPackages | cachedPackages := smCache map installedPackages select: [ :ea | ea isCached ]. ^Array streamContents: [ :s | cachedPackages do: [ :ea | | d | d := ea cacheDirectory. (d fileNamesMatching: '*.mcz') do: [ :fn | s nextPut: (d fullNameFor: fn) ]]]! Item was changed: ----- Method: MCSMCacheRepository>>readStreamForFileNamed:do: (in category 'file streaming') ----- readStreamForFileNamed: aString do: aBlock | file fileName | fileName := self fullNameFor: aString. fileName ifNil: [ "assume that this will come from the cache." ^MCCacheRepository default readStreamForFileNamed: aString do: aBlock ]. file := FileStream readOnlyFileNamed: fileName. ^[ aBlock value: file ] ensure: [ file close ]. ! Item was changed: ----- Method: MCSMReleaseRepository>>basicStoreVersion: (in category 'as yet unclassified') ----- basicStoreVersion: aVersion | url | url := self uploadVersion: aVersion. self releaseVersion: aVersion url: url! Item was changed: ----- Method: MCSMReleaseRepository>>initializeWithPackage:user:password: (in category 'as yet unclassified') ----- initializeWithPackage: packageString user: userString password: passString packageName := packageString. user := userString. password := passString. ! Item was changed: ----- Method: MCSMReleaseRepository>>stringForVersion: (in category 'as yet unclassified') ----- stringForVersion: aVersion | stream | stream := RWBinaryOrTextStream on: String new. aVersion fileOutOn: stream. ^ stream contents! Item was changed: ----- Method: MCSMReleaseRepository>>uploadVersion: (in category 'as yet unclassified') ----- uploadVersion: aVersion | result stream | result := HTTPSocket httpPut: (self stringForVersion: aVersion) to: self squeakMapUrl, '/upload/', aVersion fileName user: user passwd: password. self checkResult: result. stream := result readStream. stream upToAll: 'http://'. ^ 'http://', stream upToEnd! Item was changed: ----- Method: MCSaveVersionDialog>>logMessage: (in category 'accessing') ----- logMessage: aString message := aString. self changed: #logMessage! Item was changed: ----- Method: MCSaveVersionDialog>>versionName: (in category 'accessing') ----- versionName: aString name := aString. self changed: #versionName! Item was changed: ----- Method: MCScanner>>next (in category 'as yet unclassified') ----- next | c | stream skipSeparators. c := stream peek. c = $# ifTrue: [c := stream next; peek]. c = $' ifTrue: [^ self nextString]. c = $( ifTrue: [^ self nextArray]. c isAlphaNumeric ifTrue: [^ self nextSymbol]. self error: 'Unknown token type'. ! Item was changed: ----- Method: MCScanner>>stream: (in category 'as yet unclassified') ----- stream: aStream stream := aStream! Item was changed: ----- Method: MCSmtpRepository>>emailAddress: (in category 'as yet unclassified') ----- emailAddress: aString email := aString ! Item was changed: ----- Method: MCSnapshot>>initializeWithDefinitions: (in category 'initializing') ----- initializeWithDefinitions: aCollection definitions := aCollection.! Item was changed: ----- Method: MCSnapshotBrowser>>categorySelection: (in category 'selecting') ----- categorySelection: aNumber categorySelection := aNumber = 0 ifFalse: [self visibleCategories at: aNumber]. self classSelection: 0. self changed: #categorySelection; changed: #annotations; changed: #classList. ! Item was changed: ----- Method: MCSnapshotBrowser>>classDefinitionString (in category 'text') ----- classDefinitionString | defs | defs := items select: [:ea | (ea isClassDefinition or: [ea isClassDefinitionExtension]) and: [ea className = classSelection]]. defs isEmpty ifTrue: [^ 'This class is defined elsewhere.']. ^ String streamContents: [:stream | defs asArray sort do: [:ea | ea printDefinitionOn: stream] separatedBy: [stream nextPut: $.; cr] ].! Item was changed: ----- Method: MCSnapshotBrowser>>methodSelection: (in category 'selecting') ----- methodSelection: aNumber methodSelection := aNumber = 0 ifFalse: [self visibleMethods at: aNumber]. self changed: #methodSelection; changed: #text; changed: #annotations! Item was changed: ----- Method: MCSnapshotBrowser>>methodsForSelectedProtocol (in category 'accessing') ----- methodsForSelectedProtocol | methods | protocolSelection ifNil: [^ Array new]. methods := self methodsForSelectedClass asOrderedCollection. (protocolSelection = '-- all --') ifFalse: [methods removeAllSuchThat: [:ea | ea category ~= protocolSelection]]. ^ methods ! Item was changed: ----- Method: MCSnapshotBrowser>>protocolSelection: (in category 'selecting') ----- protocolSelection: anInteger protocolSelection := (anInteger = 0 ifFalse: [self visibleProtocols at: anInteger]). self methodSelection: 0. self changed: #protocolSelection; changed: #methodList; changed: #annotations! Item was changed: ----- Method: MCSnapshotBrowser>>selectedClassOrMetaClass (in category 'accessing') ----- selectedClassOrMetaClass | class | classSelection ifNil: [ ^nil ]. class := Smalltalk at: classSelection ifAbsent: [ ^nil ]. ^self switchIsClass ifTrue: [ class class ] ifFalse: [ class ].! Item was changed: ----- Method: MCSnapshotBrowser>>snapshot: (in category 'accessing') ----- snapshot: aSnapshot items := aSnapshot definitions asSortedCollection. self categorySelection: 0.! Item was changed: ----- Method: MCSnapshotBrowser>>switchBeClass (in category 'switch') ----- switchBeClass switch := #class. self signalSwitchChanged.! Item was changed: ----- Method: MCSnapshotBrowser>>switchBeComment (in category 'switch') ----- switchBeComment switch := #comment. self signalSwitchChanged.! Item was changed: ----- Method: MCSnapshotBrowser>>switchBeInstance (in category 'switch') ----- switchBeInstance switch := #instance. self signalSwitchChanged.! Item was changed: ----- Method: MCSnapshotBrowser>>switchIsInstance (in category 'switch') ----- switchIsInstance switch ifNil: [switch := #instance]. ^ switch = #instance.! Item was changed: ----- Method: MCSnapshotBrowser>>visibleProtocols (in category 'listing') ----- visibleProtocols | methods protocols | self switchIsComment ifTrue: [^ Array new]. methods := self methodsForSelectedClass. protocols := (methods collect: [:ea | ea category]) asSet asSortedCollection. (protocols size > 1) ifTrue: [protocols add: '-- all --']. ^ protocols ! Item was changed: ----- Method: MCStReader>>categoryFromDoIt: (in category 'as yet unclassified') ----- categoryFromDoIt: aString | tokens | tokens := Scanner new scanTokens: aString. tokens size = 3 ifFalse: [self error: 'Unrecognized category definition']. ^ tokens at: 3! Item was changed: ----- Method: MCStReader>>commentFor: (in category 'as yet unclassified') ----- commentFor: aPseudoClass | comment | comment := aPseudoClass organization classComment. ^ comment asString = '' ifTrue: [comment] ifFalse: [comment string]! Item was changed: ----- Method: MCStReader>>commentStampFor: (in category 'as yet unclassified') ----- commentStampFor: aPseudoClass | comment | comment := aPseudoClass organization classComment. ^ [comment stamp] on: MessageNotUnderstood do: [nil]! Item was changed: ----- Method: MCStReader>>loadDefinitions (in category 'evaluating') ----- loadDefinitions | filePackage | filePackage := FilePackage new fullName: 'ReadStream'; fileInFrom: self readStream. definitions := OrderedCollection new. filePackage classes do: [:pseudoClass | pseudoClass hasDefinition ifTrue: [definitions add: (self classDefinitionFrom: pseudoClass)]. definitions addAll: (self methodDefinitionsFor: pseudoClass). definitions addAll: (self methodDefinitionsFor: pseudoClass metaClass)]. filePackage doIts do: [:ea | self addDefinitionsFromDoit: ea string]. ! Item was changed: ----- Method: MCStReader>>systemOrganizationFromRecords: (in category 'as yet unclassified') ----- systemOrganizationFromRecords: changeRecords | categories | categories := changeRecords select: [:ea | 'SystemOrganization*' match: ea string] thenCollect: [:ea | (self categoryFromDoIt: ea string)]. ^ categories isEmpty ifFalse: [MCOrganizationDefinition categories: categories asArray]! Item was changed: ----- Method: MCSubDirectoryRepository>>findFullNameForReading: (in category 'as yet unclassified') ----- findFullNameForReading: aBaseName "Answer the latest version of aBaseName" | possible | possible := SortedCollection sortBlock: [ :a :b | b first modificationTime < a first modificationTime ]. self allDirectories do: [:dir | dir entries do: [:ent | ent isDirectory ifFalse: [ (ent name = aBaseName) ifTrue: [ possible add: {ent. dir fullNameFor: ent name}]]]]. ^(possible at: 1 ifAbsent: [ ^nil ]) second ! Item was changed: ----- Method: MCSubDirectoryRepository>>readStreamForFileNamed:do: (in category 'as yet unclassified') ----- readStreamForFileNamed: aString do: aBlock | file val | file := FileStream readOnlyFileNamed: (self findFullNameForReading: aString). val := aBlock value: file. file close. ^ val! Item was changed: ----- Method: MCSystemCategoryParser>>addDefinitionsTo: (in category 'as yet unclassified') ----- addDefinitionsTo: aCollection | definition | definition := aCollection detect: [:ea | ea isOrganizationDefinition ] ifNone: [aCollection add: (MCOrganizationDefinition categories: #())]. definition categories: (definition categories copyWith: self category).! Item was changed: ----- Method: MCSystemCategoryParser>>category (in category 'as yet unclassified') ----- category | tokens | tokens := Scanner new scanTokens: source. tokens size = 3 ifFalse: [self error: 'Unrecognized category definition']. ^ tokens at: 3! Item was changed: ----- Method: MCThreeWayMerger>>initialize (in category 'as yet unclassified') ----- initialize index := MCDefinitionIndex new. provisions := Set new! Item was changed: ----- Method: MCThreeWayMerger>>operations (in category 'as yet unclassified') ----- operations ^ operations ifNil: [operations := OrderedCollection new]! Item was changed: ----- Method: MCTool>>label: (in category 'morphic ui') ----- label: aString label := aString! Item was changed: ----- Method: MCTool>>window (in category 'morphic ui') ----- window ^ morph ifNil: [morph := self buildWindow]! Item was changed: ----- Method: MCVariableDefinition>>name: (in category 'accessing') ----- name: aString name := aString! Item was changed: ----- Method: MCVersion>>allDependenciesDo:ifUnresolved: (in category 'enumerating') ----- allDependenciesDo: aBlock ifUnresolved: failBlock | dict | dict := Dictionary new. self allDependenciesNotIn: dict do: aBlock ifUnresolved: failBlock! Item was changed: ----- Method: MCVersion>>setPackage:info:snapshot:dependencies: (in category 'initialize-release') ----- setPackage: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection package := aPackage. info := aVersionInfo. snapshot := aSnapshot. dependencies := aCollection! Item was changed: ----- Method: MCVersion>>withAllDependenciesDo:ifUnresolved: (in category 'enumerating') ----- withAllDependenciesDo: aBlock ifUnresolved: failBlock | dict | dict := Dictionary new. self allDependenciesNotIn: dict do: aBlock ifUnresolved: failBlock. aBlock value: self! Item was changed: ----- Method: MCVersionDependency>>initializeWithPackage:info: (in category 'initialize-release') ----- initializeWithPackage: aPackage info: aVersionInfo package := aPackage. versionInfo := aVersionInfo! Item was changed: ----- Method: MCVersionHistoryBrowser>>ancestry: (in category 'accessing') ----- ancestry: anAncestry ancestry := anAncestry! Item was changed: ----- Method: MCVersionHistoryBrowser>>index: (in category 'accessing') ----- index: anObject "Set the value of index" index := anObject! Item was changed: ----- Method: MCVersionHistoryBrowser>>package: (in category 'accessing') ----- package: aMCPackage package := aMCPackage! Item was changed: ----- Method: MCVersionHistoryBrowser>>selection: (in category 'accessing') ----- selection: aNumber index := aNumber. self changed: #selection; changed: #summary! Item was changed: ----- Method: MCVersionHistoryBrowser>>summary (in category 'accessing') ----- summary | selInfo | selInfo := self selectedInfo. ^ selInfo ifNil: [''] ifNotNil: [selInfo summary]! Item was changed: ----- Method: MCVersionInfoWriter>>written (in category 'as yet unclassified') ----- written ^ written ifNil: [written := Set new]! Item was changed: ----- Method: MCVersionInspector>>version: (in category 'accessing') ----- version: aVersion version := aVersion! Item was changed: ----- Method: MCVersionLoader>>checkForModifications (in category 'checking') ----- checkForModifications | modifications | modifications := versions select: [:ea | ea package workingCopy modified]. modifications isEmpty ifFalse: [self warnAboutLosingChangesTo: modifications].! Item was changed: ----- Method: MCVersionLoader>>initialize (in category 'initialize-release') ----- initialize versions := OrderedCollection new! Item was changed: ----- Method: MCVersionMerger>>initialize (in category 'as yet unclassified') ----- initialize records := OrderedCollection new. merger := MCThreeWayMerger new.! Item was changed: ----- Method: MCVersionNameAndMessageRequest>>suggestedName: (in category 'accessing') ----- suggestedName: aString suggestion := aString! Item was changed: ----- Method: MCVersionNotification>>initializeWithVersion:repository: (in category 'as yet unclassified') ----- initializeWithVersion: aVersion repository: aRepository version := aVersion. repository := aRepository. ancestor := repository closestAncestorVersionFor: version info ifNone: []. changes := ancestor ifNil: [#()] ifNotNil: [(version snapshot patchRelativeToBase: ancestor snapshot) operations asSortedCollection]! Item was changed: ----- Method: MCVersionNotification>>messageTo: (in category 'as yet unclassified') ----- messageTo: aString | message | message := MailMessage empty. message setField: 'from' toString: self fromAddress. message setField: 'to' toString: aString. message setField: 'subject' toString: '[MC] ', version info name. message body: (MIMEDocument contentType: 'text/plain' content: self messageText). ^ message! Item was changed: ----- Method: MCVersionNotification>>notify: (in category 'as yet unclassified') ----- notify: aString | message | message := self messageTo: aString. SMTPClient deliverMailFrom: message from to: (Array with: message to) text: message text usingServer: MailSender smtpServer! Item was changed: ----- Method: MCVersionSorter>>addToCurrentLayer: (in category 'as yet unclassified') ----- addToCurrentLayer: aVersionInfo | layer | layer := layers at: depthIndex. (layer includes: aVersionInfo) ifFalse: [depths at: aVersionInfo ifPresent: [:i | i < depthIndex ifTrue: [(layers at: i) remove: aVersionInfo] ifFalse: [^ false]]. layer add: aVersionInfo. depths at: aVersionInfo put: depthIndex. ^ true]. ^ false ! Item was changed: ----- Method: MCVersionSorter>>allAncestorsOf: (in category 'as yet unclassified') ----- allAncestorsOf: aVersionInfo | all | all := Set new. self addAllAncestorsOf: aVersionInfo to: all. ^ all! Item was changed: ----- Method: MCVersionSorter>>initialize (in category 'as yet unclassified') ----- initialize stepparents := Dictionary new. roots := OrderedCollection new.! Item was changed: ----- Method: MCVersionSorter>>popLayer (in category 'as yet unclassified') ----- popLayer depthIndex := depthIndex - 1! Item was changed: ----- Method: MCVersionSorter>>pushLayer (in category 'as yet unclassified') ----- pushLayer depthIndex := depthIndex + 1. depthIndex > layers size ifTrue: [layers add: OrderedCollection new]. ! Item was changed: ----- Method: MCVersionSorter>>sortedVersionInfos (in category 'as yet unclassified') ----- sortedVersionInfos layers := OrderedCollection with: OrderedCollection new. depthIndex := 1. depths := Dictionary new. roots do: [:ea | self processVersionInfo: ea]. ^ layers gather: [:ea | ea]! Item was changed: ----- Method: MCWorkingAncestry>>addStepChild: (in category 'as yet unclassified') ----- addStepChild: aVersionInfo stepChildren := stepChildren copyWith: aVersionInfo! Item was changed: ----- Method: MCWorkingCopy>>changesRelativeToRepository: (in category 'operations') ----- changesRelativeToRepository: aRepository | ancestorVersion ancestorSnapshot | ancestorVersion := aRepository closestAncestorVersionFor: ancestry ifNone: []. ancestorSnapshot := ancestorVersion ifNil: [MCSnapshot empty] ifNotNil: [ancestorVersion snapshot]. ^ package snapshot patchRelativeToBase: ancestorSnapshot! Item was changed: ----- Method: MCWorkingCopy>>clearRequiredPackages (in category 'accessing') ----- clearRequiredPackages requiredPackages := nil! Item was changed: ----- Method: MCWorkingCopy>>initialize (in category 'private') ----- initialize super initialize. ancestry := MCWorkingAncestry new! Item was changed: ----- Method: MCWorkingCopy>>loaded: (in category 'operations') ----- loaded: aVersion ancestry := MCWorkingAncestry new addAncestor: aVersion info. requiredPackages := OrderedCollection withAll: (aVersion dependencies collect: [:ea | ea package]). self modified: false. self changed! Item was changed: ----- Method: MCWorkingCopy>>repositoryGroup (in category 'repositories') ----- repositoryGroup ^ repositoryGroup ifNil: [repositoryGroup := MCRepositoryGroup new]! Item was changed: ----- Method: MCWorkingCopy>>repositoryGroup: (in category 'repositories') ----- repositoryGroup: aRepositoryGroup repositoryGroup := aRepositoryGroup! Item was changed: ----- Method: MCWorkingCopy>>requiredPackages (in category 'accessing') ----- requiredPackages ^ requiredPackages ifNil: [requiredPackages := OrderedCollection new]! Item was changed: ----- Method: MCWorkingCopy>>uniqueVersionName (in category 'private') ----- uniqueVersionName |versionName| counter := nil. [versionName := self nextVersionName. self repositoryGroup includesVersionNamed: versionName] whileTrue. ^ versionName! Item was changed: ----- Method: MCWorkingCopy>>updateInstVars (in category 'migration') ----- updateInstVars ancestry ifNil: [ancestry := MCWorkingAncestry new. versionInfo ifNotNil: [versionInfo ancestors do: [:ea | ancestry addAncestor: ea]. versionInfo := nil]]! Item was changed: ----- Method: MCWorkingCopy>>versionInfo: (in category 'accessing') ----- versionInfo: aVersionInfo ancestry := MCWorkingAncestry new addAncestor: aVersionInfo! Item was changed: ----- Method: MCWorkingCopyBrowser>>defaults (in category 'morphic ui') ----- defaults ^ defaults ifNil: [defaults := Dictionary new]! Item was changed: ----- Method: MCWorkingCopyBrowser>>repository (in category 'actions') ----- repository workingCopy ifNotNil: [repository := self defaults at: workingCopy ifAbsent: []]. ^ repository! Item was changed: ----- Method: MCWorkingCopyBrowser>>repository: (in category 'actions') ----- repository: aRepository repository := aRepository. workingCopy ifNotNil: [self defaults at: workingCopy put: aRepository]! Item was changed: ----- Method: MCWorkingCopyBrowser>>viewChanges (in category 'actions') ----- viewChanges | patch | self canSave ifTrue: [patch := workingCopy changesRelativeToRepository: self repository. patch isNil ifTrue: [^ self]. patch isEmpty ifTrue: [ workingCopy modified: false. self inform: 'No changes' ] ifFalse: [ workingCopy modified: true. (MCPatchBrowser forPatch: patch) label: 'Patch Browser: ', workingCopy description; show]]! Item was changed: ----- Method: MCWriter>>stream: (in category 'accessing') ----- stream: aStream stream := aStream! Item was changed: ----- Method: TimeStamp class>>fromMethodTimeStamp: (in category '*monticello-instance creation') ----- fromMethodTimeStamp: aString | stream | stream := ReadStream on: aString. stream skipSeparators. stream skipTo: Character space. ^self readFrom: stream.! Item was changed: ----- Method: TimeStamp class>>fromString: (in category '*monticello-instance creation') ----- fromString: aString "Answer a new instance for the value given by aString. TimeStamp fromString: '1-10-2000 11:55:00 am'. " ^self readFrom: (ReadStream on: aString).! Item was changed: ----- Method: TimeStamp class>>readFrom: (in category '*monticello-instance creation') ----- readFrom: stream | date time | stream skipSeparators. date := Date readFrom: stream. stream skipSeparators. time := Time readFrom: stream. ^self date: date time: time!

1 0

The Trunk: KernelTests-bf.284.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

Bert Freudenberg uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-bf.284.mcz ==================== Summary ==================== Name: KernelTests-bf.284 Author: bf Time: 8 December 2014, 1:48:44.325 am UUID: 48e0096d-f7b5-4f85-88e6-25eafcbea100 Ancestors: KernelTests-eem.283 Restore timestamps lost in assignment conversion. =============== Diff against KernelTests-eem.283 =============== Item was changed: ----- Method: BlockContextTest>>setUp (in category 'running') ----- setUp super setUp. aBlockContext := [100@100 corner: 200@200]. contextOfaBlockContext := thisContext.! Item was changed: ----- Method: BlockContextTest>>testOneArgument (in category 'tests') ----- testOneArgument | c | c := OrderedCollection new. c add: 'hello'. [c do: [1 + 2]] ifError: [:err :rcvr | self deny: err = 'This block requires 0 arguments.']. [c do: [:arg1 :arg2 | 1 + 2]] ifError: [:err :rcvr | self deny: err = 'This block requires 2 arguments.'] ! Item was changed: ----- Method: CompiledMethodTest>>returnPlusOne: (in category 'examples') ----- returnPlusOne: anInteger ^anInteger + 1. ! Item was changed: ----- Method: CompiledMethodTest>>returnTrue (in category 'examples') ----- returnTrue ^true !

1 0

The Trunk: Kernel-bf.890.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

Bert Freudenberg uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-bf.890.mcz ==================== Summary ==================== Name: Kernel-bf.890 Author: bf Time: 8 December 2014, 1:47:26.425 am UUID: 578f262a-c72b-4a4f-b9ce-813aeb77728b Ancestors: Kernel-eem.889 Restore timestamps lost in assignment conversion. =============== Diff against Kernel-eem.889 =============== Item was changed: ----- Method: Behavior class>>canZapMethodDictionary (in category 'testing') ----- canZapMethodDictionary "Return false since zapping the method dictionary of Behavior class or its subclasses will cause the system to fail." ^false! Item was changed: ----- Method: Behavior>>>> (in category 'accessing method dictionary') ----- >> selector "Answer the compiled method associated with the argument, selector (a Symbol), a message selector in the receiver's method dictionary. If the selector is not in the dictionary, create an error notification." ^self compiledMethodAt: selector ! Item was changed: ----- Method: Behavior>>addSelector:withMethod: (in category 'adding/removing methods') ----- addSelector: selector withMethod: compiledMethod ^ self addSelector: selector withMethod: compiledMethod notifying: nil! Item was changed: ----- Method: Behavior>>bindingOf: (in category 'testing method dictionary') ----- bindingOf: varName "Answer the binding of some variable resolved in the scope of the receiver" ^superclass bindingOf: varName! Item was changed: ----- Method: Behavior>>canZapMethodDictionary (in category 'testing') ----- canZapMethodDictionary "Return true if it is safe to zap the method dictionary on #obsolete" ^true! Item was changed: ----- Method: Behavior>>compiledMethodAt: (in category 'accessing method dictionary') ----- compiledMethodAt: selector "Answer the compiled method associated with the argument, selector (a Symbol), a message selector in the receiver's method dictionary. If the selector is not in the dictionary, create an error notification." ^ self methodDict at: selector! Item was changed: ----- Method: Behavior>>copyOfMethodDictionary (in category 'copying') ----- copyOfMethodDictionary "Return a copy of the receiver's method dictionary" ^ self methodDict copy! Item was changed: ----- Method: Behavior>>emptyMethodDictionary (in category 'initialize-release') ----- emptyMethodDictionary ^ MethodDictionary new! Item was changed: ----- Method: Behavior>>formalHeaderPartsFor: (in category 'accessing method dictionary') ----- "popeye" formalHeaderPartsFor: "olive oil" aSelector "RELAX!! The warning you may have just seen about possibly having a bad source file does not apply here, because this method *intends* to have its source code start with a comment. This method returns a collection giving the parts in the formal declaration for aSelector. This parse is in support of schemes in which adjutant properties of a method can be declared via special comments secreted in the formal header The result will have 3 elements for a simple, argumentless selector. 5 elements for a single-argument selector 9 elements for a two-argument selector 13 elements for a three-argument, selector etc... The syntactic elements are: 1 comment preceding initial selector fragment 2 first selector fragment 3 comment following first selector fragment (nil if selector has no arguments) ---------------------- (ends here for, e.g., #copy) 4 first formal argument 5 comment following first formal argument (nil if selector has only one argument) ---------------------- (ends here for, e.g., #copyFrom:) 6 second keyword 7 comment following second keyword 8 second formal argument 9 comment following second formal argument (nil if selector has only two arguments) ---------------------- (ends here for, e.g., #copyFrom:to:) Any nil element signifies an absent comment. NOTE: The comment following the final formal argument is *not* successfully retrieved by this method in its current form, though it can be obtained, if needed, by other means (e.g. calling #firstPrecodeCommentFor:). Thus, the *final* element in the structure returned by this method is always going to be nil." ^ Scanner new scanMessageParts: (self methodHeaderFor: aSelector) " Behavior class formalHeaderPartsFor: #formalHeaderPartsFor: " ! Item was changed: ----- Method: Behavior>>fullyImplementsVocabulary: (in category 'testing method dictionary') ----- fullyImplementsVocabulary: aVocabulary "Answer whether instances of the receiver respond to all the messages in aVocabulary" (aVocabulary encompassesAPriori: self) ifTrue: [^ true]. aVocabulary allSelectorsInVocabulary do: [:aSelector | (self canUnderstand: aSelector) ifFalse: [^ false]]. ^ true! Item was changed: ----- Method: Behavior>>hasMethods (in category 'testing method dictionary') ----- hasMethods "Answer whether the receiver has any methods in its method dictionary." ^ self methodDict size > 0! Item was changed: ----- Method: Behavior>>includesSelector: (in category 'testing method dictionary') ----- includesSelector: aSymbol "Answer whether the message whose selector is the argument is in the method dictionary of the receiver's class." ^ self methodDict includesKey: aSymbol! Item was changed: ----- Method: Behavior>>isMeta (in category 'testing') ----- isMeta ^ false! Item was changed: ----- Method: Behavior>>longPrintOn: (in category 'printing') ----- longPrintOn: aStream "Append to the argument, aStream, the names and values of all of the receiver's instance variables. But, not useful for a class with a method dictionary." aStream nextPutAll: '<<too complex to show>>'; cr.! Item was changed: ----- Method: Behavior>>methodDictionary (in category 'accessing method dictionary') ----- methodDictionary "Convenience" ^self methodDict! Item was changed: ----- Method: Behavior>>methodsDo: (in category 'accessing method dictionary') ----- methodsDo: aBlock "Evaluate aBlock for all the compiled methods in my method dictionary." ^ self methodDict valuesDo: aBlock! Item was changed: ----- Method: Behavior>>recompile: (in category 'compiling') ----- recompile: selector "Compile the method associated with selector in the receiver's method dictionary." ^self recompile: selector from: self! Item was changed: ----- Method: Behavior>>removeSelectorSilently: (in category 'adding/removing methods') ----- removeSelectorSilently: selector "Remove selector without sending system change notifications" ^ SystemChangeNotifier uniqueInstance doSilently: [self removeSelector: selector].! Item was changed: ----- Method: Behavior>>selectorsDo: (in category 'accessing method dictionary') ----- selectorsDo: selectorBlock "Evaluate selectorBlock for all the message selectors in my method dictionary." ^ self methodDict keysDo: selectorBlock! Item was changed: ----- Method: Behavior>>sourceCodeAt: (in category 'accessing method dictionary') ----- sourceCodeAt: selector ^ (self methodDict at: selector) getSourceFor: selector in: self! Item was changed: ----- Method: Behavior>>sourceCodeAt:ifAbsent: (in category 'accessing method dictionary') ----- sourceCodeAt: selector ifAbsent: aBlock ^ (self methodDict at: selector ifAbsent: [^ aBlock value]) getSourceFor: selector in: self! Item was changed: ----- Method: Behavior>>sourceMethodAt:ifAbsent: (in category 'accessing method dictionary') ----- sourceMethodAt: selector ifAbsent: aBlock "Answer the paragraph corresponding to the source code for the argument." ^ (self sourceCodeAt: selector ifAbsent: [^ aBlock value]) asText makeSelectorBoldIn: self! Item was changed: ----- Method: Behavior>>standardMethodHeaderFor: (in category 'accessing method dictionary') ----- standardMethodHeaderFor: aSelector | args | args := (1 to: aSelector numArgs) collect:[:i| 'arg', i printString]. args size = 0 ifTrue:[^aSelector asString]. args size = 1 ifTrue:[^aSelector,' arg1']. ^String streamContents:[:s| (aSelector findTokens:':') with: args do:[:tok :arg| s nextPutAll: tok; nextPutAll:': '; nextPutAll: arg; nextPutAll:' '. ]. ]. ! Item was changed: ----- Method: Behavior>>superclass:methodDictionary:format: (in category 'initialize-release') ----- superclass: aClass methodDictionary: mDict format: fmt "Basic initialization of the receiver. Must only be sent to a new instance; else we would need Object flushCache." superclass := aClass. format := fmt. methodDict := mDict.! Item was changed: ----- Method: BlockClosure>>assert (in category 'exceptions') ----- assert self assert: self! Item was changed: ----- Method: BlockClosure>>doWhileFalse: (in category 'controlling') ----- doWhileFalse: conditionBlock "Evaluate the receiver once, then again as long the value of conditionBlock is false." | result | [result := self value. conditionBlock value] whileFalse. ^ result! Item was changed: ----- Method: BlockClosure>>doWhileTrue: (in category 'controlling') ----- doWhileTrue: conditionBlock "Evaluate the receiver once, then again as long the value of conditionBlock is true." | result | [result := self value. conditionBlock value] whileTrue. ^ result! Item was changed: ----- Method: BlockClosure>>repeat (in category 'controlling') ----- repeat "Evaluate the receiver repeatedly, ending only if the block explicitly returns." [self value. true] whileTrue! Item was changed: ----- Method: BlockClosure>>repeatWithGCIf: (in category 'controlling') ----- repeatWithGCIf: testBlock | ans | "run the receiver, and if testBlock returns true, garbage collect and run the receiver again" ans := self value. (testBlock value: ans) ifTrue: [ Smalltalk garbageCollect. ans := self value ]. ^ans! Item was changed: ----- Method: BlockClosure>>timeToRun (in category 'evaluating') ----- timeToRun "Answer the number of milliseconds taken to execute this block." ^ Time millisecondsToRun: self ! Item was changed: ----- Method: BlockClosure>>whileFalse (in category 'controlling') ----- whileFalse "Ordinarily compiled in-line, and therefore not overridable. This is in case the message is sent to other than a literal block. Evaluate the receiver, as long as its value is false." ^ [self value] whileFalse: []! Item was changed: ----- Method: BlockClosure>>whileFalse: (in category 'controlling') ----- whileFalse: aBlock "Ordinarily compiled in-line, and therefore not overridable. This is in case the message is sent to other than a literal block. Evaluate the argument, aBlock, as long as the value of the receiver is false." ^ [self value] whileFalse: [aBlock value]! Item was changed: ----- Method: BlockClosure>>whileTrue (in category 'controlling') ----- whileTrue "Ordinarily compiled in-line, and therefore not overridable. This is in case the message is sent to other than a literal block. Evaluate the receiver, as long as its value is true." ^ [self value] whileTrue: []! Item was changed: ----- Method: BlockClosure>>whileTrue: (in category 'controlling') ----- whileTrue: aBlock "Ordinarily compiled in-line, and therefore not overridable. This is in case the message is sent to other than a literal block. Evaluate the argument, aBlock, as long as the value of the receiver is true." ^ [self value] whileTrue: [aBlock value]! Item was changed: ----- Method: Class>>deactivate (in category 'initialize-release') ----- deactivate "A remnant from the 3.3a modules work, retained . Does nothing, but may be overridden in Metaclasses."! Item was changed: ----- Method: Class>>fileOut (in category 'fileIn/Out') ----- fileOut "Create a file whose name is the name of the receiver with '.st' as the extension, and file a description of the receiver onto it." ^ self fileOutAsHtml: false! Item was changed: ----- Method: Class>>fileOutAsHtml: (in category 'fileIn/Out') ----- fileOutAsHtml: useHtml "File a description of the receiver onto a new file whose base name is the name of the receiver." | internalStream | internalStream := WriteStream on: (String new: 100). internalStream header; timeStamp. self sharedPools size > 0 ifTrue: [ self shouldFileOutPools ifTrue: [self fileOutSharedPoolsOn: internalStream]]. self fileOutOn: internalStream moveSource: false toFile: 0. internalStream trailer. FileStream writeSourceCodeFrom: internalStream baseName: self name isSt: true useHtml: useHtml. ! Item was changed: ----- Method: Class>>fileOutInitializerOn: (in category 'fileIn/Out') ----- fileOutInitializerOn: aStream ^self class fileOutInitializerOn: aStream! Item was changed: ----- Method: Class>>fileOutOn:moveSource:toFile: (in category 'fileIn/Out') ----- fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex "File a description of the receiver on aFileStream. If the boolean argument, moveSource, is true, then set the trailing bytes to the position of aFileStream and to fileIndex in order to indicate where to find the source code." ^self fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: true! Item was changed: ----- Method: Class>>fileOutSharedPoolsOn: (in category 'fileIn/Out') ----- fileOutSharedPoolsOn: aFileStream "file out the shared pools of this class after prompting the user about each pool" | poolsToFileOut | poolsToFileOut := self sharedPools select: [:aPool | (self shouldFileOutPool: (self environment keyAtIdentityValue: aPool))]. poolsToFileOut do: [:aPool | self fileOutPool: aPool onFileStream: aFileStream]. ! Item was changed: ----- Method: Class>>removeFromChanges (in category 'fileIn/Out') ----- removeFromChanges "References to the receiver, a class, and its metaclass should no longer be included in the system ChangeSet. 7/18/96 sw: call removeClassAndMetaClassChanges:" ChangeSet current removeClassAndMetaClassChanges: self! Item was changed: ----- Method: Class>>removeFromSystem (in category 'initialize-release') ----- removeFromSystem "Forget the receiver from the Smalltalk global dictionary. Any existing instances will refer to an obsolete version of the receiver." self removeFromSystem: true.! Item was changed: ----- Method: Class>>removeFromSystem: (in category 'initialize-release') ----- removeFromSystem: logged "Forget the receiver from the Smalltalk global dictionary. Any existing instances will refer to an obsolete version of the receiver." "keep the class name and category for triggering the system change message. If we wait to long, then we get obsolete information which is not what we want." "tell class to deactivate and unload itself-- two separate events in the module system" self deactivate; unload. self superclass ifNotNil: ["If we have no superclass there's nothing to be remembered" self superclass addObsoleteSubclass: self]. self environment forgetClass: self logged: logged. self obsolete.! Item was changed: ----- Method: Class>>removeFromSystemUnlogged (in category 'initialize-release') ----- removeFromSystemUnlogged "Forget the receiver from the Smalltalk global dictionary. Any existing instances will refer to an obsolete version of the receiver. Do not log the removal either to the current change set nor to the system changes log" ^self removeFromSystem: false! Item was changed: ----- Method: Class>>storeDataOn: (in category 'fileIn/Out') ----- storeDataOn: aDataStream "I don't get stored. Use a DiskProxy" (aDataStream insideASegment and: [self isSystemDefined not]) ifTrue: [ ^ super storeDataOn: aDataStream]. "do trace me" self error: 'use a DiskProxy to store a Class'! Item was changed: ----- Method: Class>>superclass:methodDict:format:name:organization:instVarNames:classPool:sharedPools: (in category 'initialize-release') ----- superclass: sup methodDict: md format: ft name: nm organization: org instVarNames: nilOrArray classPool: pool sharedPools: poolSet "Answer an instance of me, a new class, using the arguments of the message as the needed information. Must only be sent to a new instance; else we would need Object flushCache." superclass := sup. methodDict := md. format := ft. name := nm. instanceVariables := nilOrArray. classPool := pool. sharedPools := poolSet. self organization: org.! Item was changed: ----- Method: Class>>unload (in category 'initialize-release') ----- unload "Sent when a the class is removed. Does nothing, but may be overridden by (class-side) subclasses." ! Item was changed: ----- Method: ClassDescription>>addSelector:withMethod:notifying: (in category 'accessing method dictionary') ----- addSelector: selector withMethod: compiledMethod notifying: requestor | priorMethodOrNil | priorMethodOrNil := self compiledMethodAt: selector ifAbsent: [nil]. self addSelectorSilently: selector withMethod: compiledMethod. priorMethodOrNil isNil ifTrue: [SystemChangeNotifier uniqueInstance methodAdded: compiledMethod selector: selector inClass: self requestor: requestor] ifFalse: [SystemChangeNotifier uniqueInstance methodChangedFrom: priorMethodOrNil to: compiledMethod selector: selector inClass: self requestor: requestor].! Item was changed: ----- Method: ClassDescription>>allInstVarNamesEverywhere (in category 'instance variables') ----- allInstVarNamesEverywhere "Answer the set of inst var names used by the receiver, all superclasses, and all subclasses" | aList | aList := OrderedCollection new. (self allSuperclasses , self withAllSubclasses asOrderedCollection) do: [:cls | aList addAll: cls instVarNames]. ^ aList asSet "BorderedMorph allInstVarNamesEverywhere"! Item was changed: ----- Method: ClassDescription>>checkForInstVarsOK: (in category 'instance variables') ----- checkForInstVarsOK: instVarString "Return true if instVarString does no include any names used in a subclass" | instVarArray | instVarArray := Scanner new scanFieldNames: instVarString. self allSubclasses do: [:cl | cl instVarNames do: [:n | (instVarArray includes: n) ifTrue: [self error: n , ' is already used in ' , cl name. ^ false]]]. ^ true! Item was changed: ----- Method: ClassDescription>>classComment: (in category 'fileIn/Out') ----- classComment: aString "Store the comment, aString or Text or RemoteString, associated with the class we are orgainzing. Empty string gets stored only if had a non-empty one before." ^ self classComment: aString stamp: '<historical>'! Item was changed: ----- Method: ClassDescription>>classComment:stamp: (in category 'fileIn/Out') ----- classComment: aString stamp: aStamp "Store the comment, aString or Text or RemoteString, associated with the class we are organizing. Empty string gets stored only if had a non-empty one before." | ptr header file oldCommentRemoteStr | (aString isKindOf: RemoteString) ifTrue: [SystemChangeNotifier uniqueInstance classCommented: self. ^ self organization classComment: aString stamp: aStamp]. oldCommentRemoteStr := self organization commentRemoteStr. (aString size = 0) & (oldCommentRemoteStr == nil) ifTrue: [^ self organization classComment: nil]. "never had a class comment, no need to write empty string out" ptr := oldCommentRemoteStr ifNil: [0] ifNotNil: [oldCommentRemoteStr sourcePointer]. SourceFiles ifNotNil: [(file := SourceFiles at: 2) ifNotNil: [file setToEnd; cr; nextPut: $!!. "directly" "Should be saying (file command: 'H3') for HTML, but ignoring it here" header := String streamContents: [:strm | strm nextPutAll: self name; nextPutAll: ' commentStamp: '. aStamp storeOn: strm. strm nextPutAll: ' prior: '; nextPutAll: ptr printString]. file nextChunkPut: header]]. self organization classComment: (RemoteString newString: aString onFileNumber: 2) stamp: aStamp. SystemChangeNotifier uniqueInstance classCommented: self. ! Item was changed: ----- Method: ClassDescription>>commentFollows (in category 'fileIn/Out') ----- commentFollows "Answer a ClassCommentReader who will scan in the comment." ^ ClassCommentReader new setClass: self category: #Comment "False commentFollows inspect"! Item was changed: ----- Method: ClassDescription>>commentStamp:prior: (in category 'fileIn/Out') ----- commentStamp: changeStamp prior: indexAndOffset "Prior source link ignored when filing in." ^ ClassCommentReader new setClass: self category: #Comment changeStamp: changeStamp! Item was changed: ----- Method: ClassDescription>>compile:classified:notifying: (in category 'compiling') ----- compile: text classified: category notifying: requestor | stamp | stamp := self acceptsLoggingOfCompilation ifTrue: [Utilities changeStamp] ifFalse: [nil]. ^ self compile: text classified: category withStamp: stamp notifying: requestor! Item was changed: ----- Method: ClassDescription>>compile:classified:withStamp:notifying: (in category 'compiling') ----- compile: text classified: category withStamp: changeStamp notifying: requestor ^ self compile: text classified: category withStamp: changeStamp notifying: requestor logSource: self acceptsLoggingOfCompilation! Item was changed: ----- Method: ClassDescription>>compileSilently:classified: (in category 'compiling') ----- compileSilently: code classified: category "Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed." ^ self compileSilently: code classified: category notifying: nil.! Item was changed: ----- Method: ClassDescription>>compileSilently:classified:notifying: (in category 'compiling') ----- compileSilently: code classified: category notifying: requestor "Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed." ^ SystemChangeNotifier uniqueInstance doSilently: [self compile: code classified: category withStamp: nil notifying: requestor logSource: false].! Item was changed: ----- Method: ClassDescription>>copy:from:classified: (in category 'copying') ----- copy: sel from: class classified: cat "Install the method associated with the first arugment, sel, a message selector, found in the method dictionary of the second argument, class, as one of the receiver's methods. Classify the message under the third argument, cat." | code category | "Useful when modifying an existing class" code := class sourceMethodAt: sel. code == nil ifFalse: [cat == nil ifTrue: [category := class organization categoryOfElement: sel] ifFalse: [category := cat]. (self methodDict includesKey: sel) ifTrue: [code asString = (self sourceMethodAt: sel) asString ifFalse: [self error: self name , ' ' , sel , ' will be redefined if you proceed.']]. self compile: code classified: category]! Item was changed: ----- Method: ClassDescription>>doneCompiling (in category 'compiling') ----- doneCompiling "A ClassBuilder has finished the compilation of the receiver. This message is a notification for a class that needs to do some cleanup / reinitialization after it has been recompiled."! Item was changed: ----- Method: ClassDescription>>fileOutCategory: (in category 'fileIn/Out') ----- fileOutCategory: catName ^ self fileOutCategory: catName asHtml: false! Item was changed: ----- Method: ClassDescription>>fileOutCategory:asHtml: (in category 'fileIn/Out') ----- fileOutCategory: catName asHtml: useHtml "FileOut the named category, possibly in Html format." | internalStream | internalStream := WriteStream on: (String new: 1000). internalStream header; timeStamp. self fileOutCategory: catName on: internalStream moveSource: false toFile: 0. internalStream trailer. FileStream writeSourceCodeFrom: internalStream baseName: (self name , '-' , catName) isSt: true useHtml: useHtml.! Item was changed: ----- Method: ClassDescription>>fileOutMethod: (in category 'fileIn/Out') ----- fileOutMethod: selector "Write source code of a single method on a file. Make up a name for the file." self fileOutMethod: selector asHtml: false! Item was changed: ----- Method: ClassDescription>>fileOutMethod:asHtml: (in category 'fileIn/Out') ----- fileOutMethod: selector asHtml: useHtml "Write source code of a single method on a file in .st or .html format" | internalStream | (selector == #Comment) ifTrue: [^ self inform: 'Sorry, cannot file out class comment in isolation.']. (self includesSelector: selector) ifFalse: [^ self error: 'Selector ', selector asString, ' not found']. internalStream := WriteStream on: (String new: 1000). internalStream header; timeStamp. self printMethodChunk: selector withPreamble: true on: internalStream moveSource: false toFile: 0. FileStream writeSourceCodeFrom: internalStream baseName: (self name , '-' , (selector copyReplaceAll: ':' with: '')) isSt: true useHtml: useHtml. ! Item was changed: ----- Method: ClassDescription>>fileOutOn:moveSource:toFile: (in category 'fileIn/Out') ----- fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex "File a description of the receiver on aFileStream. If the boolean argument, moveSource, is true, then set the trailing bytes to the position of aFileStream and to fileIndex in order to indicate where to find the source code." aFileStream command: 'H3'. aFileStream nextChunkPut: self definition. aFileStream command: '/H3'. self organization putCommentOnFile: aFileStream numbered: fileIndex moveSource: moveSource forClass: self. self organization categories do: [:heading | self fileOutCategory: heading on: aFileStream moveSource: moveSource toFile: fileIndex]! Item was changed: ----- Method: ClassDescription>>fileOutOrganizationOn: (in category 'fileIn/Out') ----- fileOutOrganizationOn: aFileStream "File a description of the receiver's organization on aFileStream." aFileStream cr; nextPut: $!!. aFileStream nextChunkPut: self name, ' reorganize'; cr. aFileStream nextChunkPut: self organization printString; cr! Item was changed: ----- Method: ClassDescription>>forgetDoIts (in category 'initialize-release') ----- forgetDoIts "get rid of old DoIt methods and bogus entries in the ClassOrganizer." SystemChangeNotifier uniqueInstance doSilently: [ self organization removeElement: #DoIt; removeElement: #DoItIn:. ]. super forgetDoIts.! Item was changed: ----- Method: ClassDescription>>instanceVariablesString (in category 'printing') ----- instanceVariablesString "Answer a string of my instance variable names separated by spaces." ^String streamContents: [ :stream | self instVarNames do: [ :each | stream nextPutAll: each ] separatedBy: [ stream space ] ]! Item was changed: ----- Method: ClassDescription>>methods (in category 'fileIn/Out') ----- methods "Answer a ClassCategoryReader for compiling messages that are not classified, as in fileouts made with Smalltalk/V" ^ ClassCategoryReader new setClass: self category: ClassOrganizer default! Item was changed: ----- Method: ClassDescription>>methodsFor: (in category 'fileIn/Out') ----- methodsFor: categoryName "Answer a ClassCategoryReader for compiling the messages in the category, categoryName, of the receiver." ^ ClassCategoryReader new setClass: self category: categoryName asSymbol "(False methodsFor: 'logical operations') inspect"! Item was changed: ----- Method: ClassDescription>>methodsFor:stamp: (in category 'fileIn/Out') ----- methodsFor: categoryName stamp: changeStamp ^ self methodsFor: categoryName stamp: (Utilities fixStamp: changeStamp) prior: 0! Item was changed: ----- Method: ClassDescription>>methodsFor:stamp:prior: (in category 'fileIn/Out') ----- methodsFor: categoryName stamp: changeStamp prior: indexAndOffset "Prior source link ignored when filing in." ^ ClassCategoryReader new setClass: self category: categoryName asSymbol changeStamp: changeStamp "Most importantly, return the new ClassCategoryReader, so a fileIn will let it seize control. So method will be placed in the proper category. See the transfer of control where ReadWriteStream fileIn calls scanFrom:"! Item was changed: ----- Method: ClassDescription>>moveInstVarNamed:to:after: (in category 'compiling') ----- moveInstVarNamed: instVarName to: anotherClass after: prevInstVarName "Move the given instance variable to another class." self == anotherClass ifFalse:[ self notify:'Warning:' asText allBold,' moving ', instVarName printString,' from ', self name,' to ', anotherClass name,' will not be recorded in the change set correctly. Proceed to do it anyways.']. ^(ClassBuilder new) moveInstVarNamed: instVarName from: self to: anotherClass after: prevInstVarName! Item was changed: ----- Method: ClassDescription>>noteCompilationOf:meta: (in category 'compiling') ----- noteCompilationOf: aSelector meta: isMeta "A hook allowing some classes to react to recompilation of certain selectors"! Item was changed: ----- Method: ClassDescription>>organization: (in category 'organization') ----- organization: aClassOrg "Install an instance of ClassOrganizer that represents the organization of the messages of the receiver." aClassOrg ifNotNil: [aClassOrg setSubject: self]. organization := aClassOrg! Item was changed: ----- Method: ClassDescription>>printCategoryChunk:on: (in category 'fileIn/Out') ----- printCategoryChunk: categoryName on: aFileStream ^ self printCategoryChunk: categoryName withStamp: '' on: aFileStream! Item was changed: ----- Method: ClassDescription>>printCategoryChunk:on:priorMethod: (in category 'fileIn/Out') ----- printCategoryChunk: category on: aFileStream priorMethod: priorMethod ^ self printCategoryChunk: category on: aFileStream withStamp: Utilities changeStamp priorMethod: priorMethod! Item was changed: ----- Method: ClassDescription>>printCategoryChunk:on:withStamp:priorMethod: (in category 'fileIn/Out') ----- printCategoryChunk: category on: aFileStream withStamp: changeStamp priorMethod: priorMethod "Print a method category preamble. This must have a category name. It may have an author/date stamp, and it may have a prior source link. If it has a prior source link, it MUST have a stamp, even if it is empty." "The current design is that changeStamps and prior source links are preserved in the changes file. All fileOuts include changeStamps. Condensing sources, however, eliminates all stamps (and links, natch)." aFileStream cr; command: 'H3'; nextPut: $!!. aFileStream nextChunkPut: (String streamContents: [:strm | strm nextPutAll: self name; nextPutAll: ' methodsFor: '; print: category asString. (changeStamp ~~ nil and: [changeStamp size > 0 or: [priorMethod ~~ nil]]) ifTrue: [strm nextPutAll: ' stamp: '; print: changeStamp]. priorMethod ~~ nil ifTrue: [strm nextPutAll: ' prior: '; print: priorMethod sourcePointer]]). aFileStream command: '/H3'.! Item was changed: ----- Method: ClassDescription>>printCategoryChunk:withStamp:on: (in category 'fileIn/Out') ----- printCategoryChunk: categoryName withStamp: changeStamp on: aFileStream ^ self printCategoryChunk: categoryName on: aFileStream withStamp: changeStamp priorMethod: nil! Item was changed: ----- Method: ClassDescription>>printSubclassesOn:level: (in category 'accessing class hierarchy') ----- printSubclassesOn: aStream level: level "As part of the algorithm for printing a description of the receiver, print the subclass on the file stream, aStream, indenting level times." | subclassNames | aStream crtab: level. aStream nextPutAll: self name. aStream space; print: self instVarNames. self == Class ifTrue: [aStream crtab: level + 1; nextPutAll: '[ ... all the Metaclasses ... ]'. ^self]. subclassNames := self subclasses asSortedCollection:[:c1 :c2| c1 name <= c2 name]. "Print subclasses in alphabetical order" subclassNames do: [:subclass | subclass printSubclassesOn: aStream level: level + 1]! Item was changed: ----- Method: ClassDescription>>renameInstVar:to: (in category 'instance variables') ----- renameInstVar: oldName to: newName (self confirm: 'WARNING: Renaming of instance variables is subject to substitution ambiguities. Do you still wish to attempt it?') ifFalse: [self halt]. "...In other words, this does a dumb text search-and-replace, which might improperly alter, eg, a literal string. As long as the oldName is unique, everything should work jes' fine. - di" ^ self renameSilentlyInstVar: oldName to: newName! Item was changed: ----- Method: ClassDescription>>reorganize (in category 'organization') ----- reorganize "During fileIn, !!Rectangle reorganize!! allows Rectangle to seize control and treat the next chunk as its organization. See the transfer of control where ReadWriteStream fileIn calls scanFrom:" ^self organization! Item was changed: ----- Method: ClassDescription>>sharedPoolsString (in category 'printing') ----- sharedPoolsString "Answer a string of my shared pool names separated by spaces." ^String streamContents: [ :stream | self sharedPools do: [ :each | stream nextPutAll: (self environment keyAtIdentityValue: each ifAbsent: [ 'private' ]) ] separatedBy: [ stream space ] ]! Item was changed: ----- Method: ClassDescription>>subclasses (in category 'accessing class hierarchy') ----- subclasses ^ Array new! Item was changed: ----- Method: ClassDescription>>subclassesDo: (in category 'accessing class hierarchy') ----- subclassesDo: aBlock "Evaluate the argument, aBlock, for each of the receiver's immediate subclasses." ^self subclasses do: aBlock! Item was changed: ----- Method: ClassDescription>>superclass:methodDictionary:format: (in category 'initialize-release') ----- superclass: aClass methodDictionary: mDict format: fmt "Basic initialization of the receiver" super superclass: aClass methodDictionary: mDict format: fmt. instanceVariables := nil. self organization: nil.! Item was changed: ----- Method: ClassDescription>>wantsChangeSetLogging (in category 'compiling') ----- wantsChangeSetLogging "Answer whether code submitted for the receiver should be remembered by the changeSet mechanism. 7/12/96 sw" ^ true! Item was changed: ----- Method: ClassDescription>>wantsRecompilationProgressReported (in category 'compiling') ----- wantsRecompilationProgressReported "Answer whether the receiver would like progress of its recompilation reported interactively to the user." ^ true! Item was changed: ----- Method: ClassDescription>>whichCategoryIncludesSelector: (in category 'organization') ----- whichCategoryIncludesSelector: aSelector "Answer the category of the argument, aSelector, in the organization of the receiver, or answer nil if the receiver does not inlcude this selector." (self includesSelector: aSelector) ifTrue: [^ self organization categoryOfElement: aSelector] ifFalse: [^nil]! Item was changed: ----- Method: CompiledMethod class>>primitive:numArgs:numTemps:stackSize:literals:bytecodes:trailer: (in category 'instance creation') ----- primitive: primNum numArgs: numArgs numTemps: numTemps stackSize: stackSize literals: literals bytecodes: bytecodes trailer: trailerBytes "Create method with given attributes. numTemps includes numArgs. stackSize does not include numTemps." | compiledMethod | compiledMethod := self newBytes: bytecodes size trailerBytes: trailerBytes nArgs: numArgs nTemps: numTemps nStack: stackSize nLits: literals size primitive: primNum. (WriteStream with: compiledMethod) position: compiledMethod initialPC - 1; nextPutAll: bytecodes. literals withIndexDo: [:obj :i | compiledMethod literalAt: i put: obj]. ^ compiledMethod! Item was changed: ----- Method: Date>>printOn: (in category 'printing') ----- printOn: aStream self printOn: aStream format: #(1 2 3 $ 3 1 ) ! Item was changed: ----- Method: Date>>storeOn: (in category 'printing') ----- storeOn: aStream aStream print: self printString; nextPutAll: ' asDate' ! Item was changed: ----- Method: EventSensor>>peekButtons (in category 'accessing') ----- peekButtons self fetchMoreEvents. ^mouseButtons! Item was changed: ----- Method: EventSensor>>peekPosition (in category 'accessing') ----- peekPosition self fetchMoreEvents. ^mousePosition! Item was changed: ----- Method: EventSensor>>primKbdNext (in category 'private') ----- primKbdNext "Allows for use of old Sensor protocol to get at the keyboard, as when running kbdTest or the InterpreterSimulator in Morphic" | evtBuf | self fetchMoreEvents. keyboardBuffer isEmpty ifFalse:[^ keyboardBuffer next]. eventQueue ifNotNil: [evtBuf := eventQueue nextOrNilSuchThat: [:buf | self isKbdEvent: buf]. self flushNonKbdEvents]. ^ evtBuf ifNotNil: [evtBuf at: 3] ! Item was changed: ----- Method: EventSensor>>primKbdPeek (in category 'private') ----- primKbdPeek "Allows for use of old Sensor protocol to get at the keyboard, as when running kbdTest or the InterpreterSimulator in Morphic" | char | self fetchMoreEvents. keyboardBuffer isEmpty ifFalse: [^ keyboardBuffer peek]. char := nil. eventQueue ifNotNil: [eventQueue nextOrNilSuchThat: "NOTE: must not return out of this block, so loop to end" [:buf | (self isKbdEvent: buf) ifTrue: [char ifNil: [char := buf at: 3]]. false "NOTE: block value must be false so Queue won't advance"]]. ^ char! Item was changed: ----- Method: EventSensor>>primMouseButtons (in category 'private') ----- primMouseButtons self fetchMoreEvents. self flushNonKbdEvents. ^ mouseButtons! Item was changed: ----- Method: EventSensor>>primMousePt (in category 'private') ----- primMousePt self fetchMoreEvents. self flushNonKbdEvents. ^ mousePosition! Item was changed: ----- Method: Metaclass>>fileOutOn:moveSource:toFile:initializing: (in category 'fileIn/Out') ----- fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: aBool super fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex. (aBool and:[moveSource not and: [self methodDict includesKey: #initialize]]) ifTrue: [aFileStream cr. aFileStream cr. aFileStream nextChunkPut: thisClass name , ' initialize'. aFileStream cr]! Item was changed: ----- Method: Object>>addModelYellowButtonMenuItemsTo:forMorph:hand: (in category 'graph model') ----- addModelYellowButtonMenuItemsTo: aCustomMenu forMorph: aMorph hand: aHandMorph "The receiver serves as the model for aMorph; a menu is being constructed for the morph, and here the receiver is able to add its own items" Preferences cmdGesturesEnabled ifTrue: [ "build mode" aCustomMenu add: 'inspect model' translated target: self action: #inspect. ]. ^aCustomMenu ! Item was changed: ----- Method: Object>>halt (in category 'error handling') ----- halt "This is the typical message to use for inserting breakpoints during debugging. It behaves like halt:, but does not call on halt: in order to avoid putting this message on the stack. Halt is especially useful when the breakpoint message is an arbitrary one." Halt signal! Item was changed: ----- Method: Time class>>dateAndTimeFromSeconds: (in category 'smalltalk-80') ----- dateAndTimeFromSeconds: secondCount ^ Array with: (Date fromSeconds: secondCount) with: (Time fromSeconds: secondCount \\ 86400)! Item was changed: ----- Method: Time class>>millisecondsSince: (in category 'squeak protocol') ----- millisecondsSince: lastTime "Answer the elapsed time since last recorded in milliseconds. Compensate for rollover." ^self milliseconds: self millisecondClockValue since: lastTime ! Item was changed: ----- Method: Time>>hhmm24 (in category 'printing') ----- hhmm24 "Return a string of the form 1123 (for 11:23 am), 2154 (for 9:54 pm), of exactly 4 digits" ^(String streamContents: [ :aStream | self print24: true showSeconds: false on: aStream ]) copyWithout: $: ! Item was changed: ----- Method: Time>>print24 (in category 'printing') ----- print24 "Return as 8-digit string 'hh:mm:ss', with leading zeros if needed" ^String streamContents: [ :aStream | self print24: true on: aStream ] ! Item was changed: ----- Method: Time>>print24:on: (in category 'printing') ----- print24: hr24 on: aStream "Format is 'hh:mm:ss' or 'h:mm:ss am' " self print24: hr24 showSeconds: true on: aStream! Item was changed: ----- Method: Time>>printMinutes (in category 'printing') ----- printMinutes "Return as string 'hh:mm pm' " ^String streamContents: [ :aStream | self print24: false showSeconds: false on: aStream ]! Item was changed: ----- Method: Time>>storeOn: (in category 'printing') ----- storeOn: aStream aStream print: self printString; nextPutAll: ' asTime' !

1 0

The Trunk: Graphics-bf.303.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

Bert Freudenberg uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-bf.303.mcz ==================== Summary ==================== Name: Graphics-bf.303 Author: bf Time: 8 December 2014, 1:42:10.857 am UUID: 59c75040-7563-4061-8425-81f4467d3eb8 Ancestors: Graphics-topa.302 Restore timestamps lost in assignment conversion. =============== Diff against Graphics-topa.302 =============== Item was changed: ----- Method: Form>>fadeImageVert:at: (in category 'transitions') ----- fadeImageVert: otherImage at: topLeft "Display fadeImageVert: (Form fromDisplay: (10@10 extent: 300@300)) reverse at: 10@10" | d | d := self depth. ^ self fadeImage: otherImage at: topLeft indexAndMaskDo: [:i :mask | mask fill: ((mask width//2//d-i*d)@0 extent: i*2*d@mask height) fillColor: Color black. i <= (mask width//d)]!

1 0

The Trunk: Files-bf.142.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

Bert Freudenberg uploaded a new version of Files to project The Trunk: http://source.squeak.org/trunk/Files-bf.142.mcz ==================== Summary ==================== Name: Files-bf.142 Author: bf Time: 8 December 2014, 1:40:15.966 am UUID: a1712c19-2d55-4680-a320-928c62f76cce Ancestors: Files-ul.141 Restore timestamps lost in assignment conversion. =============== Diff against Files-ul.141 =============== Item was changed: ----- Method: AcornFileDirectory class>>isActiveDirectoryClass (in category 'platform specific') ----- isActiveDirectoryClass "Does this class claim to be that properly active subclass of FileDirectory for the current platform? On Acorn, the test is whether platformName is 'RiscOS' (on newer VMs) or if the primPathNameDelimiter is $. (on older ones), which is what we would like to use for a dirsep if only it would work out. See pathNameDelimiter for more woeful details - then just get on and enjoy Squeak" ^ Smalltalk platformName = 'RiscOS' or: [self primPathNameDelimiter = $.]! Item was changed: ----- Method: AsyncFile>>test:fileName: (in category 'as yet unclassified') ----- test: byteCount fileName: fileName "AsyncFile new test: 10000 fileName: 'testData'" | buf1 buf2 bytesWritten bytesRead | buf1 := String new: byteCount withAll: $x. buf2 := String new: byteCount. self open: ( FileDirectory default fullNameFor: fileName) forWrite: true. self primWriteStart: fileHandle fPosition: 0 fromBuffer: buf1 at: 1 count: byteCount. semaphore wait. bytesWritten := self primWriteResult: fileHandle. self close. self open: ( FileDirectory default fullNameFor: fileName) forWrite: false. self primReadStart: fileHandle fPosition: 0 count: byteCount. semaphore wait. bytesRead := self primReadResult: fileHandle intoBuffer: buf2 at: 1 count: byteCount. self close. buf1 = buf2 ifFalse: [self error: 'buffers do not match']. ^ 'wrote ', bytesWritten printString, ' bytes; ', 'read ', bytesRead printString, ' bytes' ! Item was changed: ----- Method: CrLfFileStream>>binary (in category 'access') ----- binary super binary. lineEndConvention := nil! Item was changed: ----- Method: CrLfFileStream>>convertStringFromCr: (in category 'private') ----- convertStringFromCr: aString | inStream outStream | lineEndConvention ifNil: [^ aString]. lineEndConvention == #cr ifTrue: [^ aString]. lineEndConvention == #lf ifTrue: [^ aString copy replaceAll: Cr with: Lf]. "lineEndConvention == #crlf" inStream := ReadStream on: aString. outStream := WriteStream on: (String new: aString size). [inStream atEnd] whileFalse: [outStream nextPutAll: (inStream upTo: Cr). (inStream atEnd not or: [aString last = Cr]) ifTrue: [outStream nextPutAll: CrLf]]. ^ outStream contents! Item was changed: ----- Method: CrLfFileStream>>convertStringToCr: (in category 'private') ----- convertStringToCr: aString | inStream outStream | lineEndConvention ifNil: [^ aString]. lineEndConvention == #cr ifTrue: [^ aString]. lineEndConvention == #lf ifTrue: [^ aString copy replaceAll: Lf with: Cr]. "lineEndConvention == #crlf" inStream := ReadStream on: aString. outStream := WriteStream on: (String new: aString size). [inStream atEnd] whileFalse: [outStream nextPutAll: (inStream upTo: Cr). (inStream atEnd not or: [aString last = Cr]) ifTrue: [outStream nextPut: Cr. inStream peek = Lf ifTrue: [inStream next]]]. ^ outStream contents! Item was changed: ----- Method: CrLfFileStream>>detectLineEndConvention (in category 'access') ----- detectLineEndConvention "Detect the line end convention used in this stream. The result may be either #cr, #lf or #crlf." | char numRead pos | self isBinary ifTrue: [^ self error: 'Line end conventions are not used on binary streams']. lineEndConvention := LineEndDefault. "Default if nothing else found" numRead := 0. pos := super position. [super atEnd not and: [numRead < LookAheadCount]] whileTrue: [char := super next. char = Lf ifTrue: [super position: pos. ^ lineEndConvention := #lf]. char = Cr ifTrue: [super peek = Lf ifTrue: [lineEndConvention := #crlf] ifFalse: [lineEndConvention := #cr]. super position: pos. ^ lineEndConvention]. numRead := numRead + 1]. super position: pos. ^ lineEndConvention! Item was changed: ----- Method: CrLfFileStream>>next (in category 'access') ----- next | char secondChar | char := super next. self isBinary ifTrue: [^char]. char == Cr ifTrue: [secondChar := super next. secondChar ifNotNil: [secondChar == Lf ifFalse: [self skip: -1]]. ^Cr]. char == Lf ifTrue: [^Cr]. ^char! Item was changed: ----- Method: CrLfFileStream>>next: (in category 'access') ----- next: n | string peekChar | string := super next: n. string size = 0 ifTrue: [ ^string ]. self isBinary ifTrue: [ ^string ]. "if we just read a CR, and the next character is an LF, then skip the LF" ( string last = Character cr ) ifTrue: [ peekChar := super next. "super peek doesn't work because it relies on #next" peekChar ~= Character lf ifTrue: [ super position: (super position - 1) ]. ]. string := string withSqueakLineEndings. string size = n ifTrue: [ ^string ]. "string shrunk due to embedded crlfs; make up the difference" ^string, (self next: n - string size)! Item was changed: ----- 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 changed: ----- Method: CrLfFileStream>>peek (in category 'access') ----- peek "Answer what would be returned if the message next were sent to the receiver. If the receiver is at the end, answer nil. " | next pos | self atEnd ifTrue: [^ nil]. pos := self position. next := self next. self position: pos. ^ next! Item was changed: ----- Method: CrLfFileStream>>upTo: (in category 'access') ----- upTo: aCharacter | newStream char | newStream := WriteStream on: (String new: 100). [(char := self next) isNil or: [char == aCharacter]] whileFalse: [newStream nextPut: char]. ^ newStream contents ! Item was changed: ----- Method: DirectoryEntry>>convertFromSystemName (in category 'multilingual system') ----- convertFromSystemName name := (FilePath pathName: name isEncoded: true) asSqueakPathName! Item was changed: ----- Method: DosFileDirectory>>checkName:fixErrors: (in category 'as yet unclassified') ----- checkName: aFileName fixErrors: fixing "Check if the file name contains any invalid characters" | fName badChars hasBadChars | fName := super checkName: aFileName fixErrors: fixing. badChars := #( $: $< $> $| $/ $\ $? $* $") asSet. hasBadChars := fName includesAnyOf: badChars. (hasBadChars and:[fixing not]) ifTrue:[^self error:'Invalid file name']. hasBadChars ifFalse:[^ fName]. ^ fName collect: [:char | (badChars includes: char) ifTrue:[$#] ifFalse:[char]]! Item was changed: ----- Method: DosFileDirectory>>driveName (in category 'path access') ----- driveName "return a possible drive letter and colon at the start of a Path name, empty string otherwise" | firstTwoChars | ( pathName asSqueakPathName size >= 2 ) ifTrue: [ firstTwoChars := (pathName asSqueakPathName copyFrom: 1 to: 2). (self class isDrive: firstTwoChars) ifTrue: [^firstTwoChars] ]. ^''! Item was changed: ----- Method: FileDirectory class>>deleteFilePath: (in category 'create/delete file') ----- deleteFilePath: fullPathToAFile "Delete the file after finding its directory" | dir | dir := self on: (self dirPathFor: fullPathToAFile). dir deleteFileNamed: (self localNameFor: fullPathToAFile). ! Item was changed: ----- Method: FileDirectory class>>fileName:extension: (in category 'name utilities') ----- fileName: fileName extension: fileExtension | extension | extension := FileDirectory dot , fileExtension. ^(fileName endsWith: extension) ifTrue: [fileName] ifFalse: [fileName , extension].! Item was changed: ----- Method: FileDirectory class>>forFileName: (in category 'instance creation') ----- forFileName: aString | path | path := self dirPathFor: aString. path isEmpty ifTrue: [^ self default]. ^ self on: path ! Item was changed: ----- Method: FileDirectory class>>initializeStandardMIMETypes (in category 'class initialization') ----- initializeStandardMIMETypes "FileDirectory initializeStandardMIMETypes" StandardMIMEMappings := Dictionary new. #( (gif ('image/gif')) (pdf ('application/pdf')) (aiff ('audio/aiff')) (bmp ('image/bmp')) (png ('image/png')) (swf ('application/x-shockwave-flash')) (htm ('text/html' 'text/plain')) (html ('text/html' 'text/plain')) (jpg ('image/jpeg')) (jpeg ('image/jpeg')) (mid ('audio/midi')) (midi ('audio/midi')) (mp3 ('audio/mpeg')) (mpeg ('video/mpeg')) (mpg ('video/mpg')) (txt ('text/plain')) (text ('text/plain')) (mov ('video/quicktime')) (qt ('video/quicktime')) (tif ('image/tiff')) (tiff ('image/tiff')) (ttf ('application/x-truetypefont')) (wrl ('model/vrml')) (vrml ('model/vrml')) (wav ('audio/wav')) ) do:[:spec| StandardMIMEMappings at: spec first asString put: spec last. ].! Item was changed: ----- Method: FileDirectory class>>setDefaultDirectoryClass (in category 'system start up') ----- setDefaultDirectoryClass "Initialize the default directory class to suit this platform. This method is called when the image starts up - it needs to be right at the front of the list of the startup sequence" DirectoryClass := self activeDirectoryClass ! Item was changed: ----- Method: FileDirectory class>>setDefaultDirectoryFrom: (in category 'system start up') ----- setDefaultDirectoryFrom: imageName "Initialize the default directory to the directory containing the Squeak image file. This method is called when the image starts up." DirectoryClass := self activeDirectoryClass. DefaultDirectory := self on: (FilePath pathName: (self dirPathFor: imageName) isEncoded: true) asSqueakPathName. ! Item was changed: ----- Method: FileDirectory class>>shutDown (in category 'system start up') ----- shutDown Smalltalk closeSourceFiles. ! Item was changed: ----- Method: FileDirectory class>>splitName:to: (in category 'name utilities') ----- splitName: fullName to: pathAndNameBlock "Take the file name and convert it to the path name of a directory and a local file name within that directory. FileName must be of the form: <dirPath><delimiter><localName>, where <dirPath><delimiter> is optional. The <dirPath> part may contain delimiters." | delimiter i dirName localName | delimiter := self pathNameDelimiter. (i := fullName findLast: [:c | c = delimiter]) = 0 ifTrue: [dirName := String new. localName := fullName] ifFalse: [dirName := fullName copyFrom: 1 to: (i - 1 max: 1). localName := fullName copyFrom: i + 1 to: fullName size]. ^ pathAndNameBlock value: dirName value: localName! Item was changed: ----- Method: FileDirectory class>>urlForFileNamed: (in category 'name utilities') ----- urlForFileNamed: aFilename "Create a URL for the given fully qualified file name" "FileDirectory urlForFileNamed: 'C:\Home\andreasr\Squeak\DSqueak3\DSqueak3:=1.1\DSqueak3.1.image' " | path localName | DirectoryClass splitName: aFilename to: [:p :n | path := p. localName := n]. ^ localName asUrlRelativeTo: (self on: path) url asUrl! Item was changed: ----- Method: FileDirectory>>checkName:fixErrors: (in category 'file name utilities') ----- checkName: aFileName fixErrors: fixing "Check a string aFileName for validity as a file name. Answer the original file name if it is valid. If the name is not valid (e.g., it is too long or contains illegal characters) and fixing is false, raise an error. If fixing is true, fix the name (usually by truncating and/or tranforming characters), and answer the corrected name. The default behavior is just to truncate the name to the maximum length for this platform. Subclasses can do any kind of checking and correction appropriate for their platform." | maxLength | aFileName size = 0 ifTrue: [self error: 'zero length file name']. maxLength := self class maxFileNameLength. aFileName size > maxLength ifTrue: [ fixing ifTrue: [^ aFileName contractTo: maxLength] ifFalse: [self error: 'file name is too long']]. ^ aFileName ! Item was changed: ----- Method: FileDirectory>>copyFileNamed:toFileNamed: (in category 'file operations') ----- copyFileNamed: fileName1 toFileNamed: fileName2 "Copy the contents of the existing file with the first name into a new file with the second name. Both files are assumed to be in this directory." "FileDirectory default copyFileNamed: 'todo.txt' toFileNamed: 'todocopy.txt'" | file1 file2 | file1 := (self readOnlyFileNamed: fileName1) binary. file2 := (self newFileNamed: fileName2) binary. self copyFile: file1 toFile: file2. file1 close. file2 close. ! Item was changed: ----- Method: FileDirectory>>copyFileWithoutOverwriteConfirmationNamed:toFileNamed: (in category 'file operations') ----- copyFileWithoutOverwriteConfirmationNamed: fileName1 toFileNamed: fileName2 "Copy the contents of the existing file with the first name into a file with the second name (which may or may not exist). If the second file exists, force an overwrite without confirming. Both files are assumed to be in this directory." "FileDirectory default copyFileWithoutOverwriteConfirmationNamed: 'todo.txt' toFileNamed: 'todocopy.txt'" | file1 file2 | fileName1 = fileName2 ifTrue: [^ self]. file1 := (self readOnlyFileNamed: fileName1) binary. file2 := (self forceNewFileNamed: fileName2) binary. self copyFile: file1 toFile: file2. file1 close. file2 close.! 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. 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. (StandardFileStream retryWithGC:[self primDeleteFileNamed: (self fullNameFor: localFileName) asVmPathName] until:[:result| result notNil] forFileNamed: fullName) == nil ifTrue: [^failBlock value]. ! Item was changed: ----- Method: FileDirectory>>exists (in category 'testing') ----- exists "Answer whether the directory exists" | result | result := self primLookupEntryIn: pathName asVmPathName index: 1. ^ result ~= #badDirectoryPath ! Item was changed: ----- Method: FileDirectory>>fileNamesMatching: (in category 'file name utilities') ----- fileNamesMatching: pat " FileDirectory default fileNamesMatching: '*' FileDirectory default fileNamesMatching: '*.image;*.changes' " | files | files := OrderedCollection new. (pat findTokens: ';', String crlf) do: [ :tok | files addAll: (self fileNames select: [:name | tok match: name]) ]. ^files ! Item was changed: ----- Method: FileDirectory>>fileOrDirectoryExists: (in category 'file operations') ----- fileOrDirectoryExists: filenameOrPath "Answer true if either a file or a directory file of the given name exists. The given name may be either a full path name or a local name within this directory." "FileDirectory default fileOrDirectoryExists: Smalltalk sourcesName" | fName dir | DirectoryClass splitName: filenameOrPath to: [:filePath :name | fName := name. filePath isEmpty ifTrue: [dir := self] ifFalse: [dir := FileDirectory on: filePath]]. ^ (dir includesKey: fName) or: [ fName = '' and:[ dir entries size > 1]]! Item was changed: ----- Method: FileDirectory>>filesContaining:caseSensitive: (in category 'searching') ----- filesContaining: searchString caseSensitive: aBoolean | aList | "Search the contents of all files in the receiver and its subdirectories for the search string. Return a list of paths found. Make the search case sensitive if aBoolean is true." aList := OrderedCollection new. self withAllFilesDo: [:stream | (stream contentsOfEntireFile includesSubstring: searchString caseSensitive: aBoolean) ifTrue: [aList add: stream name]] andDirectoriesDo: [:d | d pathName]. ^ aList "FileDirectory default filesContaining: 'includesSubstring:' caseSensitive: true"! Item was changed: ----- Method: FileDirectory>>fullNameFor: (in category 'file name utilities') ----- fullNameFor: fileName "Return a corrected, fully-qualified name for the given file name. If the given name is already a full path (i.e., it contains a delimiter character), assume it is already a fully-qualified name. Otherwise, prefix it with the path to this directory. In either case, correct the local part of the file name." "Details: Note that path relative to a directory, such as '../../foo' are disallowed by this algorithm. Also note that this method is tolerent of a nil argument -- is simply returns nil in this case." | correctedLocalName prefix | fileName ifNil: [^ nil]. DirectoryClass splitName: fileName to: [:filePath :localName | correctedLocalName := localName isEmpty ifFalse: [self checkName: localName fixErrors: true] ifTrue: [localName]. prefix := self fullPathFor: filePath]. prefix isEmpty ifTrue: [^correctedLocalName]. prefix last = self pathNameDelimiter ifTrue:[^ prefix, correctedLocalName] ifFalse:[^ prefix, self slash, correctedLocalName]! Item was changed: ----- Method: FileDirectory>>fullNamesOfAllFilesInSubtree (in category 'enumeration') ----- fullNamesOfAllFilesInSubtree "Answer a collection containing the full names of all the files in the subtree of the file system whose root is this directory." | result todo dir | result := OrderedCollection new: 100. todo := OrderedCollection with: self. [todo size > 0] whileTrue: [ dir := todo removeFirst. dir fileNames do: [:n | result add: (dir fullNameFor: n)]. dir directoryNames do: [:n | todo add: (dir directoryNamed: n)]]. ^ result asArray ! Item was changed: ----- Method: FileDirectory>>getMacFileTypeAndCreator: (in category 'file operations') ----- getMacFileTypeAndCreator: fileName | results typeString creatorString | "get the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4. Does nothing on other platforms (where the underlying primitive is a noop)." "FileDirectory default getMacFileNamed: 'foo'" typeString := ByteArray new: 4 withAll: ($? asInteger). creatorString := ByteArray new: 4 withAll: ($? asInteger). [self primGetMacFileNamed: (self fullNameFor: fileName) asVmPathName type: typeString creator: creatorString.] ensure: [typeString := typeString asString. creatorString := creatorString asString]. results := Array with: typeString convertFromSystemString with: creatorString convertFromSystemString. ^results ! Item was changed: ----- Method: FileDirectory>>lastNameFor:extension: (in category 'file name utilities') ----- lastNameFor: baseFileName extension: extension "Assumes a file name includes a version number encoded as '.' followed by digits preceding the file extension. Increment the version number and answer the new file name. If a version number is not found, set the version to 1 and answer a new file name" | files splits | files := self fileNamesMatching: (baseFileName,'*', self class dot, extension). splits := files collect: [:file | self splitNameVersionExtensionFor: file] thenSelect: [:split | (split at: 1) = baseFileName]. splits := splits asSortedCollection: [:a :b | (a at: 2) < (b at: 2)]. ^splits isEmpty ifTrue: [nil] ifFalse: [(baseFileName, '.', (splits last at: 2) asString, self class dot, extension) asFileName]! Item was changed: ----- Method: FileDirectory>>nextNameFor:extension: (in category 'file name utilities') ----- nextNameFor: baseFileName extension: extension "Assumes a file name includes a version number encoded as '.' followed by digits preceding the file extension. Increment the version number and answer the new file name. If a version number is not found, set the version to 1 and answer a new file name" | files splits version | files := self fileNamesMatching: (baseFileName,'*', self class dot, extension). splits := files collect: [:file | self splitNameVersionExtensionFor: file] thenSelect: [:split | (split at: 1) = baseFileName]. splits := splits asSortedCollection: [:a :b | (a at: 2) < (b at: 2)]. splits isEmpty ifTrue: [version := 1] ifFalse: [version := (splits last at: 2) + 1]. ^ (baseFileName, '.', version asString, self class dot, extension) asFileName! Item was changed: ----- Method: FileDirectory>>putFile:named: (in category 'file operations') ----- putFile: file1 named: destinationFileName "Copy the contents of the existing fileStream into the file destinationFileName in this directory. fileStream can be anywhere in the fileSystem." | file2 | file1 binary. (file2 := self newFileNamed: destinationFileName) ifNil: [^ false]. file2 binary. self copyFile: file1 toFile: file2. file1 close. file2 close. ^ true ! Item was changed: ----- Method: FileDirectory>>realUrl (in category 'file name utilities') ----- realUrl "Senders expect url without trailing slash - #url returns slash" | url | url := self url. url last = $/ ifTrue:[^url copyFrom: 1 to: url size-1]. ^url! Item was changed: ----- Method: FileDirectory>>setPathName: (in category 'private') ----- setPathName: pathString pathName := FilePath pathName: pathString. ! Item was changed: ----- Method: FileDirectory>>splitNameVersionExtensionFor: (in category 'file name utilities') ----- splitNameVersionExtensionFor: fileName " answer an array with the root name, version # and extension. See comment in nextSequentialNameFor: for more details" | baseName version extension i j | baseName := self class baseNameFor: fileName. extension := self class extensionFor: fileName. i := j := baseName findLast: [:c | c isDigit not]. i = 0 ifTrue: [version := 0] ifFalse: [(baseName at: i) = $. ifTrue: [version := (baseName copyFrom: i+1 to: baseName size) asNumber. j := j - 1] ifFalse: [version := 0]. baseName := baseName copyFrom: 1 to: j]. ^ Array with: baseName with: version with: extension! Item was changed: ----- Method: FileDirectory>>upLoadProject:named:resourceUrl:retry: (in category 'file operations') ----- upLoadProject: projectFile named: destinationFileName resourceUrl: resUrl retry: aBool "Copy the contents of the existing fileStream into the file destinationFileName in this directory. fileStream can be anywhere in the fileSystem. No retrying for local file systems." | result | result := self putFile: projectFile named: destinationFileName. [self setMacFileNamed: destinationFileName type: 'SOBJ' creator: 'FAST'] on: Error do: [ "ignore" ]. ^result! Item was changed: ----- Method: FileDirectory>>withAllFilesDo:andDirectoriesDo: (in category 'searching') ----- withAllFilesDo: fileStreamBlock andDirectoriesDo: directoryBlock "For the receiver and all it's subdirectories evaluate directoryBlock. For a read only file stream on each file within the receiver and it's subdirectories evaluate fileStreamBlock." | todo dir | todo := OrderedCollection with: self. [todo size > 0] whileTrue: [ dir := todo removeFirst. directoryBlock value: dir. dir fileNames do: [: n | fileStreamBlock value: (FileStream readOnlyFileNamed: (dir fullNameFor: n))]. dir directoryNames do: [: n | todo add: (dir directoryNamed: n)]] ! Item was changed: ----- Method: FileDirectory>>withAllSubdirectoriesCollect: (in category 'enumeration') ----- withAllSubdirectoriesCollect: aBlock "Evaluate aBlock with each of the directories in the subtree of the file system whose root is this directory. Answer the results of these evaluations." | result todo dir | result := OrderedCollection new: 100. todo := OrderedCollection with: self. [todo size > 0] whileTrue: [ dir := todo removeFirst. result add: (aBlock value: dir). dir directoryNames do: [:n | todo add: (dir directoryNamed: n)]]. ^ result ! Item was changed: ----- Method: FilePath>>convertToCurrentVersion:refStream: (in category 'file in/out') ----- convertToCurrentVersion: varDict refStream: smartRefStrm "If we're reading in an old version with a system path instance variable, convert it to a vm path." varDict at: 'systemPathName' ifPresent: [ :x | vmPathName := x. ]. ^super convertToCurrentVersion: varDict refStream: smartRefStrm. ! Item was changed: ----- Method: FilePath>>copySystemToVm (in category 'file in/out') ----- copySystemToVm (self class instVarNames includes: 'systemPathName') ifTrue: [ vmPathName := self instVarNamed: 'systemPathName'. ]. ! Item was changed: ----- Method: FilePath>>pathName:isEncoded: (in category 'conversion') ----- pathName: p isEncoded: isEncoded converter := LanguageEnvironment defaultFileNameConverter. isEncoded ifTrue: [ squeakPathName := p convertFromWithConverter: converter. vmPathName := p. ] ifFalse: [ squeakPathName := p isOctetString ifTrue: [p asOctetString] ifFalse: [p]. vmPathName := squeakPathName convertToWithConverter: converter. ]. ! Item was changed: ----- Method: FileStream class>>oldFileOrNoneNamed: (in category 'instance creation') ----- oldFileOrNoneNamed: fileName "If the file exists, answer a read-only FileStream on it. If it doesn't, answer nil." | fullName | fullName := self fullName: fileName. (self concreteStream isAFileNamed: fullName) ifTrue: [^ self concreteStream readOnlyFileNamed: fullName] ifFalse: [^ nil]. ! Item was changed: ----- Method: FileStream class>>removeLineFeeds: (in category 'file reader services') ----- removeLineFeeds: fullName | fileContents | fileContents := ((FileStream readOnlyFileNamed: fullName) wantsLineEndConversion: true) contentsOfEntireFile. (FileStream newFileNamed: fullName) nextPutAll: fileContents; close.! Item was changed: ----- Method: FileStream>>contents (in category 'accessing') ----- contents "Return the contents of the receiver. Do not close or otherwise touch the receiver. Return data in whatever mode the receiver is in (e.g., binary or text)." | s savePos | savePos := self position. self position: 0. s := self next: self size. self position: savePos. ^s! Item was changed: ----- Method: HtmlFileStream class>>initialize (in category 'class initialization') ----- initialize "HtmlFileStream initialize" TabThing := '   ' "I took Ted's suggestion to use &nbsp, which works far better for the HTML. Style sheets provide an alternative, possibly better, solution since they permit finer-grain control of the HTML formatting, and thus would permit capturing the style in which text was originally rendered. Internal tabbings would still get lost. 1/1/99 acg."! Item was changed: ----- Method: HtmlFileStream class>>newFrom: (in category 'instance creation') ----- newFrom: aFileStream "Answer an HtmlFileStream that is 'like' aFileStream. As a side-effect, the surviving fileStream answered by this method replaces aFileStream on the finalization registry. 1/6/99 acg" |inst| inst := super newFrom: aFileStream. StandardFileStream unregister: aFileStream. HtmlFileStream register: inst. inst detectLineEndConvention. ^inst ! Item was changed: ----- Method: HtmlFileStream>>copyMethodChunkFrom: (in category 'fileIn/Out') ----- copyMethodChunkFrom: aStream "Overridden to bolden the first line (presumably a method header)" | terminator code firstLine | terminator := $!!. aStream skipSeparators. code := aStream upTo: terminator. firstLine := code copyUpTo: Character cr. firstLine size = code size ifTrue: [self nextPutAll: code] ifFalse: [self command: 'b'; nextPutAll: firstLine; command: '/b'. self nextPutAll: (code copyFrom: firstLine size + 1 to: code size)]. self nextPut: terminator. [aStream peekFor: terminator] whileTrue: "case of imbedded (doubled) terminators" [self nextPut: terminator; nextPutAll: (aStream upTo: terminator); nextPut: terminator]! Item was changed: ----- Method: HtmlFileStream>>header (in category 'read, write, position') ----- header "append the HTML header. Be sure to call trailer after you put out the data. 4/4/96 tk" | cr | cr := String with: Character cr. self command: 'HTML'; verbatim: cr. self command: 'HEAD'; verbatim: cr. self command: 'TITLE'. self nextPutAll: '"', self name, '"'. self command: '/TITLE'; verbatim: cr. self command: '/HEAD'; verbatim: cr. self command: 'BODY'; verbatim: cr. ! Item was changed: ----- Method: HtmlFileStream>>nextChunk (in category 'fileIn/Out') ----- nextChunk "Answer the contents of the receiver, up to the next terminator character (!!). Imbedded terminators are doubled. Undo and strip out all Html stuff in the stream and convert the characters back. 4/12/96 tk" | out char did rest | self skipSeparators. "Absorb <...><...> also" out := WriteStream on: (String new: 500). [self atEnd] whileFalse: [ self peek = $< ifTrue: [self unCommand]. "Absorb <...><...>" (char := self next) = $& ifTrue: [ rest := self upTo: $;. did := out position. rest = 'lt' ifTrue: [out nextPut: $<]. rest = 'gt' ifTrue: [out nextPut: $>]. rest = 'amp' ifTrue: [out nextPut: $&]. did = out position ifTrue: [ self error: 'new HTML char encoding'. "Please add it to this code"]] ifFalse: [char = $!! "terminator" ifTrue: [ self peek = $!! ifFalse: [^ out contents]. out nextPut: self next] "pass on one $!!" ifFalse: [char asciiValue = 9 ifTrue: [self next; next; next; next "TabThing"]. out nextPut: char]] ]. ^ out contents! Item was changed: ----- Method: HtmlFileStream>>trailer (in category 'read, write, position') ----- trailer "append the HTML trailer. Call this just before file close. 4/4/96 tk" | cr | cr := String with: Character cr. self command: '/BODY'; verbatim: cr. self command: '/HTML'; verbatim: cr. ! Item was changed: ----- Method: MacFileDirectory class>>initializeTypeToMimeMappings (in category 'class initialization') ----- initializeTypeToMimeMappings "MacFileDirectory initializeTypeToMimeMappings" TypeToMimeMappings := Dictionary new. #( "format" "(abcd ('image/gif'))" ) do:[:spec| TypeToMimeMappings at: spec first asString put: spec last. ]. ! Item was changed: ----- Method: MacFileDirectory class>>makeAbsolute: (in category 'platform specific') ----- makeAbsolute: path "Ensure that path looks like an absolute path" | absolutePath | (self isAbsolute: path) ifTrue: [ ^path ]. "If a path begins with a colon, it is relative." absolutePath := (path first = $:) ifTrue: [ path copyWithoutFirst ] ifFalse: [ path ]. (self isAbsolute: absolutePath) ifTrue: [ ^absolutePath ]. "Otherwise, if it contains a colon anywhere, it is absolute and the first component is the volume name." ^absolutePath, ':'! Item was changed: ----- Method: MacFileDirectory>>fullNameFor: (in category 'as yet unclassified') ----- fullNameFor: fileName "Return a corrected, fully-qualified name for the given file name. If the given name is already a full path (i.e., it contains a delimiter character), assume it is already a fully-qualified name. Otherwise, prefix it with the path to this directory. In either case, correct the local part of the file name." "Details: Note that path relative to a directory, such as '../../foo' are disallowed by this algorithm. Also note that this method is tolerent of a nil argument -- is simply returns nil in this case." "Fix by hmm: for a file in the root directory of a volume on MacOS, the filePath (name of the directory) is not recognizable as an absolute path anymore (it has no delimiters). Therefore, the original fileName is tested for absoluteness, and the filePath is only made absolute if the original fileName was not absolute" | correctedLocalName prefix | fileName isEmptyOrNil ifTrue: [^ fileName]. DirectoryClass splitName: fileName to: [:filePath :localName | correctedLocalName := localName isEmpty ifFalse: [self checkName: localName fixErrors: true] ifTrue: [localName]. prefix := (DirectoryClass isAbsolute: fileName) ifTrue: [filePath] ifFalse: [self fullPathFor: filePath]]. prefix isEmpty ifTrue: [^correctedLocalName]. prefix last = self pathNameDelimiter ifTrue:[^ prefix, correctedLocalName] ifFalse:[^ prefix, self slash, correctedLocalName]! Item was changed: ----- Method: MacFileDirectory>>mimeTypesFor: (in category 'file operations') ----- mimeTypesFor: fileName "Return a list of MIME types applicable to the receiver. This default implementation uses the file name extension to figure out what we're looking at but specific subclasses may use other means of figuring out what the type of some file is. Some systems like the macintosh use meta data on the file to indicate data type" | typeCreator type | typeCreator := self getMacFileTypeAndCreator: ((self fullNameFor: fileName)). type := (typeCreator at: 1) asLowercase. ^TypeToMimeMappings at: type ifAbsent:[super mimeTypesFor: fileName]! Item was changed: ----- Method: RemoteString>>fileStream (in category 'accessing') ----- fileStream "Answer the file stream with position set at the beginning of my string" | theFile | (sourceFileNumber == nil or: [(SourceFiles at: sourceFileNumber) == nil]) ifTrue: [^ nil]. theFile := SourceFiles at: sourceFileNumber. theFile position: filePositionHi. ^ theFile! Item was changed: ----- Method: RemoteString>>setSourcePointer: (in category 'accessing') ----- setSourcePointer: aSourcePointer sourceFileNumber := SourceFiles fileIndexFromSourcePointer: aSourcePointer. filePositionHi := SourceFiles filePositionFromSourcePointer: aSourcePointer! Item was changed: ----- Method: RemoteString>>string (in category 'accessing') ----- string "Answer the receiver's string if remote files are enabled." | theFile | (sourceFileNumber == nil or: [(SourceFiles at: sourceFileNumber) == nil]) ifTrue: [^'']. theFile := SourceFiles at: sourceFileNumber. theFile position: filePositionHi. ^ theFile nextChunk! Item was changed: ----- Method: RemoteString>>string:onFileNumber:toFile: (in category 'private') ----- string: aStringOrText onFileNumber: fileNumber toFile: aFileStream "Store this as the receiver's text if source files exist. If aStringOrText is a Text, store a marker with the string part, and then store the runs of TextAttributes in the next chunk." | position | position := aFileStream position. self fileNumber: fileNumber position: position. aFileStream nextChunkPutWithStyle: aStringOrText "^ self (important)"! Item was changed: ----- Method: StandardFileStream class>>isAFileNamed: (in category 'file creation') ----- isAFileNamed: fileName "Answer true if a file of the given name exists." | f | f := self new open: fileName forWrite: false. f ifNil: [^ false]. f close. ^ true ! 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." | 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 changed: ----- Method: StandardFileStream class>>oldFileNamed: (in category 'file creation') ----- oldFileNamed: fileName "Open an existing file with the given name for reading and writing. If the name has no directory part, then the file will be created in the default directory. If the file already exists, its prior contents may be modified or replaced, but the file will not be truncated on close." | fullName | fullName := self fullName: fileName. ^(self isAFileNamed: fullName) ifTrue: [self new open: fullName forWrite: true] ifFalse: ["File does not exist..." (FileDoesNotExistException fileName: fullName) signal]! Item was changed: ----- Method: StandardFileStream>>findStringFromEnd: (in category 'read, write, position') ----- findStringFromEnd: string "Fast version to find a String in a file starting from the end. Returns the position and also sets the position there. If string is not found 0 is returned and position is unchanged." | pos buffer count oldPos | oldPos := self position. self setToEnd. pos := self position. [ pos := ((pos - 2000 + string size) max: 0). "the [+ string size] allows for the case where the end of the search string is at the beginning of the current buffer" self position: pos. buffer := self next: 2000. (count := buffer findString: string) > 0 ifTrue: ["Found the string part way into buffer" self position: pos. self next: count-1. "use next instead of position:, so that CrLfFileStream can do its magic if it is being used" ^self position]. pos = 0] whileFalse. "Never found it, and hit beginning of file" self position: oldPos. ^0! Item was changed: ----- Method: StandardFileStream>>peekFor: (in category 'access') ----- peekFor: item "Answer false and do not advance if the next element is not equal to item, or if this stream is at the end. If the next element is equal to item, then advance over it and return true" | next | "self atEnd ifTrue: [^ false]. -- SFStream will give nil" (next := self next) == nil ifTrue: [^ false]. item = next ifTrue: [^ true]. self skip: -1. ^ false! Item was changed: ----- Method: StandardFileStream>>primFlush: (in category 'primitives') ----- primFlush: id "Flush pending changes to the disk" | p | <primitive: 'primitiveFileFlush' module: 'FilePlugin'> "In some OS's seeking to 0 and back will do a flush" p := self position. self position: 0; position: p! Item was changed: ----- Method: StandardFileStream>>primURLRequest:target:semaIndex: (in category 'browser requests') ----- primURLRequest: url target: target semaIndex: index "target - String (frame, also ':=top', ':=parent' etc)" <primitive:'primitivePluginRequestURL'> ^nil ! Item was changed: ----- Method: StandardFileStream>>readOnly (in category 'properties-setting') ----- readOnly "Make this file read-only." rwmode := false. ! Item was changed: ----- Method: StandardFileStream>>readWrite (in category 'properties-setting') ----- readWrite "Make this file writable." rwmode := true. ! Item was changed: ----- Method: StandardFileStream>>waitBrowserReadyFor:ifFail: (in category 'browser requests') ----- waitBrowserReadyFor: timeout ifFail: errorBlock | startTime delay okay | okay := self primBrowserReady. okay ifNil:[^errorBlock value]. okay ifTrue: [^true]. startTime := Time millisecondClockValue. delay := Delay forMilliseconds: 100. [(Time millisecondsSince: startTime) < timeout] whileTrue: [ delay wait. okay := self primBrowserReady. okay ifNil:[^errorBlock value]. okay ifTrue: [^true]]. ^errorBlock value! Item was changed: ----- Method: StandardSourceFileArray>>fileIndexFromSourcePointer: (in category 'sourcePointer conversion') ----- fileIndexFromSourcePointer: anInteger "Return the index of the source file which contains the source chunk addressed by anInteger" "This implements the recent 32M source file algorithm" | hi | hi := anInteger // 16r1000000. ^hi < 3 ifTrue: [hi] ifFalse: [hi - 2]! Item was changed: ----- Method: StandardSourceFileArray>>filePositionFromSourcePointer: (in category 'sourcePointer conversion') ----- filePositionFromSourcePointer: anInteger "Return the position of the source chunk addressed by anInteger" "This implements the recent 32M source file algorithm" | hi lo | hi := anInteger // 16r1000000. lo := anInteger \\ 16r1000000. ^hi < 3 ifTrue: [lo] ifFalse: [lo + 16r1000000]! Item was changed: ----- Method: StandardSourceFileArray>>initialize (in category 'initialize-release') ----- initialize files := Array new: 2. files at: 1 put: (SourceFiles at: 1). files at: 2 put: (SourceFiles at: 2)! Item was changed: ----- Method: StandardSourceFileArray>>initialize: (in category 'initialize-release') ----- initialize: nFiles files := Array new: nFiles! Item was changed: ----- Method: StandardSourceFileArray>>sourcePointerFromFileIndex:andPosition: (in category 'sourcePointer conversion') ----- sourcePointerFromFileIndex: index andPosition: position | hi lo | "Return a source pointer according to the new 32M algorithm" ((index between: 1 and: 2) and: [position between: 0 and: 16r1FFFFFF]) ifFalse: [self error: 'invalid source code pointer']. hi := index. lo := position. lo >= 16r1000000 ifTrue: [ hi := hi+2. lo := lo - 16r1000000]. ^hi * 16r1000000 + lo! Item was changed: ----- Method: UnixFileDirectory>>setPathName: (in category 'private') ----- setPathName: pathString "Unix path names start with a leading delimiter character." (pathString isEmpty or: [pathString first ~= self pathNameDelimiter]) ifTrue: [pathName := FilePath pathName: (self pathNameDelimiter asString, pathString)] ifFalse: [pathName := FilePath pathName: pathString]. !

1 0

The Trunk: EToys-bf.119.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

Bert Freudenberg uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-bf.119.mcz ==================== Summary ==================== Name: EToys-bf.119 Author: bf Time: 8 December 2014, 1:39:03.772 am UUID: 5b17be15-da78-4207-88e4-f2c78f0e75b9 Ancestors: EToys-dtl.118 Restore timestamps lost in assignment conversion. =============== Diff against EToys-dtl.118 =============== Item was changed: ----- Method: CardPlayer class>>compileAccessorsFor: (in category 'slots') ----- compileAccessorsFor: varName "Compile instance-variable accessor methods for the given variable name" | nameString | nameString := varName asString capitalized. self compileSilently: ('get', nameString, ' ^ ', varName) classified: 'access'. self compileSilently: ('set', nameString, ': val ', varName, ' := val') classified: 'access'! Item was changed: ----- Method: EToyVocabulary class>>masterOrderingOfCategorySymbols (in category 'accessing') ----- masterOrderingOfCategorySymbols "Answer a dictatorially-imposed presentation list of category symbols. This governs the order in which available vocabulary categories are presented in etoy viewers using the etoy vocabulary. The default implementation is that any items that are in this list will occur first, in the order specified here; after that, all other items will come, in alphabetic order by their translated wording." ^#(basic #'color & border' geometry motion #'pen use' tests layout #'drag & drop' scripting observation button search miscellaneous)! Item was changed: ----- Method: EToyVocabulary>>isEToyVocabulary (in category 'testing') ----- isEToyVocabulary ^true! Item was changed: ----- Method: FileDirectory>>eToyUserList (in category '*Etoys') ----- eToyUserList | spec index fd list match | spec := self eToyBaseFolderSpec. "something like 'U:\Squeak\users\*-Squeak'." spec ifNil:[^ServerDirectory eToyUserListForFileDirectory: self]. "Compute list of users based on base folder spec" index := spec indexOf: $*. "we really need one" index = 0 ifTrue:[^ServerDirectory eToyUserListForFileDirectory: self]. fd := FileDirectory on: (FileDirectory dirPathFor: (spec copyFrom: 1 to: index)). "reject all non-directories" list := fd entries select:[:each| each isDirectory]. "reject all non-matching entries" match := spec copyFrom: fd pathName size + 2 to: spec size. list := list collect:[:each| each name]. list := list select:[:each| match match: each]. "extract the names (e.g., those positions that match '*')" index := match indexOf: $*. list := list collect:[:each| each copyFrom: index to: each size - (match size - index)]. ^list! Item was changed: ----- Method: FileDirectory>>eToyUserName: (in category '*Etoys') ----- eToyUserName: aString "Set the default directory from the given user name" | dirName | dirName := self eToyBaseFolderSpec. "something like 'U:\Squeak\users\*-Squeak'" dirName ifNil:[^self]. dirName := dirName copyReplaceAll:'*' with: aString. " dirName last = self class pathNameDelimiter ifFalse:[dirName := dirName, self slash]. FileDirectory setDefaultDirectoryFrom: dirName. dirName := dirName copyFrom: 1 to: dirName size - 1. " pathName := FilePath pathName: dirName! Item was changed: ----- Method: MethodHolder class>>isolatedCodePaneForClass:selector: (in category '*Etoys') ----- isolatedCodePaneForClass: aClass selector: aSelector "Answer a MethodMorph on the given class and selector" | aCodePane aMethodHolder | aMethodHolder := self new. aMethodHolder methodClass: aClass methodSelector: aSelector. aCodePane := MethodMorph on: aMethodHolder text: #contents accept: #contents:notifying: readSelection: #contentsSelection menu: #codePaneMenu:shifted:. aMethodHolder addDependent: aCodePane. aCodePane borderWidth: 2; color: Color white. aCodePane scrollBarOnLeft: false. aCodePane width: 300. ^ aCodePane! Item was changed: ----- Method: MethodHolder class>>makeIsolatedCodePaneForClass:selector: (in category '*Etoys') ----- makeIsolatedCodePaneForClass: aClass selector: aSelector "Create, and place in the morphic Hand, an isolated code pane bearing source code for the given class and selector" (self isolatedCodePaneForClass: aClass selector: aSelector) openInHand! Item was changed: ----- Method: Player class>>compileInstVarAccessorsFor: (in category 'slots') ----- compileInstVarAccessorsFor: varName "Compile getters and setteres for the given instance variable name" | nameString | nameString := varName asString capitalized. self compileSilently: ('get', nameString, ' ^ ', varName) classified: 'access'. self compileSilently: ('set', nameString, ': val ', varName, ' := val') classified: 'access'! Item was changed: ----- Method: Player>>getConePosition (in category 'sound') ----- getConePosition "Note: Performance hacked to allow real-time sound. Assumes costume is a SpeakerMorph." ^ costume renderedMorph conePosition! Item was changed: ----- Method: Player>>setConePosition: (in category 'sound') ----- setConePosition: aNumber "Note: Performance hacked to allow real-time sound. Assumes costume is a SpeakerMorph." costume renderedMorph conePosition: aNumber.! Item was changed: ----- Method: Point>>basicType (in category '*Etoys-tiles') ----- basicType "Answer a symbol representing the inherent type of the receiver" ^ #Point! Item was changed: ----- Method: ScriptEditorMorph>>toggleWhetherShowingTiles (in category 'other') ----- toggleWhetherShowingTiles "Toggle between showing the method pane and showing the tiles pane" self showingMethodPane ifFalse: "currently showing tiles" [self showSourceInScriptor] ifTrue: "current showing textual source" [Preferences universalTiles ifTrue: [^ self revertToTileVersion]. self savedTileVersionsCount >= 1 ifTrue: [(self userScriptObject lastSourceString = (playerScripted class compiledMethodAt: scriptName) decompileString) ifFalse: [(self confirm: 'Caution -- this script was changed textually; if you revert to tiles at this point you will lose all the changes you may have made textually. Do you really want to do this?' translated) ifFalse: [^ self]]. self revertToTileVersion] ifFalse: [Beeper beep]]! Item was changed: ----- Method: String>>newTileMorphRepresentative (in category '*Etoys-tiles') ----- newTileMorphRepresentative ^ TileMorph new setLiteral: self;addSuffixIfCan! Item was changed: ----- Method: SyntaxMorph class>>allSpecs (in category 'accessing') ----- allSpecs "Return all specs that the Viewer knows about. Cache them." "SyntaxMorph allSpecs" ^AllSpecs ifNil: [ AllSpecs := Dictionary new. (EToyVocabulary morphClassesDeclaringViewerAdditions) do: [:cls | cls allAdditionsToViewerCategories keysAndValuesDo: [ :k :v | (AllSpecs at: k ifAbsentPut: [ OrderedCollection new ]) addAll: v ] ]. AllSpecs ]! Item was changed: ----- Method: SyntaxMorph class>>clearAllSpecs (in category 'accessing') ----- clearAllSpecs "Clear the specs that the Viewer knows about." "SyntaxMorph clearAllSpecs" AllSpecs := nil.! Item was changed: ----- Method: SyntaxMorph>>assignmentArrow (in category 'pop ups') ----- assignmentArrow "Offer to embed this variable in a new assignment statement. (Don't confuse this with upDownAssignment:, which runs the up and down arrows that rotate among assignment types.)" | rr | self isAVariable ifFalse: [^ nil]. self isDeclaration ifTrue: [^ nil]. ^ (rr := RectangleMorph new) extent: 11@13; borderWidth: 1; color: Color lightGreen; borderColor: Color gray; addMorph: ((self noiseStringMorph: '_') topLeft: rr topLeft + (3@0)); on: #mouseUp send: #newAssignment to: self ! Item was changed: ----- Method: SyntaxMorph>>assignmentNode:variable:value: (in category 'node to morph') ----- assignmentNode: aNode variable: variable value: value | row v expMorph | row := self addRow: #assignment on: aNode. v := variable asMorphicSyntaxIn: row. self alansTest1 ifTrue: [v setConditionalPartStyle; layoutInset: 2]. row addToken: ' := ' type: #assignmentArrow on: aNode. expMorph := value asMorphicSyntaxIn: row. self alansTest1 ifTrue: [ row setSpecialOuterTestFormat. (expMorph hasProperty: #deselectedColor) ifFalse: [expMorph setConditionalPartStyle]. ]. ^row ! 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: World. ! Item was changed: ----- Method: TileMorph>>mouseMove: (in category 'event handling') ----- mouseMove: evt self options ifNotNil: [^ self showOptions]. (self hasProperty: #previousLiteral) ifFalse: [^ self]. self currentHand releaseKeyboardFocus. "Once reviving the value at drag start" literal := self valueOfProperty: #previousLiteral. "Then applying delta" self arrowAction: (self valueOfProperty: #previousPoint) y - evt position y * self arrowDelta abs. ^ super mouseMove: evt! Item was changed: ----- Method: TypeListTile>>addMenuIcon (in category 'arrows') ----- addMenuIcon "Add a little menu icon; store it in my suffixArrow slot" suffixArrow := ImageMorph new image: (ScriptingSystem formAtKey: #MenuTriangle). suffixArrow setBalloonText: 'click here to choose a new type for this parameter' translated. self addMorphBack: suffixArrow! Item was changed: ----- Method: Vocabulary class>>instanceWhoRespondsTo: (in category '*Etoys-queries') ----- instanceWhoRespondsTo: aSelector "Find the most likely class that responds to aSelector. Return an instance of it. Look in vocabularies to match the selector." "Most eToy selectors are for Players" | mthRefs | ((self vocabularyNamed: #eToy) includesSelector: aSelector) ifTrue: [aSelector == #+ ifFalse: [^ Player new costume: Morph new]]. "Numbers are a problem" ((self vocabularyNamed: #Number) includesSelector: aSelector) ifTrue: [^ 1]. "Is a Float any different?" "String Point Time Date" #() do: [:nn | ((self vocabularyNamed: nn) includesSelector: aSelector) ifTrue: ["Ask Scott how to get a prototypical instance" ^ (Smalltalk at: nn) new]]. mthRefs := self systemNavigation allImplementorsOf: aSelector. "every one who implements the selector" mthRefs sortBlock: [:a :b | (Smalltalk at: a classSymbol) allSuperclasses size < (Smalltalk at: b classSymbol) allSuperclasses size]. mthRefs size > 0 ifTrue: [^ (Smalltalk at: mthRefs first classSymbol) new]. ^ Error new!

1 0

The Trunk: Compression-bf.46.mcz
by commits＠source.squeak.org 08 Dec '14

08 Dec '14

Bert Freudenberg uploaded a new version of Compression to project The Trunk: http://source.squeak.org/trunk/Compression-bf.46.mcz ==================== Summary ==================== Name: Compression-bf.46 Author: bf Time: 8 December 2014, 1:35:04.484 am UUID: d9f61764-05a9-4109-ae6c-4835e2d04a4a Ancestors: Compression-nice.45 Restore timestamps lost in assignment conversion. =============== Diff against Compression-nice.45 =============== Item was changed: ----- Method: CompressedSourceStream>>contentsOfEntireFile (in category 'access') ----- contentsOfEntireFile | contents | self position: 0. contents := self next: self size. self close. ^ contents! Item was changed: ----- Method: CompressedSourceStream>>next (in category 'access') ----- next <primitive: 65> position >= readLimit ifTrue: [^ (self next: 1) at: 1] ifFalse: [^ collection at: (position := position + 1)]! Item was changed: ----- Method: CompressedSourceStream>>next: (in category 'access') ----- next: n | str | n <= (readLimit - position) ifTrue: ["All characters are available in buffer" str := collection copyFrom: position + 1 to: position + n. position := position + n. ^ str]. "Read limit could be segment boundary or real end of file" (readLimit + self segmentOffset) = endOfFile ifTrue: ["Real end of file -- just return what's available" ^ self next: readLimit - position]. "Read rest of segment. Then (after positioning) read what remains" str := self next: readLimit - position. self position: self position. ^ str , (self next: n - str size) ! Item was changed: ----- Method: CompressedSourceStream>>openOn: (in category 'open/close') ----- openOn: aFile "Open the receiver." segmentFile := aFile. segmentFile binary. segmentFile size > 0 ifTrue: [self readHeaderInfo. "If file exists, then read the parameters"] ifFalse: [self segmentSize: 20000 maxSize: 34000000. "Otherwise write default values"]! Item was changed: ----- Method: CompressedSourceStream>>position: (in category 'access') ----- position: newPosition | compressedBuffer newSegmentIndex | newPosition > endOfFile ifTrue: [self error: 'Attempt to position beyond the end of file']. newSegmentIndex := (newPosition // segmentSize) + 1. newSegmentIndex ~= segmentIndex ifTrue: [self flush. segmentIndex := newSegmentIndex. newSegmentIndex > nSegments ifTrue: [self error: 'file size limit exceeded']. segmentFile position: (segmentTable at: segmentIndex). (segmentTable at: segmentIndex+1) = 0 ifTrue: [newPosition ~= endOfFile ifTrue: [self error: 'Internal logic error']. collection size = segmentSize ifFalse: [self error: 'Internal logic error']. "just leave garbage beyond end of file"] ifFalse: [compressedBuffer := segmentFile next: ((segmentTable at: segmentIndex+1) - (segmentTable at: segmentIndex)). collection := (GZipReadStream on: compressedBuffer) upToEnd asString]. readLimit := collection size min: endOfFile - self segmentOffset]. position := newPosition \\ segmentSize. ! Item was changed: ----- Method: CompressedSourceStream>>readHeaderInfo (in category 'open/close') ----- readHeaderInfo | valid a b | segmentFile position: 0. segmentSize := segmentFile nextNumber: 4. nSegments := segmentFile nextNumber: 4. endOfFile := segmentFile nextNumber: 4. segmentFile size < (nSegments+1 + 3 * 4) ifTrue: "Check for reasonable segment info" [self error: 'This file is not in valid compressed source format']. segmentTable := (1 to: nSegments+1) collect: [:x | segmentFile nextNumber: 4]. segmentTable first ~= self firstSegmentLoc ifTrue: [self error: 'This file is not in valid compressed source format']. valid := true. 1 to: nSegments do: "Check that segment offsets are ascending" [:i | a := segmentTable at: i. b := segmentTable at: i+1. (a = 0 and: [b ~= 0]) ifTrue: [valid := false]. (a ~= 0 and: [b ~= 0]) ifTrue: [b <= a ifTrue: [valid := false]]]. valid ifFalse: [self error: 'This file is not in valid compressed source format']. dirty := false. self position: 0.! Item was changed: ----- Method: CompressedSourceStream>>segmentSize:maxSize: (in category 'private') ----- segmentSize: segSize maxSize: maxSize "Note that this method can be called after the initial open, provided that no writing has yet taken place. This is how to override the default segmentation." self size = 0 ifFalse: [self error: 'Cannot set parameters after the first write']. segmentFile position: 0. segmentFile nextNumber: 4 put: (segmentSize := segSize). segmentFile nextNumber: 4 put: (nSegments := maxSize // segSize + 2). segmentFile nextNumber: 4 put: (endOfFile := 0). segmentTable := Array new: nSegments+1 withAll: 0. segmentTable at: 1 put: self firstSegmentLoc. "Loc of first segment, always." segmentTable do: [:i | segmentFile nextNumber: 4 put: i]. segmentIndex := 1. collection := String new: segmentSize. writeLimit := segmentSize. readLimit := 0. position := 0. endOfFile := 0. self writeSegment. ! Item was changed: ----- Method: CompressedSourceStream>>writeSegment (in category 'private') ----- writeSegment "The current segment must be the last in the file." | compressedSegment | segmentFile position: (segmentTable at: segmentIndex). compressedSegment := ByteArray streamContents: [:strm | (GZipWriteStream on: strm) nextPutAll: collection asByteArray; close]. segmentFile nextPutAll: compressedSegment. segmentTable at: segmentIndex + 1 put: segmentFile position. segmentFile position: 2 * 4. segmentFile nextNumber: 4 put: endOfFile. segmentFile position: (segmentIndex + 3) * 4. segmentFile nextNumber: 4 put: (segmentTable at: segmentIndex + 1). dirty := false! Item was changed: ----- Method: GZipSurrogateStream>>timeStamp (in category 'as yet unclassified') ----- timeStamp "Append the current time to the receiver as a String." self bufferStream nextChunkPut: "double string quotes and !!s" (String streamContents: [:s | Smalltalk timeStamp: s]) printString. self bufferStream cr!

1 0

← Newer
1
...
6
7
8
9
10
11
12
Older →