Packages December 2018

packages@lists.squeakfoundation.org

1 participants
51 discussions

The Trunk: Monticello-pre.690.mcz
by commits＠source.squeak.org 07 Dec '18

07 Dec '18

Patrick Rein uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-pre.690.mcz ==================== Summary ==================== Name: Monticello-pre.690 Author: pre Time: 7 December 2018, 9:58:49.626427 am UUID: 1ff627da-fec1-48d4-b35f-eec253e8ef0f Ancestors: Monticello-pre.689 More advances on categorizing all the messages. This time the Monticello classes (except for one class for which I am really unsure what the messages are actually for). =============== Diff against Monticello-pre.689 =============== Item was changed: + ----- Method: MCAddition class>>of: (in category 'instance creation') ----- - ----- Method: MCAddition class>>of: (in category 'as yet unclassified') ----- of: aDefinition ^ self new intializeWithDefinition: aDefinition! Item was changed: + ----- Method: MCAddition>>= (in category 'comparing') ----- - ----- Method: MCAddition>>= (in category 'as yet unclassified') ----- = other ^ other isAddition and: [definition = other definition]! Item was changed: + ----- Method: MCAddition>>applyTo: (in category 'applying') ----- - ----- Method: MCAddition>>applyTo: (in category 'accessing') ----- applyTo: anObject anObject addDefinition: definition! Item was changed: + ----- Method: MCAddition>>hash (in category 'comparing') ----- - ----- Method: MCAddition>>hash (in category 'as yet unclassified') ----- hash ^ definition hash! Item was changed: + ----- Method: MCAddition>>inverse (in category 'accessing') ----- - ----- Method: MCAddition>>inverse (in category 'as yet unclassified') ----- inverse ^ MCRemoval of: definition! Item was changed: + ----- Method: MCAddition>>isClassPatch (in category 'testing') ----- - ----- Method: MCAddition>>isClassPatch (in category 'as yet unclassified') ----- isClassPatch ^definition isClassDefinition! Item was changed: + ----- Method: MCAncestry class>>new (in category 'instance creation') ----- - ----- Method: MCAncestry class>>new (in category 'as yet unclassified') ----- new ^ self basicNew initialize! Item was changed: + ----- Method: MCCacheRepository>>basicStoreVersion: (in category 'private') ----- - ----- Method: MCCacheRepository>>basicStoreVersion: (in category 'as yet unclassified') ----- basicStoreVersion: aVersion (aVersion isCacheable not or: [self allFileNames includes: aVersion fileName]) ifFalse: [super basicStoreVersion: aVersion] ! Item was changed: + ----- Method: MCCacheRepository>>cacheForPackage: (in category 'caching') ----- - ----- 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>>newFileNames (in category 'accessing') ----- - ----- Method: MCCacheRepository>>newFileNames (in category 'as yet unclassified') ----- newFileNames ^ self allFileNames difference: self seenFileNames! Item was changed: + ----- Method: MCCacheRepository>>rescan (in category 'private') ----- - ----- Method: MCCacheRepository>>rescan (in category 'as yet unclassified') ----- rescan + + self flag: #todo. "This method seems to be unused --pre" self newFileNames do: [:ea | self versionReaderForFileNamed: ea do: [:reader | (self cacheForPackage: reader package) recordVersionInfo: reader info forFileNamed: ea. self seenFileNames add: ea]] displayingProgress: 'Scanning cache...'! Item was changed: + ----- Method: MCCacheRepository>>seenFileNames (in category 'accessing') ----- - ----- Method: MCCacheRepository>>seenFileNames (in category 'as yet unclassified') ----- seenFileNames ^ seenFiles ifNil: [seenFiles := OrderedCollection new]! Item was changed: + ----- Method: MCCacheRepository>>versionInfoForFileNamed: (in category 'caching') ----- - ----- Method: MCCacheRepository>>versionInfoForFileNamed: (in category 'as yet unclassified') ----- versionInfoForFileNamed: aString ^ cache at: aString ifAbsentPut: [self versionReaderForFileNamed: aString do: [:r | r info]]! Item was changed: + ----- Method: MCChangeSelector>>buttonSpecs (in category 'ui') ----- - ----- Method: MCChangeSelector>>buttonSpecs (in category 'as yet unclassified') ----- buttonSpecs ^ #((Select select 'Select these changes') (Cancel cancel 'Cancel the operation') )! Item was changed: + ----- Method: MCChangeSelector>>cancel (in category 'actions') ----- - ----- Method: MCChangeSelector>>cancel (in category 'as yet unclassified') ----- cancel self answer: nil! Item was changed: + ----- Method: MCChangeSelector>>defaultLabel (in category 'ui') ----- - ----- Method: MCChangeSelector>>defaultLabel (in category 'as yet unclassified') ----- defaultLabel ^ 'Change Selector'! Item was changed: + ----- Method: MCChangeSelector>>innerButtonRow (in category 'private-ui') ----- - ----- Method: MCChangeSelector>>innerButtonRow (in category 'as yet unclassified') ----- innerButtonRow ^ self buttonRow: self innerButtonSpecs! Item was changed: + ----- Method: MCChangeSelector>>innerButtonSpecs (in category 'private-ui') ----- - ----- Method: MCChangeSelector>>innerButtonSpecs (in category 'as yet unclassified') ----- innerButtonSpecs ^ #(('Select All' selectAll 'select all changes') ('Select None' selectNone 'select no changes'))! Item was changed: + ----- Method: MCChangeSelector>>kept (in category 'accessing') ----- - ----- Method: MCChangeSelector>>kept (in category 'as yet unclassified') ----- kept ^ kept ifNil: [kept := Set new]! Item was changed: + ----- Method: MCChangeSelector>>listSelectionAt: (in category 'actions') ----- - ----- Method: MCChangeSelector>>listSelectionAt: (in category 'as yet unclassified') ----- listSelectionAt: aNumber ^ self kept includes: (self items at: aNumber)! Item was changed: + ----- Method: MCChangeSelector>>listSelectionAt:put: (in category 'actions') ----- - ----- 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>>select (in category 'actions') ----- - ----- Method: MCChangeSelector>>select (in category 'as yet unclassified') ----- select self answer: (MCPatch operations: kept)! Item was changed: + ----- Method: MCChangeSelector>>selectAll (in category 'actions') ----- - ----- Method: MCChangeSelector>>selectAll (in category 'as yet unclassified') ----- selectAll kept addAll: self items. self changed: #list! Item was changed: + ----- Method: MCChangeSelector>>selectNone (in category 'actions') ----- - ----- Method: MCChangeSelector>>selectNone (in category 'as yet unclassified') ----- selectNone kept := Set new. self changed: #list! Item was changed: + ----- Method: MCChangeSelector>>widgetSpecs (in category 'ui') ----- - ----- Method: MCChangeSelector>>widgetSpecs (in category 'as yet unclassified') ----- widgetSpecs Preferences annotationPanes ifFalse: [ ^#( ((buttonRow) (0 0 1 0) (0 0 0 defaultButtonPaneHeight)) ((multiListMorph:selection:listSelection:menu: list selection listSelectionAt: methodListMenu:) (0 0 1 0.4) (0 defaultButtonPaneHeight 0 0)) ((innerButtonRow) (0 0.4 1 0.4) (0 0 0 defaultButtonPaneHeight)) ((textMorph: text) (0 0.4 1 1) (0 defaultButtonPaneHeight 0 0)) )]. ^ { #((buttonRow) (0 0 1 0) (0 0 0 defaultButtonPaneHeight)). #((multiListMorph:selection:listSelection:menu: list selection listSelectionAt: methodListMenu:) (0 0 1 0.4) (0 defaultButtonPaneHeight 0 0)). #((innerButtonRow) (0 0.4 1 0.4) (0 0 0 defaultButtonPaneHeight)). { #(textMorph: annotations). #(0 0.4 1 0.4). { 0. self defaultButtonPaneHeight. 0. self defaultButtonPaneHeight+self defaultAnnotationPaneHeight. }}. { #(textMorph: text). #(0 0.4 1 1). { 0. self defaultButtonPaneHeight+self defaultAnnotationPaneHeight. 0. 0.}} }! Item was changed: + ----- Method: MCClassInstanceVariableDefinition class>>type (in category 'accessing') ----- - ----- Method: MCClassInstanceVariableDefinition class>>type (in category 'as yet unclassified') ----- type ^ #classInstance! Item was changed: + ----- Method: MCClassTraitParser class>>pattern (in category 'constants') ----- - ----- Method: MCClassTraitParser class>>pattern (in category 'as yet unclassified') ----- pattern ^ '*classTrait*uses:*'! Item was changed: + ----- Method: MCClassVariableDefinition class>>type (in category 'accessing') ----- - ----- Method: MCClassVariableDefinition class>>type (in category 'as yet unclassified') ----- type ^ #class! Item was changed: + ----- Method: MCConflict class>>operation: (in category 'instance creation') ----- - ----- Method: MCConflict class>>operation: (in category 'as yet unclassified') ----- operation: anOperation ^ self new operation: anOperation ! Item was changed: + ----- Method: MCConflict>>annotations (in category 'accessing') ----- - ----- Method: MCConflict>>annotations (in category 'as yet unclassified') ----- annotations ^operation ifNotNil: [ :op | op annotations ]! Item was changed: + ----- Method: MCConflict>>applyTo: (in category 'applying') ----- - ----- Method: MCConflict>>applyTo: (in category 'as yet unclassified') ----- applyTo: anObject self isResolved ifFalse: [self error: 'Cannot continue until this conflict has been resolved']. self remoteChosen ifTrue: [operation applyTo: anObject].! Item was changed: + ----- Method: MCConflict>>chooseLocal (in category 'resolving ') ----- - ----- Method: MCConflict>>chooseLocal (in category 'as yet unclassified') ----- chooseLocal chooseRemote := false! Item was changed: + ----- Method: MCConflict>>chooseNewer (in category 'resolving ') ----- - ----- Method: MCConflict>>chooseNewer (in category 'as yet unclassified') ----- chooseNewer self isLocalNewer ifTrue: [ self chooseLocal ] ifFalse: [ self isRemoteNewer ifTrue: [ self chooseRemote ]]! Item was changed: + ----- Method: MCConflict>>chooseOlder (in category 'resolving ') ----- - ----- Method: MCConflict>>chooseOlder (in category 'as yet unclassified') ----- chooseOlder self isRemoteNewer ifTrue: [ self chooseLocal ] ifFalse: [ self isLocalNewer ifTrue: [ self chooseRemote ]]! Item was changed: + ----- Method: MCConflict>>chooseRemote (in category 'resolving ') ----- - ----- Method: MCConflict>>chooseRemote (in category 'as yet unclassified') ----- chooseRemote chooseRemote := true! Item was changed: + ----- Method: MCConflict>>chooseSameAST (in category 'resolving ') ----- - ----- Method: MCConflict>>chooseSameAST (in category 'as yet unclassified') ----- chooseSameAST | fromSrc toSrc | (self definition isNil or: [self definition isMethodDefinition not]) ifTrue: [^ self]. fromSrc := (Parser new parse: operation fromSource class: nil class) generate decompile asString. toSrc := (Parser new parse: operation toSource class: nil class) generate decompile asString. fromSrc = toSrc ifTrue: [self chooseLocal].! Item was changed: + ----- Method: MCConflict>>clearChoice (in category 'resolving ') ----- - ----- Method: MCConflict>>clearChoice (in category 'as yet unclassified') ----- clearChoice chooseRemote := nil! Item was changed: + ----- Method: MCConflict>>definition (in category 'accessing') ----- - ----- Method: MCConflict>>definition (in category 'as yet unclassified') ----- definition ^operation ifNotNil: [ :op | op definition ]! Item was changed: + ----- Method: MCConflict>>isConflict (in category 'testing') ----- - ----- Method: MCConflict>>isConflict (in category 'as yet unclassified') ----- isConflict ^true! Item was changed: + ----- Method: MCConflict>>isLocalNewer (in category 'testing') ----- - ----- Method: MCConflict>>isLocalNewer (in category 'as yet unclassified') ----- isLocalNewer ^ self localDefinition fullTimeStamp > self remoteDefinition fullTimeStamp! Item was changed: + ----- Method: MCConflict>>isRemoteNewer (in category 'testing') ----- - ----- Method: MCConflict>>isRemoteNewer (in category 'as yet unclassified') ----- isRemoteNewer ^ self localDefinition fullTimeStamp < self remoteDefinition fullTimeStamp! Item was changed: + ----- Method: MCConflict>>isResolved (in category 'testing') ----- - ----- Method: MCConflict>>isResolved (in category 'as yet unclassified') ----- isResolved ^ chooseRemote notNil! Item was changed: + ----- Method: MCConflict>>localChosen (in category 'testing') ----- - ----- Method: MCConflict>>localChosen (in category 'as yet unclassified') ----- localChosen ^ chooseRemote notNil and: [chooseRemote not]! Item was changed: + ----- Method: MCConflict>>localDefinition (in category 'accessing') ----- - ----- Method: MCConflict>>localDefinition (in category 'as yet unclassified') ----- localDefinition ^ operation baseDefinition! Item was changed: + ----- Method: MCConflict>>operation (in category 'accessing') ----- - ----- Method: MCConflict>>operation (in category 'as yet unclassified') ----- operation ^ operation! Item was changed: + ----- Method: MCConflict>>operation: (in category 'accessing') ----- - ----- Method: MCConflict>>operation: (in category 'as yet unclassified') ----- operation: anOperation operation := anOperation! Item was changed: + ----- Method: MCConflict>>remoteChosen (in category 'testing') ----- - ----- Method: MCConflict>>remoteChosen (in category 'as yet unclassified') ----- remoteChosen ^ chooseRemote notNil and: [chooseRemote]! Item was changed: + ----- Method: MCConflict>>remoteDefinition (in category 'testing') ----- - ----- Method: MCConflict>>remoteDefinition (in category 'as yet unclassified') ----- remoteDefinition ^ operation targetDefinition! Item was changed: + ----- Method: MCConflict>>source (in category 'accessing') ----- - ----- Method: MCConflict>>source (in category 'as yet unclassified') ----- source ^ self localChosen ifTrue: [operation fromSource] ifFalse: [operation source]! Item was changed: + ----- Method: MCConflict>>status (in category 'accessing') ----- - ----- Method: MCConflict>>status (in category 'as yet unclassified') ----- status ^ self isResolved ifFalse: [''] ifTrue: [self remoteChosen ifFalse: ['L'] ifTrue: ['R']]! Item was changed: + ----- Method: MCConflict>>summary (in category 'accessing') ----- - ----- 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: MCDependencySorter class>>items: (in category 'instance creation') ----- - ----- Method: MCDependencySorter class>>items: (in category 'as yet unclassified') ----- items: aCollection ^ self new addAll: aCollection! Item was changed: + ----- Method: MCDependencySorter class>>new (in category 'instance creation') ----- - ----- Method: MCDependencySorter class>>new (in category 'as yet unclassified') ----- new ^ self basicNew initialize! Item was changed: + ----- Method: MCDependencySorter class>>sortItems: (in category 'utility') ----- - ----- 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: MCDependentsWrapper>>asString (in category 'converting') ----- - ----- Method: MCDependentsWrapper>>asString (in category 'as yet unclassified') ----- asString ^item description! Item was changed: + ----- Method: MCDependentsWrapper>>contents (in category 'accessing') ----- - ----- Method: MCDependentsWrapper>>contents (in category 'as yet unclassified') ----- contents | list workingCopies | workingCopies := model unsortedWorkingCopies. list := item requiredPackages collect: [:each | workingCopies detect: [:wc | wc package = each] ifNone: [nil]] thenSelect: [:x | x notNil]. ^list collect: [:each | self class with: each model: model]! Item was changed: + ----- Method: MCDependentsWrapper>>hasContents (in category 'testing') ----- - ----- Method: MCDependentsWrapper>>hasContents (in category 'as yet unclassified') ----- hasContents ^item requiredPackages isEmpty not! Item was changed: + ----- Method: MCDependentsWrapper>>item (in category 'accessing') ----- - ----- Method: MCDependentsWrapper>>item (in category 'as yet unclassified') ----- item ^item! Item was changed: + ----- Method: MCDictionaryRepository>>= (in category 'testing') ----- - ----- Method: MCDictionaryRepository>>= (in category 'as yet unclassified') ----- = other ^ self == other! Item was changed: + ----- Method: MCDictionaryRepository>>allVersionInfos (in category 'accessing') ----- - ----- Method: MCDictionaryRepository>>allVersionInfos (in category 'as yet unclassified') ----- allVersionInfos ^ dict values collect: [:ea | ea info]! Item was changed: + ----- Method: MCDictionaryRepository>>basicStoreVersion: (in category 'private') ----- - ----- Method: MCDictionaryRepository>>basicStoreVersion: (in category 'as yet unclassified') ----- basicStoreVersion: aVersion dict at: aVersion info put: aVersion! Item was changed: + ----- Method: MCDictionaryRepository>>closestAncestorVersionFor:ifNone: (in category 'accessing') ----- - ----- Method: MCDictionaryRepository>>closestAncestorVersionFor:ifNone: (in category 'as yet unclassified') ----- closestAncestorVersionFor: anAncestry ifNone: errorBlock | info | info := anAncestry breadthFirstAncestors detect: [:ea | self includesVersionWithInfo: ea] ifNone: [^ errorBlock value]. ^ self versionWithInfo: info! Item was changed: + ----- Method: MCDictionaryRepository>>description (in category 'accessing') ----- - ----- Method: MCDictionaryRepository>>description (in category 'as yet unclassified') ----- description ^ description ifNil: ['cache']! Item was changed: + ----- Method: MCDictionaryRepository>>description: (in category 'accessing') ----- - ----- Method: MCDictionaryRepository>>description: (in category 'as yet unclassified') ----- description: aString description := aString ! Item was changed: + ----- Method: MCDictionaryRepository>>dictionary (in category 'accessing') ----- - ----- Method: MCDictionaryRepository>>dictionary (in category 'as yet unclassified') ----- dictionary ^ dict! Item was changed: + ----- Method: MCDictionaryRepository>>dictionary: (in category 'accessing') ----- - ----- Method: MCDictionaryRepository>>dictionary: (in category 'as yet unclassified') ----- dictionary: aDictionary dict := aDictionary! Item was changed: + ----- Method: MCDictionaryRepository>>includesVersionNamed: (in category 'versions') ----- - ----- Method: MCDictionaryRepository>>includesVersionNamed: (in category 'as yet unclassified') ----- includesVersionNamed: aString | mcVersionName | mcVersionName := aString asMCVersionName. ^ dict anySatisfy: [ : ea | ea info versionName = mcVersionName ]! Item was changed: + ----- Method: MCDictionaryRepository>>includesVersionWithInfo: (in category 'testing') ----- - ----- Method: MCDictionaryRepository>>includesVersionWithInfo: (in category 'as yet unclassified') ----- includesVersionWithInfo: aVersionInfo ^ dict includesKey: aVersionInfo! Item was changed: + ----- Method: MCDictionaryRepository>>initialize (in category 'initialize-release') ----- - ----- Method: MCDictionaryRepository>>initialize (in category 'as yet unclassified') ----- initialize dict := Dictionary new. ! Item was changed: + ----- Method: MCDictionaryRepository>>morphicOpen: (in category 'user interface') ----- - ----- Method: MCDictionaryRepository>>morphicOpen: (in category 'as yet unclassified') ----- morphicOpen: aWorkingCopy | names index infos | infos := self sortedVersionInfos. infos isEmpty ifTrue: [^ self inform: 'No versions']. names := infos collect: [:ea | ea name]. index := UIManager default chooseFrom: names title: 'Open version:'. index = 0 ifFalse: [(self versionWithInfo: (infos at: index)) open]! Item was changed: + ----- Method: MCDictionaryRepository>>sortedVersionInfos (in category 'accessing') ----- - ----- 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: MCDictionaryRepository>>versionWithInfo:ifAbsent: (in category 'versions') ----- - ----- Method: MCDictionaryRepository>>versionWithInfo:ifAbsent: (in category 'as yet unclassified') ----- versionWithInfo: aVersionInfo ifAbsent: errorBlock ^ dict at: aVersionInfo ifAbsent: errorBlock! Item was changed: + ----- Method: MCDiffyVersion>>baseInfo (in category 'accessing') ----- - ----- Method: MCDiffyVersion>>baseInfo (in category 'as yet unclassified') ----- baseInfo ^ base! Item was changed: + ----- Method: MCDiffyVersion>>baseSnapshot (in category 'accessing') ----- - ----- Method: MCDiffyVersion>>baseSnapshot (in category 'as yet unclassified') ----- baseSnapshot | baseVersion | baseVersion := self workingCopy repositoryGroup versionWithInfo: base. baseVersion ifNil: [Error signal: 'Missing snapshot: ', self baseInfo name]. ^ baseVersion snapshot! Item was changed: + ----- Method: MCDiffyVersion>>canOptimizeLoading (in category 'testing') ----- - ----- Method: MCDiffyVersion>>canOptimizeLoading (in category 'as yet unclassified') ----- canOptimizeLoading "Answer wether I can provide a patch for the working copy without the usual diff pass" ^ package hasWorkingCopy and: [package workingCopy modified not and: [package workingCopy ancestors includes: self baseInfo]]! Item was changed: + ----- Method: MCDiffyVersion>>fileName (in category 'accessing') ----- - ----- Method: MCDiffyVersion>>fileName (in category 'as yet unclassified') ----- fileName ^ ((self class nameForVer: info name base: base name) , '.' , self writerClass extension) asMCVersionName! Item was changed: + ----- Method: MCDiffyVersion>>fileOutOn: (in category 'actions') ----- - ----- Method: MCDiffyVersion>>fileOutOn: (in category 'as yet unclassified') ----- fileOutOn: aStream "The whole point of diffy versions is to not store the full snapshot, so ensure we don't." snapshot:=nil. super fileOutOn: aStream! Item was changed: + ----- Method: MCDiffyVersion>>initializeWithPackage:info:dependencies:baseInfo:patch: (in category 'initialize-release') ----- - ----- 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>>isDiffy (in category 'testing') ----- - ----- Method: MCDiffyVersion>>isDiffy (in category 'as yet unclassified') ----- isDiffy ^ true! Item was changed: + ----- Method: MCDiffyVersion>>patch (in category 'accessing') ----- - ----- Method: MCDiffyVersion>>patch (in category 'as yet unclassified') ----- patch ^ patch! Item was changed: + ----- Method: MCDiffyVersion>>snapshot (in category 'accessing') ----- - ----- Method: MCDiffyVersion>>snapshot (in category 'as yet unclassified') ----- snapshot ^ snapshot ifNil: [snapshot := MCPatcher apply: patch to: self baseSnapshot]! Item was changed: + ----- Method: MCDiffyVersion>>summary (in category 'accessing') ----- - ----- Method: MCDiffyVersion>>summary (in category 'as yet unclassified') ----- summary ^ '(Diff against ', self baseInfo name, ')', String cr, super summary! Item was changed: + ----- Method: MCDiffyVersion>>writerClass (in category 'accessing') ----- - ----- Method: MCDiffyVersion>>writerClass (in category 'as yet unclassified') ----- writerClass ^ MCMcdWriter ! Item was changed: + ----- Method: MCDirectoryRepository>>description (in category 'user interface') ----- - ----- Method: MCDirectoryRepository>>description (in category 'accessing') ----- description ^ directory pathName! Item was changed: + ----- Method: MCDirectoryRepository>>initialize (in category 'initialize-release') ----- - ----- Method: MCDirectoryRepository>>initialize (in category 'accessing') ----- initialize directory := FileDirectory default! Item was changed: + ----- Method: MCDirectoryRepository>>isValid (in category 'testing') ----- - ----- Method: MCDirectoryRepository>>isValid (in category 'accessing') ----- isValid ^directory exists! Item was changed: + ----- Method: MCDirectoryRepository>>readStreamForFileNamed:do: (in category 'private') ----- - ----- 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 'private') ----- - ----- 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 class>>concreteSubclasses (in category 'accessing class hierarchy') ----- - ----- Method: MCDoItParser class>>concreteSubclasses (in category 'as yet unclassified') ----- concreteSubclasses ^ self allSubclasses reject: [:c | c isAbstract]! Item was changed: + ----- Method: MCDoItParser class>>forDoit: (in category 'instance creation') ----- - ----- Method: MCDoItParser class>>forDoit: (in category 'as yet unclassified') ----- forDoit: aString ^ (self subclassForDoit: aString) ifNotNil: [:c | c new source: aString]! Item was changed: + ----- Method: MCDoItParser class>>isAbstract (in category 'testing') ----- - ----- Method: MCDoItParser class>>isAbstract (in category 'as yet unclassified') ----- isAbstract ^ self pattern isNil! Item was changed: + ----- Method: MCDoItParser class>>pattern (in category 'constants') ----- - ----- Method: MCDoItParser class>>pattern (in category 'as yet unclassified') ----- pattern ^ nil! Item was changed: + ----- Method: MCDoItParser class>>subclassForDoit: (in category 'private') ----- - ----- Method: MCDoItParser class>>subclassForDoit: (in category 'as yet unclassified') ----- subclassForDoit: aString ^ self concreteSubclasses detect: [:ea | ea pattern match: aString] ifNone: []! Item was changed: + ----- Method: MCDoItParser>>addDefinitionsTo: (in category 'evaluating') ----- - ----- Method: MCDoItParser>>addDefinitionsTo: (in category 'as yet unclassified') ----- addDefinitionsTo: aCollection self subclassResponsibility ! Item was changed: + ----- Method: MCDoItParser>>source (in category 'accessing') ----- - ----- Method: MCDoItParser>>source (in category 'as yet unclassified') ----- source ^ source! Item was changed: + ----- Method: MCDoItParser>>source: (in category 'accessing') ----- - ----- Method: MCDoItParser>>source: (in category 'as yet unclassified') ----- source: aString source := aString! Item was changed: + ----- Method: MCFileBasedRepository>>allPackageAndBranchNames (in category 'packages') ----- - ----- Method: MCFileBasedRepository>>allPackageAndBranchNames (in category 'overriding') ----- allPackageAndBranchNames ^ self validNames: #packageAndBranchName! Item was changed: + ----- Method: MCFileBasedRepository>>allPackageNames (in category 'packages') ----- - ----- Method: MCFileBasedRepository>>allPackageNames (in category 'overriding') ----- allPackageNames ^ self validNames: #packageName! Item was changed: + ----- Method: MCFileBasedRepository>>basicStoreVersion: (in category 'private') ----- - ----- Method: MCFileBasedRepository>>basicStoreVersion: (in category 'overriding') ----- basicStoreVersion: aMCVersionOrConfiguration self writeStreamForFileNamed: aMCVersionOrConfiguration fileName do: [ : s | aMCVersionOrConfiguration fileOutOn: s ]. aMCVersionOrConfiguration isCacheable ifTrue: [ cache ifNil: [ cache := Dictionary new ]. self resizeCache: cache. cache at: aMCVersionOrConfiguration fileName put: aMCVersionOrConfiguration ]! Item was changed: + ----- Method: MCFileBasedRepository>>closestAncestorVersionFor:ifNone: (in category 'accessing') ----- - ----- Method: MCFileBasedRepository>>closestAncestorVersionFor:ifNone: (in category 'overriding') ----- closestAncestorVersionFor: anAncestry ifNone: errorBlock ^ self cacheAllFileNamesDuring: [super closestAncestorVersionFor: anAncestry ifNone: errorBlock]! Item was changed: + ----- Method: MCFileBasedRepository>>morphicOpen: (in category 'user interface') ----- - ----- Method: MCFileBasedRepository>>morphicOpen: (in category 'overriding') ----- morphicOpen: aWorkingCopy (MCFileRepositoryInspector repository: self workingCopy: aWorkingCopy) show! Item was changed: + ----- Method: MCFileBasedRepository>>notifyList (in category 'notifying') ----- - ----- Method: MCFileBasedRepository>>notifyList (in category 'overriding') ----- notifyList (self allFileNames includes: 'notify') ifFalse: [^ #()]. ^ self readStreamForFileNamed: 'notify' do: [:s | s upToEnd lines]! Item was changed: + ----- Method: MCFileBasedRepository>>validNames: (in category 'private') ----- - ----- Method: MCFileBasedRepository>>validNames: (in category 'overriding') ----- validNames: selectorSymbol | answer | answer := Set new. self allFileNamesOrCache do: [ : each | | versionName | versionName := each asMCVersionName. versionName isValid ifTrue: [ answer add: (versionName perform: selectorSymbol) ] ]. ^ answer! Item was changed: + ----- Method: MCFilteredVersionSorter>>addVersionInfo: (in category 'accessing') ----- - ----- Method: MCFilteredVersionSorter>>addVersionInfo: (in category 'as yet unclassified') ----- addVersionInfo: aVersionInfo (aVersionInfo hasAncestor: target) ifTrue: [super addVersionInfo: aVersionInfo] ! Item was changed: + ----- Method: MCFilteredVersionSorter>>processVersionInfo: (in category 'private') ----- - ----- Method: MCFilteredVersionSorter>>processVersionInfo: (in category 'as yet unclassified') ----- processVersionInfo: aVersionInfo | success | aVersionInfo = target ifTrue: [^ true]. (aVersionInfo hasAncestor: target) ifFalse: [^false]. self pushLayer. success := (self knownAncestorsOf: aVersionInfo) anySatisfy: [:ea | self processVersionInfo: ea]. self popLayer. success ifTrue: [self addToCurrentLayer: aVersionInfo]. ^ success ! Item was changed: + ----- Method: MCFilteredVersionSorter>>target: (in category 'accessing') ----- - ----- Method: MCFilteredVersionSorter>>target: (in category 'as yet unclassified') ----- target: aVersionInfo target := aVersionInfo! Item was changed: + ----- Method: MCFtpRepository class>>creationTemplate (in category 'configuring') ----- - ----- Method: MCFtpRepository class>>creationTemplate (in category 'as yet unclassified') ----- creationTemplate ^ 'MCFtpRepository host: ''modules.squeakfoundation.org'' directory: ''mc'' user: ''squeak'' password: ''squeak''' ! Item was changed: + ----- Method: MCFtpRepository class>>description (in category 'configuring') ----- - ----- Method: MCFtpRepository class>>description (in category 'as yet unclassified') ----- description ^ 'FTP'! Item was changed: + ----- Method: MCFtpRepository class>>fillInTheBlankRequest (in category 'configuring') ----- - ----- Method: MCFtpRepository class>>fillInTheBlankRequest (in category 'as yet unclassified') ----- fillInTheBlankRequest ^ 'FTP Repository:' ! Item was changed: + ----- Method: MCFtpRepository class>>host:directory:user:password: (in category 'instance creation') ----- - ----- Method: MCFtpRepository class>>host:directory:user:password: (in category 'as yet unclassified') ----- host: host directory: directory user: user password: password ^ self new host: host; directory: directory; user: user; password: password! Item was changed: + ----- Method: MCFtpRepository class>>morphicConfigure (in category 'configuring') ----- - ----- Method: MCFtpRepository class>>morphicConfigure (in category 'as yet unclassified') ----- morphicConfigure ^ self fillInTheBlankConfigure! Item was changed: + ----- Method: MCFtpRepository class>>templateCreationSelector (in category 'constants') ----- - ----- Method: MCFtpRepository class>>templateCreationSelector (in category 'as yet unclassified') ----- templateCreationSelector ^ #host:directory:user:password: ! Item was changed: + ----- Method: MCFtpRepository>>clientDo: (in category 'private') ----- - ----- 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 'accessing') ----- - ----- Method: MCFtpRepository>>directory: (in category 'as yet unclassified') ----- directory: dirPath directory := dirPath! Item was changed: + ----- Method: MCFtpRepository>>host: (in category 'accessing') ----- - ----- Method: MCFtpRepository>>host: (in category 'as yet unclassified') ----- host: hostname host := hostname! Item was changed: + ----- Method: MCFtpRepository>>parseDirectoryListing: (in category 'protocol handling') ----- - ----- Method: MCFtpRepository>>parseDirectoryListing: (in category 'as yet unclassified') ----- parseDirectoryListing: aString | stream files line tokens | stream := aString readStream. files := OrderedCollection new. [stream atEnd] whileFalse: [line := stream nextLine. tokens := line findTokens: ' '. tokens size > 2 ifTrue: [files add: tokens last asMCVersionName]]. ^ files! Item was changed: + ----- Method: MCFtpRepository>>password: (in category 'accessing') ----- - ----- Method: MCFtpRepository>>password: (in category 'as yet unclassified') ----- password: passwordString password := passwordString! Item was changed: + ----- Method: MCFtpRepository>>user: (in category 'accessing') ----- - ----- Method: MCFtpRepository>>user: (in category 'as yet unclassified') ----- user: userString user := userString! Item was changed: + ----- Method: MCGOODSRepository class>>creationTemplate (in category 'configuring') ----- - ----- Method: MCGOODSRepository class>>creationTemplate (in category 'as yet unclassified') ----- creationTemplate ^ 'MCGOODSRepository host: ''localhost'' port: 6100'! Item was changed: + ----- Method: MCGOODSRepository class>>description (in category 'configuring') ----- - ----- Method: MCGOODSRepository class>>description (in category 'as yet unclassified') ----- description ^ 'GOODS'! Item was changed: + ----- Method: MCGOODSRepository class>>fillInTheBlankRequest (in category 'configuring') ----- - ----- Method: MCGOODSRepository class>>fillInTheBlankRequest (in category 'as yet unclassified') ----- fillInTheBlankRequest ^ 'GOODS Repository:'! Item was changed: + ----- Method: MCGOODSRepository class>>host:port: (in category 'instance creation') ----- - ----- Method: MCGOODSRepository class>>host:port: (in category 'as yet unclassified') ----- host: hostname port: portNumber ^ self new host: hostname; port: portNumber! Item was changed: + ----- Method: MCGOODSRepository class>>morphicConfigure (in category 'configuring') ----- - ----- Method: MCGOODSRepository class>>morphicConfigure (in category 'as yet unclassified') ----- morphicConfigure ^ self fillInTheBlankConfigure! Item was changed: + ----- Method: MCGOODSRepository>>basicStoreVersion: (in category 'private') ----- - ----- Method: MCGOODSRepository>>basicStoreVersion: (in category 'as yet unclassified') ----- basicStoreVersion: aVersion self root at: aVersion info put: aVersion. self db commit.! Item was changed: + ----- Method: MCGOODSRepository>>db (in category 'private') ----- - ----- Method: MCGOODSRepository>>db (in category 'as yet unclassified') ----- db (connection isNil or: [connection isConnected not]) ifTrue: [ connection := Smalltalk at: #KKDatabase ifPresent: [:cl | cl onHost:hostname port: port ] ]. ^ connection! Item was changed: + ----- Method: MCGOODSRepository>>description (in category 'user interface') ----- - ----- Method: MCGOODSRepository>>description (in category 'as yet unclassified') ----- description ^ 'goods://', hostname asString, ':', port asString! Item was changed: + ----- Method: MCGOODSRepository>>host: (in category 'accessing') ----- - ----- Method: MCGOODSRepository>>host: (in category 'as yet unclassified') ----- host: aString hostname := aString! Item was changed: + ----- Method: MCGOODSRepository>>includesVersionNamed: (in category 'versions') ----- - ----- Method: MCGOODSRepository>>includesVersionNamed: (in category 'as yet unclassified') ----- includesVersionNamed: aString ^ (self versionNamed: aString) notNil! Item was changed: + ----- Method: MCGOODSRepository>>port: (in category 'accessing') ----- - ----- Method: MCGOODSRepository>>port: (in category 'as yet unclassified') ----- port: aNumber port := aNumber! Item was changed: + ----- Method: MCGOODSRepository>>root (in category 'accessing') ----- - ----- Method: MCGOODSRepository>>root (in category 'as yet unclassified') ----- root self db root ifNil: [self db root: Dictionary new]. ^ self db root! Item was changed: + ----- Method: MCGOODSRepository>>versionNamed: (in category 'versions') ----- - ----- Method: MCGOODSRepository>>versionNamed: (in category 'as yet unclassified') ----- versionNamed: aString | versionName | versionName := aString asMCVersionName. self root keysDo: [ : each | each versionName = versionName ifTrue: [ ^ each ] ]. ^ nil! Item was changed: + ----- Method: MCGOODSRepository>>versionNamesForPackageNamed: (in category 'versions') ----- - ----- Method: MCGOODSRepository>>versionNamesForPackageNamed: (in category 'as yet unclassified') ----- versionNamesForPackageNamed: aString ^ Array streamContents: [ : stream | self root keysDo: [ : each | each versionName packageName = aString ifTrue: [ stream nextPut: each ] ] ]! Item was changed: + ----- Method: MCGOODSRepository>>versionWithInfo:ifAbsent: (in category 'versions') ----- - ----- Method: MCGOODSRepository>>versionWithInfo:ifAbsent: (in category 'as yet unclassified') ----- versionWithInfo: aVersionInfo ifAbsent: errorBlock ^ self root at: aVersionInfo ifAbsent: errorBlock! Item was changed: + ----- Method: MCHttpRepository>>allFileNames (in category 'private-files') ----- - ----- Method: MCHttpRepository>>allFileNames (in category 'overriding') ----- allFileNames | index | index := self displayProgress: 'Updating ', self description during: [ self httpGet: self locationWithTrailingSlash, '?C=M;O=D' arguments: nil ]. ^index ifNotNil: [ self parseFileNamesFromStream: index ]! Item was changed: + ----- Method: MCHttpRepository>>asCreationTemplate (in category 'accessing') ----- - ----- Method: MCHttpRepository>>asCreationTemplate (in category 'overriding') ----- asCreationTemplate ^self class creationTemplateLocation: location user: user password: password! Item was changed: + ----- Method: MCHttpRepository>>description (in category 'user interface') ----- - ----- Method: MCHttpRepository>>description (in category 'overriding') ----- description ^ location! Item was changed: + ----- Method: MCHttpRepository>>flushCache (in category 'private') ----- - ----- Method: MCHttpRepository>>flushCache (in category 'overriding') ----- flushCache super flushCache. readerCache := nil.! Item was changed: + ----- Method: MCHttpRepository>>mcModel (in category '*monticello') ----- - ----- Method: MCHttpRepository>>mcModel (in category 'overriding') ----- mcModel "Answer the object which can respond to #historyOf: and #originOf: or nil, if none." ^ self isIndexed ifTrue: [self]! Item was changed: + ----- Method: MCHttpRepository>>refresh (in category 'accessing') ----- - ----- Method: MCHttpRepository>>refresh (in category 'overriding') ----- refresh super refresh. indexed := nil! Item was changed: + ----- Method: MCInfoProxy class>>info:workingCopy:repository: (in category 'instance creation') ----- - ----- Method: MCInfoProxy class>>info:workingCopy:repository: (in category 'create') ----- info: aMCVersionInfo workingCopy: aMCWorkingCopy repository: aMCRepository ^ self new setInfo: aMCVersionInfo workingCopy: aMCWorkingCopy repository: aMCRepository! Item was changed: + ----- Method: MCInstanceVariableDefinition class>>type (in category 'accessing') ----- - ----- Method: MCInstanceVariableDefinition class>>type (in category 'as yet unclassified') ----- type ^ #instance! Item was changed: + ----- Method: MCMcdReader class>>extension (in category 'accessing') ----- - ----- Method: MCMcdReader class>>extension (in category 'as yet unclassified') ----- extension ^ 'mcd'! Item was changed: + ----- Method: MCMcdReader>>baseInfo (in category 'accessing') ----- - ----- Method: MCMcdReader>>baseInfo (in category 'as yet unclassified') ----- baseInfo ^ baseInfo ifNil: [self loadBaseInfo]! Item was changed: + ----- Method: MCMcdReader>>basicVersion (in category 'accessing') ----- - ----- Method: MCMcdReader>>basicVersion (in category 'as yet unclassified') ----- basicVersion ^ MCDiffyVersion package: self package info: self info dependencies: self dependencies baseInfo: self baseInfo patch: self patch! Item was changed: + ----- Method: MCMcdReader>>buildPatchFrom:to: (in category 'private-loading') ----- - ----- Method: MCMcdReader>>buildPatchFrom:to: (in category 'as yet unclassified') ----- buildPatchFrom: oldDefinitions to: newDefinitions ^ MCPatch fromBase: (MCSnapshot fromDefinitions: oldDefinitions) target: (MCSnapshot fromDefinitions: newDefinitions)! Item was changed: + ----- Method: MCMcdReader>>loadBaseInfo (in category 'loading') ----- - ----- Method: MCMcdReader>>loadBaseInfo (in category 'as yet unclassified') ----- loadBaseInfo ^ baseInfo := self extractInfoFrom: (self parseMember: 'base')! Item was changed: + ----- Method: MCMcdReader>>loadPatch (in category 'loading') ----- - ----- Method: MCMcdReader>>loadPatch (in category 'as yet unclassified') ----- loadPatch | old new | (self zip memberNamed: 'patch.bin') ifNotNil: [:m | [^ patch := (DataStream on: m contentStream) next ] on: Error do: [:fallThrough ]]. definitions := OrderedCollection new. (self zip membersMatching: 'old/*') do: [:m | self extractDefinitionsFrom: m]. old := definitions asArray. definitions := OrderedCollection new. (self zip membersMatching: 'new/*') do: [:m | self extractDefinitionsFrom: m]. new := definitions asArray. ^ patch := self buildPatchFrom: old to: new. ! Item was changed: + ----- Method: MCMcdReader>>patch (in category 'accessing') ----- - ----- Method: MCMcdReader>>patch (in category 'as yet unclassified') ----- patch ^ patch ifNil: [self loadPatch]! Item was changed: + ----- Method: MCMcdWriter class>>readerClass (in category 'accessing') ----- - ----- Method: MCMcdWriter class>>readerClass (in category 'as yet unclassified') ----- readerClass ^ MCMcdReader! Item was changed: + ----- Method: MCMczReader>>associate: (in category 'utilities') ----- - ----- Method: MCMczReader>>associate: (in category 'as yet unclassified') ----- associate: tokens | result | result := Dictionary new. tokens pairsDo: [:key :value | result at: key put: (value isString ifTrue: [value] ifFalse: [value collect: [:ea | self associate: ea]])]. ^ result! Item was changed: + ----- Method: MCMczReader>>extractDefinitionsFrom: (in category 'private-loading') ----- - ----- Method: MCMczReader>>extractDefinitionsFrom: (in category 'as yet unclassified') ----- extractDefinitionsFrom: member | reader | (MCSnapshotReader readerClassForFileNamed: member fileName) ifNotNil: [:rc | reader := rc on: (self contentsForMember: member) readStream. definitions addAll: reader definitions] ! Item was changed: + ----- Method: MCMczReader>>extractDependencyFrom: (in category 'private-loading') ----- - ----- Method: MCMczReader>>extractDependencyFrom: (in category 'as yet unclassified') ----- extractDependencyFrom: zipMember ^ MCVersionDependency package: (MCPackage named: (zipMember fileName copyAfterLast: $/)) info: (self extractInfoFrom: (self parseMember: zipMember))! Item was changed: + ----- Method: MCMczReader>>extractInfoFrom: (in category 'private-loading') ----- - ----- Method: MCMczReader>>extractInfoFrom: (in category 'as yet unclassified') ----- extractInfoFrom: dict ^MCWorkingCopy infoFromDictionary: dict cache: self infoCache! Item was changed: + ----- Method: MCMczReader>>infoCache (in category 'accessing') ----- - ----- Method: MCMczReader>>infoCache (in category 'as yet unclassified') ----- infoCache ^ infoCache ifNil: [infoCache := Dictionary new]! Item was changed: + ----- Method: MCMczReader>>parseMember: (in category 'utilities') ----- - ----- Method: MCMczReader>>parseMember: (in category 'as yet unclassified') ----- parseMember: memberOrName | member contents tokens | member := self zip member: memberOrName. contents := self contentsForMember: member. tokens := (self scanner scanTokens: contents) first. ^ self associate: tokens! Item was changed: + ----- Method: MCMczReader>>scanner (in category 'constants') ----- - ----- Method: MCMczReader>>scanner (in category 'as yet unclassified') ----- scanner ^ MCScanner! Item was changed: + ----- Method: MCMczReader>>zip (in category 'accessing') ----- - ----- 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 'fileIn/out') ----- - ----- 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 class>>new (in category 'instance creation') ----- - ----- Method: MCMczWriter class>>new (in category 'as yet unclassified') ----- new ^ self basicNew initialize! Item was changed: + ----- Method: MCMczWriter class>>readerClass (in category 'accessing') ----- - ----- Method: MCMczWriter class>>readerClass (in category 'as yet unclassified') ----- readerClass ^ MCMczReader! Item was changed: + ----- Method: MCMergeBrowser class>>resolveConflictsInMerger: (in category 'instance creation') ----- - ----- 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: MCMergeBrowser>>buttonSpecs (in category 'ui') ----- - ----- Method: MCMergeBrowser>>buttonSpecs (in category 'as yet unclassified') ----- buttonSpecs ^ #((Merge merge 'Proceed with the merge' canMerge) (Cancel cancel 'Cancel the merge') ('All Newer' chooseAllNewerConflicts 'Choose all newer conflict versions') ('All Older' chooseAllOlderConflicts 'Choose all older conflict versions') ('Rest Reject' chooseAllUnchosenLocal 'Choose local versions of all remaining conflicts') ('Rest Accept' chooseAllUnchosenRemote 'Choose remote versions of all remaining conflicts') ('Accept same source' chooseAllSameAST 'Choose all local conflicting versions that have essentially the same code') )! Item was changed: + ----- Method: MCMergeBrowser>>canMerge (in category 'testing') ----- - ----- Method: MCMergeBrowser>>canMerge (in category 'as yet unclassified') ----- canMerge ^ merger isMerged! Item was changed: + ----- Method: MCMergeBrowser>>cancel (in category 'actions') ----- - ----- Method: MCMergeBrowser>>cancel (in category 'as yet unclassified') ----- cancel self answer: false! Item was changed: + ----- Method: MCMergeBrowser>>chooseAllNewerConflicts (in category 'actions') ----- - ----- Method: MCMergeBrowser>>chooseAllNewerConflicts (in category 'as yet unclassified') ----- chooseAllNewerConflicts conflicts do: [ :ea | ea chooseNewer ]. self changed: #text; changed: #list; changed: #canMerge.! Item was changed: + ----- Method: MCMergeBrowser>>chooseAllOlderConflicts (in category 'actions') ----- - ----- Method: MCMergeBrowser>>chooseAllOlderConflicts (in category 'as yet unclassified') ----- chooseAllOlderConflicts conflicts do: [ :ea | ea chooseOlder ]. self changed: #text; changed: #list; changed: #canMerge.! Item was changed: + ----- Method: MCMergeBrowser>>chooseAllSameAST (in category 'actions') ----- - ----- Method: MCMergeBrowser>>chooseAllSameAST (in category 'as yet unclassified') ----- chooseAllSameAST conflicts do: [ :ea | ea chooseSameAST ]. self changed: #text; changed: #list; changed: #canMerge.! Item was changed: + ----- Method: MCMergeBrowser>>chooseAllUnchosenLocal (in category 'actions') ----- - ----- Method: MCMergeBrowser>>chooseAllUnchosenLocal (in category 'as yet unclassified') ----- chooseAllUnchosenLocal conflicts do: [ :ea | ea isResolved ifFalse: [ ea chooseLocal ] ]. self changed: #text; changed: #list; changed: #canMerge.! Item was changed: + ----- Method: MCMergeBrowser>>chooseAllUnchosenRemote (in category 'actions') ----- - ----- Method: MCMergeBrowser>>chooseAllUnchosenRemote (in category 'as yet unclassified') ----- chooseAllUnchosenRemote conflicts do: [ :ea | ea isResolved ifFalse: [ ea chooseRemote ] ]. self changed: #text; changed: #list; changed: #canMerge.! Item was changed: + ----- Method: MCMergeBrowser>>chooseLocal (in category 'actions') ----- - ----- Method: MCMergeBrowser>>chooseLocal (in category 'as yet unclassified') ----- chooseLocal self conflictSelectionDo: [selection chooseLocal. self changed: #text; changed: #list; changed: #canMerge]. self selectNextUnresolvedConflict! Item was changed: + ----- Method: MCMergeBrowser>>chooseRemote (in category 'actions') ----- - ----- Method: MCMergeBrowser>>chooseRemote (in category 'as yet unclassified') ----- chooseRemote self conflictSelectionDo: [selection chooseRemote. self changed: #text; changed: #list; changed: #canMerge]. self selectNextUnresolvedConflict! Item was changed: + ----- Method: MCMergeBrowser>>clearChoice (in category 'actions') ----- - ----- Method: MCMergeBrowser>>clearChoice (in category 'as yet unclassified') ----- clearChoice self conflictSelectionDo: [selection clearChoice. self changed: #text; changed: #list; changed: #canMerge]! Item was changed: + ----- Method: MCMergeBrowser>>conflictSelectionDo: (in category 'private-actions') ----- - ----- Method: MCMergeBrowser>>conflictSelectionDo: (in category 'as yet unclassified') ----- conflictSelectionDo: aBlock self selectionIsConflicted ifTrue: aBlock! Item was changed: + ----- Method: MCMergeBrowser>>defaultLabel (in category 'ui') ----- - ----- Method: MCMergeBrowser>>defaultLabel (in category 'as yet unclassified') ----- defaultLabel ^ 'Merge Browser'! Item was changed: + ----- Method: MCMergeBrowser>>getConflictMenu: (in category 'menus') ----- - ----- Method: MCMergeBrowser>>getConflictMenu: (in category 'as yet unclassified') ----- getConflictMenu: aMenu selection remoteChosen ifTrue: [aMenu add: 'undo keep change' target: self selector: #clearChoice] ifFalse: [aMenu add: 'keep change' target: self selector: #chooseRemote]. selection localChosen ifTrue: [aMenu add: 'undo reject change' target: self selector: #clearChoice] ifFalse: [aMenu add: 'reject change' target: self selector: #chooseLocal]. ^ aMenu! Item was changed: + ----- Method: MCMergeBrowser>>getMenu: (in category 'morphic ui') ----- - ----- Method: MCMergeBrowser>>getMenu: (in category 'as yet unclassified') ----- getMenu: aMenu selection ifNil: [^ aMenu]. ^ self selectionIsConflicted ifTrue: [self getConflictMenu: aMenu] ifFalse: [self getOperationMenu: aMenu]! Item was changed: + ----- Method: MCMergeBrowser>>getOperationMenu: (in category 'menus') ----- - ----- Method: MCMergeBrowser>>getOperationMenu: (in category 'as yet unclassified') ----- getOperationMenu: aMenu ^ aMenu! Item was changed: + ----- Method: MCMergeBrowser>>innerButtonRow (in category 'private-ui') ----- - ----- Method: MCMergeBrowser>>innerButtonRow (in category 'as yet unclassified') ----- innerButtonRow ^ self buttonRow: self innerButtonSpecs! Item was changed: + ----- Method: MCMergeBrowser>>innerButtonSpecs (in category 'private-ui') ----- - ----- Method: MCMergeBrowser>>innerButtonSpecs (in category 'as yet unclassified') ----- innerButtonSpecs ^ #((Accept chooseRemote 'Accept the selected incoming change. Overwrites local code.' ) (Reject chooseLocal 'Reject the selected incoming change. Retains local code.' ))! Item was changed: + ----- Method: MCMergeBrowser>>items (in category 'accessing') ----- - ----- Method: MCMergeBrowser>>items (in category 'as yet unclassified') ----- items ^ conflicts, super items! Item was changed: + ----- Method: MCMergeBrowser>>merge (in category 'actions') ----- - ----- Method: MCMergeBrowser>>merge (in category 'as yet unclassified') ----- merge merger isMerged ifFalse: [self inform: 'You must resolve all the conflicts first'] ifTrue: [self answer: true] ! Item was changed: + ----- Method: MCMergeBrowser>>merger: (in category 'accessing') ----- - ----- Method: MCMergeBrowser>>merger: (in category 'as yet unclassified') ----- merger: aMerger merger := aMerger. items := aMerger operations sorted. conflicts := aMerger conflicts sort: [:a :b | a operation <= b operation].! Item was changed: + ----- Method: MCMergeBrowser>>methodListKey:from: (in category 'menus') ----- - ----- Method: MCMergeBrowser>>methodListKey:from: (in category 'as yet unclassified') ----- methodListKey: aKeystroke from: aListMorph aKeystroke caseOf: { [$k] -> [self chooseRemote]. [$r] -> [self chooseLocal]} otherwise: [super methodListKey: aKeystroke from: aListMorph ]! Item was changed: + ----- Method: MCMergeBrowser>>selectNextUnresolvedConflict (in category 'actions') ----- - ----- Method: MCMergeBrowser>>selectNextUnresolvedConflict (in category 'as yet unclassified') ----- selectNextUnresolvedConflict "Try and select the next unresolved conflict starting at current selection in the list, wrapping at beginning. If there is no more unresolved conflict, then simply move to next non conflict item in the list. This method makes assumption that conflicts are always sorted before non conflicts items." (self findListMorph: #list) ifNotNil: [:aMorph | | currentIndex nextUnresolvedIndex | currentIndex := aMorph getCurrentSelectionIndex min: conflicts size. nextUnresolvedIndex := (currentIndex + 1 to: currentIndex + conflicts size - 1) detect: [:i | | nextItem | ((nextItem := conflicts atWrap: i) isKindOf: MCConflict) and: [nextItem isResolved not]] ifNone: [0]. nextUnresolvedIndex = 0 ifTrue: [items size > 1 ifTrue: [self selection: (aMorph getCurrentSelectionIndex max: conflicts size) - conflicts size \\ items size + conflicts size + 1]] ifFalse: [self selection: nextUnresolvedIndex - 1 \\ conflicts size + 1].].! Item was changed: + ----- Method: MCMergeBrowser>>selectionIsConflicted (in category 'testing') ----- - ----- Method: MCMergeBrowser>>selectionIsConflicted (in category 'as yet unclassified') ----- selectionIsConflicted ^ selection isKindOf: MCConflict! Item was changed: + ----- Method: MCMergeBrowser>>widgetSpecs (in category 'ui') ----- - ----- Method: MCMergeBrowser>>widgetSpecs (in category 'as yet unclassified') ----- widgetSpecs Preferences annotationPanes ifFalse: [ ^#( ((buttonRow) (0 0 1 0) (0 0 0 defaultButtonPaneHeight)) ((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 defaultButtonPaneHeight 0 0)) ((innerButtonRow) (0 0.4 1 0.4) (0 0 0 defaultButtonPaneHeight)) ((textMorph: text) (0 0.4 1 1) (0 defaultButtonPaneHeight 0 0)) )]. ^ { #((buttonRow) (0 0 1 0) (0 0 0 defaultButtonPaneHeight)). #((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 defaultButtonPaneHeight 0 0)). #((innerButtonRow) (0 0.4 1 0.4) (0 0 0 defaultButtonPaneHeight)). { #(textMorph: annotations). #(0 0.4 1 0.4). { 0. self defaultButtonPaneHeight. 0. self defaultButtonPaneHeight+self defaultAnnotationPaneHeight. }}. { #(textMorph: text). #(0 0.4 1 1). { 0. self defaultButtonPaneHeight+self defaultAnnotationPaneHeight. 0. 0.}} }! Item was changed: + ----- Method: MCMergeRecord class>>version: (in category 'instance creation') ----- - ----- Method: MCMergeRecord class>>version: (in category 'as yet unclassified') ----- version: aVersion ^ self basicNew initializeWithVersion: aVersion! Item was changed: + ----- Method: MCMergeRecord>>ancestorInfo (in category 'accessing') ----- - ----- 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 'accessing') ----- - ----- Method: MCMergeRecord>>ancestorSnapshot (in category 'as yet unclassified') ----- ancestorSnapshot ^ ancestorSnapshot ifNil: [ancestorSnapshot := version workingCopy findSnapshotWithVersionInfo: self ancestorInfo]! Item was changed: + ----- Method: MCMergeRecord>>imageIsClean (in category 'testing') ----- - ----- Method: MCMergeRecord>>imageIsClean (in category 'as yet unclassified') ----- imageIsClean | ancestors | ancestors := version workingCopy ancestors. ^ ancestors size = 1 and: [ancestors first = self ancestorInfo and: [self imagePatch isEmpty]]! Item was changed: + ----- Method: MCMergeRecord>>imagePatch (in category 'accessing') ----- - ----- 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 'initialize-release') ----- - ----- Method: MCMergeRecord>>initializeWithVersion: (in category 'as yet unclassified') ----- initializeWithVersion: aVersion version := aVersion! Item was changed: + ----- Method: MCMergeRecord>>isAncestorMerge (in category 'testing') ----- - ----- Method: MCMergeRecord>>isAncestorMerge (in category 'as yet unclassified') ----- isAncestorMerge ^ version workingCopy ancestry hasAncestor: version info! Item was changed: + ----- Method: MCMergeRecord>>mergePatch (in category 'accessing') ----- - ----- 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 'accessing') ----- - ----- Method: MCMergeRecord>>packageSnapshot (in category 'as yet unclassified') ----- packageSnapshot ^ packageSnapshot ifNil: [packageSnapshot := version package snapshot]! Item was changed: + ----- Method: MCMergeRecord>>updateWorkingCopy (in category 'operations') ----- - ----- Method: MCMergeRecord>>updateWorkingCopy (in category 'as yet unclassified') ----- updateWorkingCopy self isAncestorMerge ifFalse: [self imageIsClean ifTrue: [version workingCopy loaded: version] ifFalse: [version workingCopy merged: version]]! Item was changed: + ----- Method: MCMergeRecord>>version (in category 'accessing') ----- - ----- Method: MCMergeRecord>>version (in category 'as yet unclassified') ----- version ^ version! Item was changed: + ----- Method: MCMerger>>addConflictWithOperation: (in category 'accessing') ----- - ----- Method: MCMerger>>addConflictWithOperation: (in category 'as yet unclassified') ----- addConflictWithOperation: anOperation self conflicts add: (MCConflict operation: anOperation)! Item was changed: + ----- Method: MCMerger>>applyTo: (in category 'applying') ----- - ----- Method: MCMerger>>applyTo: (in category 'as yet unclassified') ----- applyTo: anObject self isMerged ifFalse: [self error: 'You must resolve all the conflicts first']. conflicts do: [:ea | ea applyTo: anObject]! Item was changed: + ----- Method: MCMerger>>conflicts (in category 'accessing') ----- - ----- Method: MCMerger>>conflicts (in category 'as yet unclassified') ----- conflicts ^ conflicts ifNil: [conflicts := OrderedCollection new]! Item was changed: + ----- Method: MCMerger>>isMerged (in category 'testing') ----- - ----- Method: MCMerger>>isMerged (in category 'as yet unclassified') ----- isMerged ^ self conflicts allSatisfy: [:ea | ea isResolved]! Item was changed: + ----- Method: MCMerger>>load (in category 'loading') ----- - ----- 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: MCMerger>>loadWithNameLike: (in category 'loading') ----- - ----- Method: MCMerger>>loadWithNameLike: (in category 'as yet unclassified') ----- loadWithNameLike: baseName | loader | loader := MCPackageLoader new. loader provisions addAll: self provisions. self applyTo: loader. loader loadWithNameLike: baseName! Item was changed: + ----- Method: MCMerger>>mergedSnapshot (in category 'accessing') ----- - ----- Method: MCMerger>>mergedSnapshot (in category 'as yet unclassified') ----- mergedSnapshot ^ MCPatcher apply: self to: self baseSnapshot! Item was changed: + ----- Method: MCMerger>>operations (in category 'accessing') ----- - ----- Method: MCMerger>>operations (in category 'as yet unclassified') ----- operations ^ #()! Item was changed: + ----- Method: MCMerger>>provisions (in category 'accessing') ----- - ----- Method: MCMerger>>provisions (in category 'as yet unclassified') ----- provisions ^ #()! Item was changed: + ----- Method: MCModification class>>of:to: (in category 'instance creation') ----- - ----- Method: MCModification class>>of:to: (in category 'as yet unclassified') ----- of: base to: target ^ self new initializeWithBase: base target: target! Item was changed: + ----- Method: MCModification>>= (in category 'comparing') ----- - ----- Method: MCModification>>= (in category 'as yet unclassified') ----- = other ^ other isModification and: [obsoletion = other obsoletion and: [modification = other modification]]! Item was changed: + ----- Method: MCModification>>applyTo: (in category 'applying') ----- - ----- Method: MCModification>>applyTo: (in category 'accessing') ----- applyTo: anObject anObject modifyDefinition: obsoletion to: modification! Item was changed: + ----- Method: MCModification>>hash (in category 'comparing') ----- - ----- Method: MCModification>>hash (in category 'as yet unclassified') ----- hash ^ obsoletion hash bitXor: modification hash! Item was changed: + ----- Method: MCModification>>inverse (in category 'accessing') ----- - ----- Method: MCModification>>inverse (in category 'as yet unclassified') ----- inverse ^ MCModification of: modification to: obsoletion! Item was changed: + ----- Method: MCModification>>isClassPatch (in category 'testing') ----- - ----- Method: MCModification>>isClassPatch (in category 'as yet unclassified') ----- isClassPatch ^obsoletion isClassDefinition! Item was changed: + ----- Method: MCModification>>isUnchangedMethod (in category 'testing') ----- - ----- Method: MCModification>>isUnchangedMethod (in category 'as yet unclassified') ----- isUnchangedMethod "true if this is a modification of a method where only the timestamp changed" ^ obsoletion isMethodDefinition and: [obsoletion source = modification source and: [obsoletion category = modification category] ]! Item was changed: + ----- Method: MCModification>>printAnnotations:on: (in category 'accessing') ----- - ----- Method: MCModification>>printAnnotations:on: (in category 'as yet unclassified') ----- printAnnotations: request on: aStream aStream nextPutAll: 'old: '. obsoletion printAnnotations: request on: aStream. aStream cr. aStream nextPutAll: 'new: '. modification printAnnotations: request on: aStream.! Item was changed: + ----- Method: MCOperationsBrowser class>>items: (in category 'instance creation') ----- - ----- Method: MCOperationsBrowser class>>items: (in category 'creation') ----- items: aCollection ^ self new setItems: aCollection ; yourself! Item was changed: + ----- Method: MCOperationsList class>>operations: (in category 'instance creation') ----- - ----- Method: MCOperationsList class>>operations: (in category 'create') ----- operations: aCollection ^ self basicNew initializeWithOperations: aCollection! Item was changed: + ----- Method: MCOrganizationDefinition class>>categories: (in category 'instance creation') ----- - ----- Method: MCOrganizationDefinition class>>categories: (in category 'as yet unclassified') ----- categories: anArray ^ self instanceLike: (self new categories: anArray)! Item was changed: + ----- Method: MCPackageCache class>>new (in category 'instance creation') ----- - ----- Method: MCPackageCache class>>new (in category 'as yet unclassified') ----- new ^ self basicNew initialize! Item was changed: + ----- Method: MCPackageCache>>initialize (in category 'initialize-release') ----- - ----- Method: MCPackageCache>>initialize (in category 'as yet unclassified') ----- initialize sorter := MCVersionSorter new. fileNames := Dictionary new.! Item was changed: + ----- Method: MCPackageCache>>recordVersionInfo:forFileNamed: (in category 'recording') ----- - ----- Method: MCPackageCache>>recordVersionInfo:forFileNamed: (in category 'as yet unclassified') ----- recordVersionInfo: aVersionInfo forFileNamed: aString Transcript cr; show: aString. fileNames at: aVersionInfo put: aString. sorter addVersionInfo: aVersionInfo! Item was changed: + ----- Method: MCPackageCache>>versionInfos (in category 'accessing') ----- - ----- Method: MCPackageCache>>versionInfos (in category 'as yet unclassified') ----- versionInfos ^ sorter sortedVersionInfos ! Item was changed: + ----- Method: MCPackageLoader class>>installSnapshot: (in category 'loading') ----- - ----- Method: MCPackageLoader class>>installSnapshot: (in category 'as yet unclassified') ----- installSnapshot: aSnapshot self new installSnapshot: aSnapshot; load! Item was changed: + ----- Method: MCPackageLoader class>>new (in category 'instance creation') ----- - ----- Method: MCPackageLoader class>>new (in category 'as yet unclassified') ----- new ^ self basicNew initialize! Item was changed: + ----- Method: MCPackageLoader class>>unloadPackage: (in category 'unloading') ----- - ----- Method: MCPackageLoader class>>unloadPackage: (in category 'as yet unclassified') ----- unloadPackage: aPackage self new unloadPackage: aPackage; loadWithNameLike: aPackage name, '-unload'! Item was changed: + ----- Method: MCPackageLoader class>>updatePackage:withSnapshot: (in category 'loading') ----- - ----- Method: MCPackageLoader class>>updatePackage:withSnapshot: (in category 'as yet unclassified') ----- updatePackage: aPackage withSnapshot: aSnapshot self new updatePackage: aPackage withSnapshot: aSnapshot; load! Item was changed: + ----- Method: MCPackageManager class>>allManagers (in category 'private') ----- - ----- Method: MCPackageManager class>>allManagers (in category 'as yet unclassified') ----- allManagers ^ self registry values! Item was changed: + ----- Method: MCPackageManager class>>forPackage: (in category 'instance creation') ----- - ----- 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>>forPackageNamed: (in category 'instance creation') ----- - ----- Method: MCPackageManager class>>forPackageNamed: (in category 'as yet unclassified') ----- forPackageNamed: aString ^ self registry detect: [ : each | each packageName = aString ]! Item was changed: + ----- Method: MCPackageManager class>>initialize (in category 'class initialization') ----- - ----- Method: MCPackageManager class>>initialize (in category 'as yet unclassified') ----- initialize "Remove this later" Smalltalk at: #SystemChangeNotifier ifPresent:[:cls| (cls uniqueInstance) noMoreNotificationsFor: self. ].! Item was changed: + ----- Method: MCPackageManager class>>registry (in category 'private') ----- - ----- Method: MCPackageManager class>>registry (in category 'as yet unclassified') ----- registry ^ registry ifNil: [registry := Dictionary new]! Item was changed: + ----- Method: MCPatch class>>fromBase:target: (in category 'instance creation') ----- - ----- Method: MCPatch class>>fromBase:target: (in category 'create') ----- fromBase: baseSnapshot target: targetSnapshot ^ self new initializeWithBase: baseSnapshot target: targetSnapshot! Item was changed: + ----- Method: MCPatchOperation>>isClassPatch (in category 'testing') ----- - ----- Method: MCPatchOperation>>isClassPatch (in category 'as yet unclassified') ----- isClassPatch ^false! Item was changed: + ----- Method: MCPatchOperation>>isUnchangedMethod (in category 'testing') ----- - ----- Method: MCPatchOperation>>isUnchangedMethod (in category 'as yet unclassified') ----- isUnchangedMethod "true if this is a modification of a method where only the timestamp changed" ^false! Item was changed: + ----- Method: MCPatchOperation>>targetClass (in category 'accessing') ----- - ----- Method: MCPatchOperation>>targetClass (in category 'as yet unclassified') ----- targetClass self subclassResponsibility.! Item was changed: + ----- Method: MCPatcher class>>apply:to: (in category 'applying') ----- - ----- 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 class>>snapshot: (in category 'instance creation') ----- - ----- Method: MCPatcher class>>snapshot: (in category 'as yet unclassified') ----- snapshot: aSnapshot ^ self new initializeWithSnapshot: aSnapshot! Item was changed: + ----- Method: MCPatcher>>addDefinition: (in category 'accessing') ----- - ----- Method: MCPatcher>>addDefinition: (in category 'as yet unclassified') ----- addDefinition: aDefinition definitions add: aDefinition! Item was changed: + ----- Method: MCPatcher>>initializeWithSnapshot: (in category 'initialize-release') ----- - ----- Method: MCPatcher>>initializeWithSnapshot: (in category 'as yet unclassified') ----- initializeWithSnapshot: aSnapshot definitions := MCDefinitionIndex definitions: aSnapshot definitions! Item was changed: + ----- Method: MCPatcher>>modifyDefinition:to: (in category 'applying') ----- - ----- Method: MCPatcher>>modifyDefinition:to: (in category 'as yet unclassified') ----- modifyDefinition: baseDefinition to: targetDefinition self addDefinition: targetDefinition! Item was changed: + ----- Method: MCPatcher>>patchedSnapshot (in category 'applying') ----- - ----- Method: MCPatcher>>patchedSnapshot (in category 'as yet unclassified') ----- patchedSnapshot ^ MCSnapshot fromDefinitions: definitions definitions! Item was changed: + ----- Method: MCPatcher>>removeDefinition: (in category 'accessing') ----- - ----- Method: MCPatcher>>removeDefinition: (in category 'as yet unclassified') ----- removeDefinition: aDefinition definitions remove: aDefinition! Item was changed: + ----- Method: MCPoolImportDefinition class>>type (in category 'accessing') ----- - ----- Method: MCPoolImportDefinition class>>type (in category 'as yet unclassified') ----- type ^ #pool! Item was changed: + ----- Method: MCPostscriptDefinition class>>scriptSelector (in category 'private - instance creation') ----- - ----- Method: MCPostscriptDefinition class>>scriptSelector (in category 'as yet unclassified') ----- scriptSelector ^ #postscript! Item was changed: + ----- Method: MCPreambleDefinition class>>scriptSelector (in category 'private - instance creation') ----- - ----- Method: MCPreambleDefinition class>>scriptSelector (in category 'as yet unclassified') ----- scriptSelector ^ #preamble! Item was changed: + ----- Method: MCRemoval class>>of: (in category 'instance creation') ----- - ----- Method: MCRemoval class>>of: (in category 'as yet unclassified') ----- of: aDefinition ^ self new intializeWithDefinition: aDefinition! Item was changed: + ----- Method: MCRemoval>>= (in category 'comparing') ----- - ----- Method: MCRemoval>>= (in category 'as yet unclassified') ----- = other ^ other isRemoval and: [definition = other definition]! Item was changed: + ----- Method: MCRemoval>>hash (in category 'comparing') ----- - ----- Method: MCRemoval>>hash (in category 'as yet unclassified') ----- hash ^ definition hash! Item was changed: + ----- Method: MCRemoval>>inverse (in category 'accessing') ----- - ----- Method: MCRemoval>>inverse (in category 'as yet unclassified') ----- inverse ^ MCAddition of: definition! Item was changed: + ----- Method: MCRemoval>>isClassPatch (in category 'testing') ----- - ----- Method: MCRemoval>>isClassPatch (in category 'as yet unclassified') ----- isClassPatch ^definition isClassDefinition! Item was changed: + ----- Method: MCRemovalPostscriptDefinition class>>scriptSelector (in category 'private - instance creation') ----- - ----- Method: MCRemovalPostscriptDefinition class>>scriptSelector (in category 'as yet unclassified') ----- scriptSelector ^ #postscriptOfRemoval ! Item was changed: + ----- Method: MCRemovalPreambleDefinition class>>scriptSelector (in category 'private - instance creation') ----- - ----- Method: MCRemovalPreambleDefinition class>>scriptSelector (in category 'as yet unclassified') ----- scriptSelector ^ #preambleOfRemoval! Item was changed: + ----- Method: MCRepository>>description (in category 'user interface') ----- - ----- Method: MCRepository>>description (in category 'accessing') ----- description ^ self class name! Item was changed: + ----- Method: MCRepository>>morphicOpen (in category 'user interface') ----- - ----- Method: MCRepository>>morphicOpen (in category 'ui') ----- morphicOpen self morphicOpen: nil! Item was changed: + ----- Method: MCRepository>>morphicOpen: (in category 'user interface') ----- - ----- Method: MCRepository>>morphicOpen: (in category 'ui') ----- morphicOpen: aWorkingCopy (MCRepositoryInspector repository: self workingCopy: aWorkingCopy) show! Item was changed: + ----- Method: MCRepository>>notificationForVersion: (in category 'notifying') ----- - ----- Method: MCRepository>>notificationForVersion: (in category 'accessing') ----- notificationForVersion: aVersion ^ MCVersionNotification version: aVersion repository: self! Item was changed: + ----- Method: MCRepository>>notifyList (in category 'notifying') ----- - ----- Method: MCRepository>>notifyList (in category 'accessing') ----- notifyList ^ #()! Item was changed: + ----- Method: MCRepository>>openAndEditTemplateCopy (in category 'user interface') ----- - ----- Method: MCRepository>>openAndEditTemplateCopy (in category 'ui') ----- openAndEditTemplateCopy ^ self class fillInTheBlankConfigure: (self asCreationTemplate ifNil: [^nil])! Item was changed: + ----- Method: MCRepository>>sendNotificationsForVersion: (in category 'notifying') ----- - ----- 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: MCRepository>>storeVersion: (in category 'storing') ----- - ----- Method: MCRepository>>storeVersion: (in category 'accessing') ----- storeVersion: aMCVersionOrConfiguration self basicStoreVersion: (self prepareVersionForStorage: aMCVersionOrConfiguration). self sendNotificationsForVersion: aMCVersionOrConfiguration! Item was changed: + ----- Method: MCRepository>>wasRemoved (in category 'user interface') ----- - ----- Method: MCRepository>>wasRemoved (in category 'ui') ----- wasRemoved "Subclasses may override to, for example, disconnect a db session."! Item was changed: + ----- Method: MCSMCacheRepository>>description (in category 'user interface') ----- - ----- Method: MCSMCacheRepository>>description (in category 'accessing') ----- description ^ smCache directory pathName! Item was changed: + ----- Method: MCSMReleaseRepository class>>creationTemplate (in category 'configuring') ----- - ----- Method: MCSMReleaseRepository class>>creationTemplate (in category 'as yet unclassified') ----- creationTemplate ^ 'MCSMReleaseRepository package: ''mypackage'' user: ''squeak'' password: ''squeak''' ! Item was changed: + ----- Method: MCSMReleaseRepository class>>description (in category 'configuring') ----- - ----- Method: MCSMReleaseRepository class>>description (in category 'as yet unclassified') ----- description ^ 'SqueakMap Release'! Item was changed: + ----- Method: MCSMReleaseRepository class>>fillInTheBlankRequest (in category 'configuring') ----- - ----- Method: MCSMReleaseRepository class>>fillInTheBlankRequest (in category 'as yet unclassified') ----- fillInTheBlankRequest ^ 'SqueakMap Release Repository:' ! Item was changed: + ----- Method: MCSMReleaseRepository class>>morphicConfigure (in category 'configuring') ----- - ----- Method: MCSMReleaseRepository class>>morphicConfigure (in category 'as yet unclassified') ----- morphicConfigure ^ self fillInTheBlankConfigure! Item was changed: + ----- Method: MCSMReleaseRepository class>>package:user:password: (in category 'instance creation') ----- - ----- Method: MCSMReleaseRepository class>>package:user:password: (in category 'as yet unclassified') ----- package: packageString user: userString password: passString ^ self basicNew initializeWithPackage: packageString user: userString password: passString! Item was changed: + ----- Method: MCSMReleaseRepository>>basicStoreVersion: (in category 'private') ----- - ----- 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>>checkResult: (in category 'private') ----- - ----- Method: MCSMReleaseRepository>>checkResult: (in category 'as yet unclassified') ----- checkResult: resultString (#( 'HTTP/1.1 201 ' 'HTTP/1.1 200 ' 'HTTP/1.0 201 ' 'HTTP/1.0 200 ') anySatisfy: [:code | resultString beginsWith: code ]) ifFalse: [self error: resultString]. ! Item was changed: + ----- Method: MCSMReleaseRepository>>description (in category 'user interface') ----- - ----- Method: MCSMReleaseRepository>>description (in category 'as yet unclassified') ----- description ^ 'sm://', packageName! Item was changed: + ----- Method: MCSMReleaseRepository>>initializeWithPackage:user:password: (in category 'private') ----- - ----- 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>>releaseVersion:url: (in category 'private') ----- - ----- Method: MCSMReleaseRepository>>releaseVersion:url: (in category 'as yet unclassified') ----- releaseVersion: aVersion url: urlString | result | result := HTTPSocket httpPost: self squeakMapUrl, '/packagebyname/', packageName, '/newrelease' args: {'version' -> {(aVersion info versionNumber)}. 'note' -> {aVersion info message}. 'downloadURL' -> {urlString}} user: user passwd: password. result contents size > 4 ifTrue: [self error: result contents] ! Item was changed: + ----- Method: MCSMReleaseRepository>>squeakMapUrl (in category 'constants') ----- - ----- Method: MCSMReleaseRepository>>squeakMapUrl (in category 'as yet unclassified') ----- squeakMapUrl ^ 'http://localhost:9070/sm' ! Item was changed: + ----- Method: MCSMReleaseRepository>>stringForVersion: (in category 'private') ----- - ----- 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 'private') ----- - ----- 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: MCScanner class>>scan: (in category 'instance creation') ----- - ----- Method: MCScanner class>>scan: (in category 'as yet unclassified') ----- scan: aStream ^ (self new stream: aStream) next! Item was changed: + ----- Method: MCScanner class>>scanTokens: (in category 'instance creation') ----- - ----- Method: MCScanner class>>scanTokens: (in category 'as yet unclassified') ----- scanTokens: aString "compatibility" ^{ self scan: aString readStream }! Item was changed: + ----- Method: MCScanner>>next (in category 'scanning') ----- - ----- Method: MCScanner>>next (in category 'as yet unclassified') ----- next | c | stream skipSeparators. (c := stream peek) == $# 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>>nextArray (in category 'scanning') ----- - ----- Method: MCScanner>>nextArray (in category 'as yet unclassified') ----- nextArray stream next. "(" ^ Array streamContents: [:s | [stream skipSeparators. (stream peek == $)) or: [stream atEnd]] whileFalse: [s nextPut: self next]. stream next == $) ifFalse: [self error: 'Unclosed array']]! Item was changed: + ----- Method: MCScanner>>nextString (in category 'scanning') ----- - ----- Method: MCScanner>>nextString (in category 'as yet unclassified') ----- nextString ^ stream nextDelimited: $'! Item was changed: + ----- Method: MCScanner>>nextSymbol (in category 'scanning') ----- - ----- Method: MCScanner>>nextSymbol (in category 'as yet unclassified') ----- nextSymbol ^ (String streamContents: [:s | [stream peek isAlphaNumeric] whileTrue: [s nextPut: stream next]]) asSymbol ! Item was changed: + ----- Method: MCScanner>>stream: (in category 'accessing') ----- - ----- Method: MCScanner>>stream: (in category 'as yet unclassified') ----- stream: aStream stream := aStream! Item was changed: + ----- Method: MCScriptDefinition class>>from: (in category 'instance creation') ----- - ----- Method: MCScriptDefinition class>>from: (in category 'as yet unclassified') ----- from: aPackageInfo ^ self script: (aPackageInfo perform: self scriptSelector) contents asString packageName: aPackageInfo name! Item was changed: + ----- Method: MCScriptDefinition class>>script:packageName: (in category 'instance creation') ----- - ----- Method: MCScriptDefinition class>>script:packageName: (in category 'as yet unclassified') ----- script: aString packageName: packageString ^ self instanceLike: (self new initializeWithScript: aString packageName: packageString)! Item was changed: + ----- Method: MCScriptDefinition class>>scriptSelector (in category 'private - instance creation') ----- - ----- Method: MCScriptDefinition class>>scriptSelector (in category 'as yet unclassified') ----- scriptSelector self subclassResponsibility! Item was changed: + ----- Method: MCScriptDefinition class>>scriptSelector:script:packageName: (in category 'instance creation') ----- - ----- Method: MCScriptDefinition class>>scriptSelector:script:packageName: (in category 'as yet unclassified') ----- scriptSelector: selectorString script: aString packageName: packageString ^ (self subclassForScriptSelector: selectorString) script: aString packageName: packageString! Item was changed: + ----- Method: MCScriptDefinition class>>subclassForScriptSelector: (in category 'private - instance creation') ----- - ----- Method: MCScriptDefinition class>>subclassForScriptSelector: (in category 'as yet unclassified') ----- subclassForScriptSelector: selectorString ^self allSubclasses detect: [:ea | ea scriptSelector = selectorString]! Item was changed: + ----- Method: MCScriptParser class>>pattern (in category 'constants') ----- - ----- Method: MCScriptParser class>>pattern (in category 'as yet unclassified') ----- pattern ^'(PackageInfo named: *'! Item was changed: + ----- Method: MCScriptParser>>addDefinitionsTo: (in category 'evaluating') ----- - ----- Method: MCScriptParser>>addDefinitionsTo: (in category 'as yet unclassified') ----- addDefinitionsTo: aCollection | tokens definition | tokens := Scanner new scanTokens: source. definition := MCScriptDefinition scriptSelector: tokens second allButLast script: tokens third packageName: tokens first third. aCollection add: definition.! Item was changed: + ----- Method: MCSmtpRepository class>>description (in category 'configuring') ----- - ----- Method: MCSmtpRepository class>>description (in category 'as yet unclassified') ----- description ^ 'SMTP'! Item was changed: + ----- Method: MCSmtpRepository class>>morphicConfigure (in category 'configuring') ----- - ----- Method: MCSmtpRepository class>>morphicConfigure (in category 'as yet unclassified') ----- morphicConfigure | address | address := UIManager default request: 'Email address:'. ^ address isEmpty ifFalse: [self new emailAddress: address]! Item was changed: + ----- Method: MCSmtpRepository>>basicStoreVersion: (in category 'private') ----- - ----- Method: MCSmtpRepository>>basicStoreVersion: (in category 'as yet unclassified') ----- basicStoreVersion: aVersion MailSender sendMessage: (self messageForVersion: aVersion)! Item was changed: + ----- Method: MCSmtpRepository>>bodyForVersion: (in category 'converting') ----- - ----- Method: MCSmtpRepository>>bodyForVersion: (in category 'as yet unclassified') ----- bodyForVersion: aVersion ^ String streamContents: [ :s | s nextPutAll: 'from version info:'; cr; cr. s nextPutAll: aVersion info summary]! Item was changed: + ----- Method: MCSmtpRepository>>description (in category 'user interface') ----- - ----- Method: MCSmtpRepository>>description (in category 'as yet unclassified') ----- description ^ 'mailto://', email! Item was changed: + ----- Method: MCSmtpRepository>>emailAddress: (in category 'accessing') ----- - ----- Method: MCSmtpRepository>>emailAddress: (in category 'as yet unclassified') ----- emailAddress: aString email := aString ! Item was changed: + ----- Method: MCSmtpRepository>>messageForVersion: (in category 'converting') ----- - ----- Method: MCSmtpRepository>>messageForVersion: (in category 'as yet unclassified') ----- messageForVersion: aVersion | message data | message := MailMessage empty. message setField: 'from' toString: MailSender userName. message setField: 'to' toString: email. message setField: 'subject' toString: (self subjectForVersion: aVersion). message body: (MIMEDocument contentType: 'text/plain' content: (self bodyForVersion: aVersion)). "Prepare the gzipped data" data := RWBinaryOrTextStream on: String new. aVersion fileOutOn: data. message addAttachmentFrom: data reset withName: aVersion fileName. ^ message! Item was changed: + ----- Method: MCSmtpRepository>>subjectForVersion: (in category 'converting') ----- - ----- Method: MCSmtpRepository>>subjectForVersion: (in category 'as yet unclassified') ----- subjectForVersion: aVersion ^ '[Package] ', aVersion info name! Item was changed: + ----- Method: MCSnapshotBrowser class>>forSnapshot: (in category 'instance creation') ----- - ----- Method: MCSnapshotBrowser class>>forSnapshot: (in category 'as yet unclassified') ----- forSnapshot: aSnapshot ^ self new snapshot: aSnapshot! Item was changed: + ----- Method: MCSnapshotReader class>>snapshotFromStream: (in category 'converting') ----- - ----- Method: MCSnapshotReader class>>snapshotFromStream: (in category 'as yet unclassified') ----- snapshotFromStream: aStream ^ (self on: aStream) snapshot! Item was changed: + ----- Method: MCSnapshotReader>>definitions (in category 'loading') ----- - ----- Method: MCSnapshotReader>>definitions (in category 'as yet unclassified') ----- definitions definitions ifNil: [self loadDefinitions]. ^ definitions! Item was changed: + ----- Method: MCSnapshotReader>>snapshot (in category 'accessing') ----- - ----- Method: MCSnapshotReader>>snapshot (in category 'as yet unclassified') ----- snapshot ^ MCSnapshot fromDefinitions: self definitions! Item was changed: + ----- Method: MCStReader class>>extension (in category 'constants') ----- - ----- Method: MCStReader class>>extension (in category 'as yet unclassified') ----- extension ^ 'st'! Item was changed: + ----- Method: MCStReader>>addDefinitionsFromDoit: (in category 'private') ----- - ----- Method: MCStReader>>addDefinitionsFromDoit: (in category 'as yet unclassified') ----- addDefinitionsFromDoit: aString (MCDoItParser forDoit: aString) ifNotNil: [:parser | parser addDefinitionsTo: definitions]! Item was changed: + ----- Method: MCStReader>>categoryFromDoIt: (in category 'private') ----- - ----- 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>>classDefinitionFrom: (in category 'converting') ----- - ----- Method: MCStReader>>classDefinitionFrom: (in category 'as yet unclassified') ----- classDefinitionFrom: aPseudoClass | tokens traitCompositionString lastIndex classTraitCompositionString typeOfSubclass className | tokens := Scanner new scanTokens: aPseudoClass definition. traitCompositionString := ((ReadStream on: aPseudoClass definition) match: 'uses:'; upToAll: 'instanceVariableNames:') withBlanksTrimmed. classTraitCompositionString := ((ReadStream on: aPseudoClass metaClass definition asString) match: 'uses:'; upToAll: 'instanceVariableNames:') withBlanksTrimmed. traitCompositionString isEmpty ifTrue: [traitCompositionString := '{}']. classTraitCompositionString isEmpty ifTrue: [classTraitCompositionString := '{}']. lastIndex := tokens size. className := tokens at: 3. typeOfSubclass := self typeOfSubclass: (tokens at: 2). "Compiled code classes are special cases of the #bytes class type" (#bytes == typeOfSubclass and: [self compiledCodeClassNames includes: className]) ifTrue: [typeOfSubclass := #compiledMethod]. ^ MCClassDefinition name: className superclassName: (tokens at: 1) traitComposition: traitCompositionString classTraitComposition: classTraitCompositionString category: (tokens at: lastIndex) instVarNames: ((tokens at: lastIndex - 6) findTokens: ' ') classVarNames: ((tokens at: lastIndex - 4) findTokens: ' ') poolDictionaryNames: ((tokens at: lastIndex - 2) findTokens: ' ') classInstVarNames: (self classInstVarNamesFor: aPseudoClass) type: typeOfSubclass comment: (self commentFor: aPseudoClass) commentStamp: (self commentStampFor: aPseudoClass)! Item was changed: + ----- Method: MCStReader>>classInstVarNamesFor: (in category 'converting') ----- - ----- Method: MCStReader>>classInstVarNamesFor: (in category 'as yet unclassified') ----- classInstVarNamesFor: aPseudoClass | tokens | self flag: #traits. aPseudoClass metaClass hasDefinition ifFalse: [^ #()]. tokens := Scanner new scanTokens: aPseudoClass metaClass definition. "tokens size = 4 ifFalse: [self error: 'Unrecognized metaclass definition']." ^ tokens last findTokens: ' '! Item was changed: + ----- Method: MCStReader>>commentFor: (in category 'converting') ----- - ----- 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 'converting') ----- - ----- 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>>compiledCodeClassNames (in category 'private') ----- - ----- Method: MCStReader>>compiledCodeClassNames (in category 'as yet unclassified') ----- compiledCodeClassNames "Answer the names of classes for which the type is #compiledMethod. Traditionally, this was only class CompiledMehod, but later refactorings require that CompiledCode and its subclasses be treated as type #compiledMethod." ^{ #CompiledCode . #CompiledBlock . #CompiledMethod }! Item was changed: + ----- Method: MCStReader>>methodDefinitionsFor: (in category 'converting') ----- - ----- Method: MCStReader>>methodDefinitionsFor: (in category 'as yet unclassified') ----- methodDefinitionsFor: aPseudoClass ^ aPseudoClass selectors collect: [:ea | MCMethodDefinition className: aPseudoClass name classIsMeta: aPseudoClass isMeta selector: ea category: (aPseudoClass organization categoryOfElement: ea) timeStamp: (aPseudoClass stampAt: ea) source: (aPseudoClass sourceCodeAt: ea)]! Item was changed: + ----- Method: MCStReader>>systemOrganizationFromRecords: (in category 'converting') ----- - ----- 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: MCStReader>>traitDefinitionFrom: (in category 'converting') ----- - ----- Method: MCStReader>>traitDefinitionFrom: (in category 'as yet unclassified') ----- traitDefinitionFrom: aPseudoTrait | tokens traitCompositionString lastIndex | tokens := Scanner new scanTokens: aPseudoTrait definition. traitCompositionString := ((ReadStream on: aPseudoTrait definition) match: 'uses:'; upToAll: 'category:') withBlanksTrimmed. traitCompositionString isEmpty ifTrue: [traitCompositionString := '{}']. lastIndex := tokens size. ^ MCTraitDefinition name: (tokens at: 3) traitComposition: traitCompositionString category: (tokens at: lastIndex) comment: (self commentFor: aPseudoTrait) commentStamp: (self commentStampFor: aPseudoTrait)! Item was changed: + ----- Method: MCStReader>>typeOfSubclass: (in category 'private') ----- - ----- Method: MCStReader>>typeOfSubclass: (in category 'as yet unclassified') ----- typeOfSubclass: aSymbol #( (subclass: normal) (variableSubclass: variable) (variableByteSubclass: bytes) (variableDoubleByteSubclass: shorts) (variableWordSubclass: words) (variableDoubleWordSubclass: longs) (weakSubclass: weak) (ephemeronSubclass: ephemeron) (immediateSubclass: immediate) ) do: [:ea | ea first = aSymbol ifTrue: [^ ea second]]. self error: 'Unrecognized class definition'! Item was changed: + ----- Method: MCStWriter class>>readerClass (in category 'accessing') ----- - ----- Method: MCStWriter class>>readerClass (in category 'as yet unclassified') ----- readerClass ^ MCStReader! Item was changed: + ----- Method: MCSubDirectoryRepository>>allDirectories (in category 'enumerating') ----- - ----- Method: MCSubDirectoryRepository>>allDirectories (in category 'enumeration') ----- allDirectories | remaining dir dirs | remaining := OrderedCollection new. dirs := OrderedCollection new. remaining addLast: directory. [remaining isEmpty] whileFalse: [dir := remaining removeFirst. dirs add: dir. dir entries do: [:ent | ent isDirectory ifTrue: [remaining addLast: (dir directoryNamed: ent name)]]]. ^ dirs! Item was changed: + ----- Method: MCSubDirectoryRepository>>allFileNames (in category 'enumerating') ----- - ----- Method: MCSubDirectoryRepository>>allFileNames (in category 'enumeration') ----- allFileNames "sorting {entry. dirName. name}" | result | result := OrderedCollection new. self allDirectories do: [:dir | dir entries do: [:ent | ent isDirectory ifFalse: [result addLast: {ent. dir fullName. ent name}]]]. ^result sort: [:a :b | a first modificationTime >= b first modificationTime ]; replace: [:ea | ea third asMCVersionName]! Item was changed: + ----- Method: MCSubDirectoryRepository>>findFullNameForReading: (in category 'private') ----- - ----- Method: MCSubDirectoryRepository>>findFullNameForReading: (in category 'as yet unclassified') ----- findFullNameForReading: aBaseName "Answer the latest version of aBaseName" | possible | possible := OrderedCollection new. self allDirectories do: [:dir | dir entries do: [:ent | ent isDirectory ifFalse: [ (ent name = aBaseName) ifTrue: [ possible addLast: {ent. dir fullNameFor: ent name}]]]]. possible isEmpty ifTrue: [ ^nil ]. ^(possible detectMin: [ :each | each first modificationTime ]) second! Item was changed: + ----- Method: MCSubDirectoryRepository>>findFullNameForWriting: (in category 'private') ----- - ----- Method: MCSubDirectoryRepository>>findFullNameForWriting: (in category 'as yet unclassified') ----- findFullNameForWriting: aBaseName | possible split prefix fpattern now | split := directory splitNameVersionExtensionFor: aBaseName. fpattern := split first, '*'. possible := OrderedCollection new. now := Time totalSeconds. prefix := directory pathParts size. self allDirectories do: [:dir | | parts dirScore fileScore | parts := dir pathParts allButFirst: prefix. dirScore := (parts select: [ :part | fpattern match: part ]) size. fileScore := (dir entries collect: [ :ent | (ent isDirectory not and: [ fpattern match: ent name ]) ifFalse: [ SmallInteger maxVal ] ifTrue: [ now - ent modificationTime ]]). "minimum age" fileScore := fileScore isEmpty ifTrue: [ SmallInteger maxVal ] ifFalse: [ fileScore min ]. possible add: { dirScore. fileScore. dir } ]. possible sort: [ :a :b | a first = b first ifTrue: [ a second = b second ifFalse: [ a second < b second ] ifTrue: [ a third fullName size < b third fullName size ]] ifFalse: [ a first > b first ] ]. ^(possible first third) fullNameFor: aBaseName! Item was changed: + ----- Method: MCSubDirectoryRepository>>readStreamForFileNamed:do: (in category 'private') ----- - ----- 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: MCSubDirectoryRepository>>writeStreamForFileNamed:replace:do: (in category 'private') ----- - ----- Method: MCSubDirectoryRepository>>writeStreamForFileNamed:replace:do: (in category 'as yet unclassified') ----- writeStreamForFileNamed: aString replace: aBoolean do: aBlock | file | file := aBoolean ifTrue: [FileStream forceNewFileNamed: (self findFullNameForReading: aString)] ifFalse: [FileStream newFileNamed: (self findFullNameForWriting: aString)]. aBlock value: file. file close! Item was changed: + ----- Method: MCSystemCategoryParser class>>pattern (in category 'constants') ----- - ----- Method: MCSystemCategoryParser class>>pattern (in category 'as yet unclassified') ----- pattern ^ 'SystemOrganization*'! Item was changed: + ----- Method: MCSystemCategoryParser>>addDefinitionsTo: (in category 'evaluating') ----- - ----- 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 'evaluating') ----- - ----- 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 class>>base:patch: (in category 'instance creation') ----- - ----- Method: MCThreeWayMerger class>>base:patch: (in category 'as yet unclassified') ----- base: aSnapshot patch: aPatch aPatch isEmpty ifTrue: [MCNoChangesException signal]. ^ self new addBaseSnapshot: aSnapshot; applyPatch: aPatch; yourself ! Item was changed: + ----- Method: MCThreeWayMerger class>>base:target:ancestor: (in category 'instance creation') ----- - ----- Method: MCThreeWayMerger class>>base:target:ancestor: (in category 'as yet unclassified') ----- base: aSnapshot target: targetSnapshot ancestor: ancestorSnapshot ^ self base: aSnapshot patch: (targetSnapshot patchRelativeToBase: ancestorSnapshot)! Item was changed: + ----- Method: MCThreeWayMerger class>>new (in category 'instance creation') ----- - ----- Method: MCThreeWayMerger class>>new (in category 'as yet unclassified') ----- new ^ self basicNew initialize! Item was changed: + ----- Method: MCThreeWayMerger>>applyPatch: (in category 'applying') ----- - ----- Method: MCThreeWayMerger>>applyPatch: (in category 'as yet unclassified') ----- applyPatch: aPatch aPatch applyTo: self! Item was changed: + ----- Method: MCThreeWayMerger>>applyTo: (in category 'applying') ----- - ----- Method: MCThreeWayMerger>>applyTo: (in category 'as yet unclassified') ----- applyTo: anObject super applyTo: anObject. self operations do: [:ea | ea applyTo: anObject]! Item was changed: + ----- Method: MCThreeWayMerger>>initialize (in category 'initialize-release') ----- - ----- Method: MCThreeWayMerger>>initialize (in category 'as yet unclassified') ----- initialize index := MCDefinitionIndex new. provisions := Set new! Item was changed: + ----- Method: MCThreeWayMerger>>operations (in category 'accessing') ----- - ----- Method: MCThreeWayMerger>>operations (in category 'as yet unclassified') ----- operations ^ operations ifNil: [operations := OrderedCollection new]! Item was changed: + ----- Method: MCThreeWayMerger>>provisions (in category 'accessing') ----- - ----- Method: MCThreeWayMerger>>provisions (in category 'as yet unclassified') ----- provisions ^ provisions! Item was changed: + ----- Method: MCToolWindowBuilder class>>builder:tool: (in category 'instance creation') ----- - ----- Method: MCToolWindowBuilder class>>builder:tool: (in category 'as yet unclassified') ----- builder: aBuilder tool: aTool ^ self basicNew initializeWithBuilder: aBuilder tool: aTool! Item was changed: + ----- Method: MCTraitDefinition class>>name:traitComposition:category:comment:commentStamp: (in category 'instance creation') ----- - ----- Method: MCTraitDefinition class>>name:traitComposition:category:comment:commentStamp: (in category 'as yet unclassified') ----- name: classNameString traitComposition: traitCompositionString category: categoryString comment: commentString commentStamp: commentStamp ^ self instanceLike: (self new initializeWithName: classNameString traitComposition: traitCompositionString category: categoryString comment: commentString commentStamp: commentStamp) ! Item was changed: + ----- Method: MCTraitParser class>>pattern (in category 'constants') ----- - ----- Method: MCTraitParser class>>pattern (in category 'as yet unclassified') ----- pattern ^ 'Trait named:*'! Item was changed: + ----- Method: MCVariableDefinition class>>name: (in category 'instance creation') ----- - ----- Method: MCVariableDefinition class>>name: (in category 'as yet unclassified') ----- name: aString ^ self new name: aString ! Item was changed: + ----- Method: MCVersionDependency class>>package:info: (in category 'instance creation') ----- - ----- Method: MCVersionDependency class>>package:info: (in category 'as yet unclassified') ----- package: aPackage info: aVersionInfo ^ self basicNew initializeWithPackage: aPackage info: aVersionInfo! Item was changed: + ----- Method: MCVersionInfo class>>name:id:message:date:time:author:ancestors: (in category 'instance creation') ----- - ----- Method: MCVersionInfo class>>name:id:message:date:time:author:ancestors: (in category 'as yet unclassified') ----- name: vName id: id message: message date: date time: time author: author ancestors: ancestors ^ self name: vName id: id message: message date: date time: time author: author ancestors: ancestors stepChildren: #()! Item was changed: + ----- Method: MCVersionInfo class>>name:id:message:date:time:author:ancestors:stepChildren: (in category 'instance creation') ----- - ----- Method: MCVersionInfo class>>name:id:message:date:time:author:ancestors:stepChildren: (in category 'as yet unclassified') ----- name: vName id: id message: message date: date time: time author: author ancestors: ancestors stepChildren: stepChildren ^ self new initializeWithName: vName id: id message: message date: date time: time author: author ancestors: ancestors stepChildren: stepChildren! Item was changed: + ----- Method: MCVersionInfoWriter>>isWritten: (in category 'testing') ----- - ----- Method: MCVersionInfoWriter>>isWritten: (in category 'as yet unclassified') ----- isWritten: aVersionInfo ^ self written includes: aVersionInfo! Item was changed: + ----- Method: MCVersionInfoWriter>>writeVersionInfo: (in category 'writing') ----- - ----- Method: MCVersionInfoWriter>>writeVersionInfo: (in category 'as yet unclassified') ----- writeVersionInfo: aVersionInfo (self isWritten: aVersionInfo) ifTrue: [^ stream nextPutAll: '(id ', aVersionInfo id asString printString, ')']. stream nextPut: $(. #(name message id date time author) do: [:sel | stream nextPutAll: sel. stream nextPut: $ . ((aVersionInfo perform: sel) ifNil: ['']) asString printOn: stream. stream nextPut: $ ]. stream nextPutAll: 'ancestors ('. aVersionInfo ancestors do: [:ea | self writeVersionInfo: ea]. stream nextPutAll: ') stepChildren ('. aVersionInfo stepChildren do: [:ea | self writeVersionInfo: ea]. stream nextPutAll: '))'. self wrote: aVersionInfo! Item was changed: + ----- Method: MCVersionInfoWriter>>written (in category 'accessing') ----- - ----- Method: MCVersionInfoWriter>>written (in category 'as yet unclassified') ----- written ^ written ifNil: [written := Set new]! Item was changed: + ----- Method: MCVersionInfoWriter>>wrote: (in category 'accessing') ----- - ----- Method: MCVersionInfoWriter>>wrote: (in category 'as yet unclassified') ----- wrote: aVersionInfo self written add: aVersionInfo! Item was changed: + ----- Method: MCVersionLoader class>>loadVersion: (in category 'loading') ----- - ----- Method: MCVersionLoader class>>loadVersion: (in category 'as yet unclassified') ----- loadVersion: aVersion self new addVersion: aVersion; load! Item was changed: + ----- Method: MCVersionLoader class>>new (in category 'instance creation') ----- - ----- Method: MCVersionLoader class>>new (in category 'as yet unclassified') ----- new ^ self basicNew initialize! Item was changed: + ----- Method: MCVersionMerger class>>mergeVersion: (in category 'merging') ----- - ----- Method: MCVersionMerger class>>mergeVersion: (in category 'as yet unclassified') ----- mergeVersion: aVersion self new addVersion: aVersion; mergeWithNameLike: aVersion info name! Item was changed: + ----- Method: MCVersionMerger class>>new (in category 'instance creation') ----- - ----- Method: MCVersionMerger class>>new (in category 'as yet unclassified') ----- new ^ self basicNew initialize! Item was changed: + ----- Method: MCVersionMerger>>addVersion: (in category 'accessing') ----- - ----- Method: MCVersionMerger>>addVersion: (in category 'as yet unclassified') ----- addVersion: aVersion records add: (MCMergeRecord version: aVersion). aVersion dependencies do: [:ea | | dep | dep := ea resolve. (records anySatisfy: [:r | r version = dep]) ifFalse: [self addVersion: dep]]! Item was changed: + ----- Method: MCVersionMerger>>initialize (in category 'initialize-release') ----- - ----- Method: MCVersionMerger>>initialize (in category 'as yet unclassified') ----- initialize records := OrderedCollection new. merger := MCThreeWayMerger new.! Item was changed: + ----- Method: MCVersionMerger>>merge (in category 'merging') ----- - ----- Method: MCVersionMerger>>merge (in category 'as yet unclassified') ----- merge records do: [:ea | merger addBaseSnapshot: ea packageSnapshot]. records do: [:ea | merger applyPatch: ea mergePatch]. self resolveConflicts ifTrue: [merger load. records do: [:ea | ea updateWorkingCopy]].! Item was changed: + ----- Method: MCVersionMerger>>mergeWithNameLike: (in category 'merging') ----- - ----- Method: MCVersionMerger>>mergeWithNameLike: (in category 'as yet unclassified') ----- mergeWithNameLike: baseName records do: [:ea | merger addBaseSnapshot: ea packageSnapshot]. records do: [:ea | merger applyPatch: ea mergePatch]. self resolveConflicts ifTrue: [merger loadWithNameLike: baseName. records do: [:ea | ea updateWorkingCopy]].! Item was changed: + ----- Method: MCVersionMerger>>resolveConflicts (in category 'testing') ----- - ----- Method: MCVersionMerger>>resolveConflicts (in category 'as yet unclassified') ----- resolveConflicts (records allSatisfy: [:ea | ea isAncestorMerge]) ifTrue: [MCNoChangesException signal. ^ false]. ^ ((MCMergeResolutionRequest new merger: merger) signal: 'Merging ', records first version info name) = true! Item was changed: + ----- Method: MCVersionNotification class>>version:repository: (in category 'instance creation') ----- - ----- Method: MCVersionNotification class>>version:repository: (in category 'as yet unclassified') ----- version: aVersion repository: aRepository ^ self basicNew initializeWithVersion: aVersion repository: aRepository! Item was changed: + ----- Method: MCVersionNotification>>fromAddress (in category 'accessing') ----- - ----- Method: MCVersionNotification>>fromAddress (in category 'as yet unclassified') ----- fromAddress ^ 'monticello(a)beta4.com'! Item was changed: + ----- Method: MCVersionNotification>>initializeWithVersion:repository: (in category 'private') ----- - ----- 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 sorted]! Item was changed: + ----- Method: MCVersionNotification>>messageText (in category 'accessing') ----- - ----- Method: MCVersionNotification>>messageText (in category 'as yet unclassified') ----- messageText ^ String streamContents: [:s | s nextPutAll: 'Committed to repository: ', repository description; cr; cr. s nextPutAll: version summary. changes isEmpty ifFalse: [s cr; cr. s nextPutAll: '-----------------------------------------------------'; cr. s nextPutAll: 'Changes since ', ancestor info name, ':'; cr. changes do: [:ea | s cr; nextPutAll: ea summary; cr. s nextPutAll: ea sourceString]]]! Item was changed: + ----- Method: MCVersionNotification>>messageTo: (in category 'private') ----- - ----- 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 'notifying') ----- - ----- Method: MCVersionNotification>>notify: (in category 'as yet unclassified') ----- notify: aString | message | message := self messageTo: aString. SMTPClient deliverMailFrom: message from to: { message to } text: message text usingServer: MailSender smtpServer! Item was changed: + ----- Method: MCVersionSorter class>>new (in category 'instance creation') ----- - ----- Method: MCVersionSorter class>>new (in category 'as yet unclassified') ----- new ^ self basicNew initialize! Item was changed: + ----- Method: MCVersionSorter>>addAllAncestorsOf:to: (in category 'accessing') ----- - ----- Method: MCVersionSorter>>addAllAncestorsOf:to: (in category 'as yet unclassified') ----- addAllAncestorsOf: aVersionInfo to: aSet (aSet includes: aVersionInfo) ifTrue: [^ self]. aSet add: aVersionInfo. (self knownAncestorsOf: aVersionInfo) do: [:ea | self addAllAncestorsOf: ea to: aSet]! Item was changed: + ----- Method: MCVersionSorter>>addAllVersionInfos: (in category 'accessing') ----- - ----- Method: MCVersionSorter>>addAllVersionInfos: (in category 'as yet unclassified') ----- addAllVersionInfos: aCollection aCollection do: [:ea | self addVersionInfo: ea]! Item was changed: + ----- Method: MCVersionSorter>>addToCurrentLayer: (in category 'accessing') ----- - ----- 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>>addVersionInfo: (in category 'accessing') ----- - ----- Method: MCVersionSorter>>addVersionInfo: (in category 'as yet unclassified') ----- addVersionInfo: aVersionInfo roots add: aVersionInfo. self registerStepChildrenOf: aVersionInfo seen: Set new! Item was changed: + ----- Method: MCVersionSorter>>allAncestorsOf: (in category 'ancestry') ----- - ----- 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 'initialize-release') ----- - ----- Method: MCVersionSorter>>initialize (in category 'as yet unclassified') ----- initialize stepparents := Dictionary new. roots := OrderedCollection new.! Item was changed: + ----- Method: MCVersionSorter>>knownAncestorsOf: (in category 'ancestry') ----- - ----- Method: MCVersionSorter>>knownAncestorsOf: (in category 'as yet unclassified') ----- knownAncestorsOf: aVersionInfo ^ aVersionInfo ancestors, (self stepParentsOf: aVersionInfo) asArray! Item was changed: + ----- Method: MCVersionSorter>>layers (in category 'accessing') ----- - ----- Method: MCVersionSorter>>layers (in category 'as yet unclassified') ----- layers ^ layers! Item was changed: + ----- Method: MCVersionSorter>>popLayer (in category 'private') ----- - ----- Method: MCVersionSorter>>popLayer (in category 'as yet unclassified') ----- popLayer depthIndex := depthIndex - 1! Item was changed: + ----- Method: MCVersionSorter>>processVersionInfo: (in category 'private') ----- - ----- Method: MCVersionSorter>>processVersionInfo: (in category 'as yet unclassified') ----- processVersionInfo: aVersionInfo (self addToCurrentLayer: aVersionInfo) ifTrue: [self pushLayer. (self knownAncestorsOf: aVersionInfo) do: [:ea | self processVersionInfo: ea]. self popLayer] ! Item was changed: + ----- Method: MCVersionSorter>>pushLayer (in category 'private') ----- - ----- 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>>registerStepChildrenOf:seen: (in category 'private') ----- - ----- Method: MCVersionSorter>>registerStepChildrenOf:seen: (in category 'as yet unclassified') ----- registerStepChildrenOf: aVersionInfo seen: aSet (aSet includes: aVersionInfo) ifTrue: [^ self]. aSet add: aVersionInfo. aVersionInfo stepChildren do: [:ea | (self stepParentsOf: ea) add: aVersionInfo]. aVersionInfo ancestors do: [:ea | self registerStepChildrenOf: ea seen: aSet].! Item was changed: + ----- Method: MCVersionSorter>>sortedVersionInfos (in category 'versions') ----- - ----- 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: MCVersionSorter>>stepParentsOf: (in category 'ancestry') ----- - ----- Method: MCVersionSorter>>stepParentsOf: (in category 'as yet unclassified') ----- stepParentsOf: aVersionInfo ^ (stepparents at: aVersionInfo ifAbsentPut: [Set new])! Item was changed: + ----- Method: MCWorkingAncestry>>addAncestor: (in category 'accessing') ----- - ----- Method: MCWorkingAncestry>>addAncestor: (in category 'as yet unclassified') ----- addAncestor: aNode ancestors := (self ancestors reject: [:each | aNode hasAncestor: each]) copyWith: aNode! Item was changed: + ----- Method: MCWorkingAncestry>>addStepChild: (in category 'accessing') ----- - ----- Method: MCWorkingAncestry>>addStepChild: (in category 'as yet unclassified') ----- addStepChild: aVersionInfo stepChildren := stepChildren copyWith: aVersionInfo! Item was changed: + ----- Method: MCWorkingAncestry>>infoWithName:message: (in category 'versions') ----- - ----- Method: MCWorkingAncestry>>infoWithName:message: (in category 'as yet unclassified') ----- infoWithName: nameString message: messageString ^ MCVersionInfo name: nameString id: UUID new message: messageString date: Date today time: Time now author: Utilities authorInitials ancestors: ancestors asArray stepChildren: self stepChildren asArray! Item was changed: + ----- Method: MCWorkingAncestry>>name (in category 'testing') ----- - ----- Method: MCWorkingAncestry>>name (in category 'as yet unclassified') ----- name ^ '<working copy>'! Item was changed: + ----- Method: MCWorkingAncestry>>reparent: (in category 'operations') ----- - ----- Method: MCWorkingAncestry>>reparent: (in category 'as yet unclassified') ----- reparent: aNode "Let aNode be the sole parent of this version" ancestors := { aNode } ! Item was changed: + ----- Method: MCWorkingAncestry>>summary (in category 'accessing') ----- - ----- Method: MCWorkingAncestry>>summary (in category 'as yet unclassified') ----- summary ^ 'Ancestors: ', self ancestorString! Item was changed: + ----- Method: MCWorkingCopy class>>adoptVersionInfoFrom: (in category 'operations') ----- - ----- Method: MCWorkingCopy class>>adoptVersionInfoFrom: (in category 'as yet unclassified') ----- adoptVersionInfoFrom: anInstaller |viCache| viCache := Dictionary new. anInstaller versionInfo keysAndValuesDo: [:packageName :info | (self forPackage: (MCPackage named: packageName)) versionInfo: (self infoFromDictionary: info cache: viCache)]. [anInstaller clearVersionInfo] on: Error do: ["backwards compat"].! Item was changed: + ----- Method: MCWorkingCopy class>>ancestorsFromArray:cache: (in category 'operations') ----- - ----- Method: MCWorkingCopy class>>ancestorsFromArray:cache: (in category 'as yet unclassified') ----- ancestorsFromArray: anArray cache: aDictionary ^ anArray ifNotNil: [anArray collect: [:dict | self infoFromDictionary: dict cache: aDictionary]]! Item was changed: + ----- Method: MCWorkingCopy class>>checkModified: (in category 'operations') ----- - ----- Method: MCWorkingCopy class>>checkModified: (in category 'as yet unclassified') ----- checkModified: thorough "Verify that all working copies with a modified flag are really modified, by comparing them to their stored snapshot. If the 'thorough' argument is true, check all packages, even unmodified ones." "MCWorkingCopy checkModified: true" | workingCopies | workingCopies := self allManagers. thorough ifFalse: [ workingCopies := workingCopies select: [:wc | wc modified]]. workingCopies do: [:wc | wc checkModified] displayingProgress: [:wc | 'Checking package {1} for changes ...' translated format: {wc packageName}]! Item was changed: + ----- Method: MCWorkingCopy class>>infoFromDictionary:cache: (in category 'operations') ----- - ----- Method: MCWorkingCopy class>>infoFromDictionary:cache: (in category 'as yet unclassified') ----- infoFromDictionary: aDictionary cache: cache | id | id := (aDictionary at: #id) asString. ^ cache at: id ifAbsentPut: [MCVersionInfo name: (aDictionary at: #name ifAbsent: ['']) id: (UUID fromString: id) message: (aDictionary at: #message ifAbsent: ['']) date: ([Date fromString: (aDictionary at: #date)] ifError: [nil]) time: ([Time fromString: (aDictionary at: #time)] ifError: [nil]) author: (aDictionary at: #author ifAbsent: ['']) ancestors: (self ancestorsFromArray: (aDictionary at: #ancestors ifAbsent: []) cache: cache) stepChildren: (self ancestorsFromArray: (aDictionary at: #stepChildren ifAbsent: []) cache: cache)]! Item was changed: + ----- Method: MCWorkingCopy class>>initialize (in category 'class initialization') ----- - ----- Method: MCWorkingCopy class>>initialize (in category 'as yet unclassified') ----- initialize Smalltalk at: #MczInstaller ifPresent: [:installer | self adoptVersionInfoFrom: installer]. self updateInstVars. "Temporary conversion code -- remove later" registry ifNotNil:[registry rehash]. "changed #=" self allInstancesDo:[:each| "moved notifications" Smalltalk at: #SystemChangeNotifier ifPresent:[:cls| cls uniqueInstance noMoreNotificationsFor: each. ]. ]. self registerForNotifications. Smalltalk addToStartUpList: self! Item was changed: + ----- Method: MCWorkingCopy class>>updateInstVars (in category 'system maintenance') ----- - ----- Method: MCWorkingCopy class>>updateInstVars (in category 'as yet unclassified') ----- updateInstVars self allInstances do: [:ea | ea updateInstVars]! Item was changed: + ----- Method: MCWorkingCopyBrowser class>>initialize (in category 'class initialization') ----- - ----- Method: MCWorkingCopyBrowser class>>initialize (in category 'as yet unclassified') ----- initialize (TheWorldMenu respondsTo: #registerOpenCommand:) ifTrue: [TheWorldMenu registerOpenCommand: {'Monticello Browser'. {self. #open}}]! Item was changed: + ----- Method: MCWorkingCopyBrowser class>>new (in category 'instance creation') ----- - ----- Method: MCWorkingCopyBrowser class>>new (in category 'as yet unclassified') ----- new ^ self basicNew initialize! Item was changed: + ----- Method: MCWorkingCopyBrowser class>>open (in category 'instance creation') ----- - ----- Method: MCWorkingCopyBrowser class>>open (in category 'as yet unclassified') ----- open self new show! Item was changed: + ----- Method: MCWorkingHistoryBrowser>>baseSnapshot (in category 'accessing') ----- - ----- Method: MCWorkingHistoryBrowser>>baseSnapshot (in category 'as yet unclassified') ----- baseSnapshot ^ package snapshot! Item was changed: + ----- Method: MCWriteOnlyRepository>>includesVersionNamed: (in category 'versions') ----- - ----- Method: MCWriteOnlyRepository>>includesVersionNamed: (in category 'as yet unclassified') ----- includesVersionNamed: aString ^ false! Item was changed: + ----- Method: MCWriteOnlyRepository>>morphicOpen: (in category 'user interface') ----- - ----- Method: MCWriteOnlyRepository>>morphicOpen: (in category 'as yet unclassified') ----- morphicOpen: aWorkingCopy self inform: 'This repository is write-only'! Item was changed: + ----- Method: MCWriteOnlyRepository>>versionNamesForPackageNamed: (in category 'versions') ----- - ----- Method: MCWriteOnlyRepository>>versionNamesForPackageNamed: (in category 'as yet unclassified') ----- versionNamesForPackageNamed: aString "Answer a collection of MCVersionNames whose Package is named aString." ^{}! Item was changed: + ----- Method: MCWriteOnlyRepository>>versionWithInfo:ifAbsent: (in category 'versions') ----- - ----- Method: MCWriteOnlyRepository>>versionWithInfo:ifAbsent: (in category 'as yet unclassified') ----- versionWithInfo: aVersionInfo ifAbsent: aBlock ^ aBlock value! Item was changed: + ----- Method: MethodAddition>>compile (in category 'compiling') ----- - ----- Method: MethodAddition>>compile (in category 'as yet unclassified') ----- compile "This method is the how compiling a method used to work. All these steps were done at once. This method should not normally be used, because the whole point of MethodAddition is to let you first create a compiled method and then install the method later." self createCompiledMethod. self installMethod. self notifyObservers. ^selector! Item was changed: + ----- Method: MethodAddition>>compile:classified:withStamp:notifying:logSource:inClass: (in category 'initialize-release') ----- - ----- Method: MethodAddition>>compile:classified:withStamp:notifying:logSource:inClass: (in category 'as yet unclassified') ----- compile: aString classified: aString1 withStamp: aString2 notifying: aRequestor logSource: aBoolean inClass: aClass text := aString. category := aString1. changeStamp := aString2. requestor := aRequestor. logSource := aBoolean. myClass := aClass! Item was changed: + ----- Method: MethodAddition>>createCompiledMethod (in category 'compiling') ----- - ----- Method: MethodAddition>>createCompiledMethod (in category 'as yet unclassified') ----- createCompiledMethod | notification | [methodAndNode := myClass compile: text asString environment: Environment current notifying: requestor trailer: (myClass defaultMethodTrailerIfLogSource: logSource) ifFail: [^nil]] on: SyntaxErrorNotification do: [:exc | notification := exc. exc pass]. notification ifNotNil: [notification newSource ifNotNil: [:newSource | text := newSource]]. selector := methodAndNode selector. compiledMethod := methodAndNode method. self writeSourceToLog. priorMethodOrNil := myClass compiledMethodAt: selector ifAbsent: [nil]. ! Item was changed: + ----- Method: MethodAddition>>installMethod (in category 'compiling') ----- - ----- Method: MethodAddition>>installMethod (in category 'as yet unclassified') ----- installMethod myClass addSelectorSilently: selector withMethod: compiledMethod. ! Item was changed: + ----- Method: MethodAddition>>notifyObservers (in category 'compiling') ----- - ----- Method: MethodAddition>>notifyObservers (in category 'as yet unclassified') ----- notifyObservers SystemChangeNotifier uniqueInstance doSilently: [myClass organization classify: selector under: category suppressIfDefault: false]. priorMethodOrNil isNil ifTrue: [SystemChangeNotifier uniqueInstance methodAdded: compiledMethod selector: selector inProtocol: category class: myClass requestor: requestor] ifFalse: [SystemChangeNotifier uniqueInstance methodChangedFrom: priorMethodOrNil to: compiledMethod selector: selector inClass: myClass requestor: requestor]. "The following code doesn't seem to do anything." myClass instanceSide noteCompilationOf: selector meta: myClass isClassSide. ! Item was changed: + ----- Method: MethodAddition>>writeSourceToLog (in category 'compiling') ----- - ----- Method: MethodAddition>>writeSourceToLog (in category 'as yet unclassified') ----- writeSourceToLog logSource ifTrue: [ myClass logMethodSource: text forMethodWithNode: methodAndNode inCategory: category withStamp: changeStamp notifying: requestor. ]. !

1 0

The Trunk: MultilingualTests-pre.37.mcz
by commits＠source.squeak.org 06 Dec '18

06 Dec '18

Patrick Rein uploaded a new version of MultilingualTests to project The Trunk: http://source.squeak.org/trunk/MultilingualTests-pre.37.mcz ==================== Summary ==================== Name: MultilingualTests-pre.37 Author: pre Time: 6 December 2018, 8:26:00.740566 pm UUID: 01733a34-a005-1d4d-a679-fd99c2fe27c3 Ancestors: MultilingualTests-pre.36 Similar to the commit in Multilingual, this commit categorizes un-categorized methods and moves tests from testing to tests. =============== Diff against MultilingualTests-pre.36 =============== Item was changed: + ----- Method: FontTest>>testDisplay (in category 'tests') ----- - ----- Method: FontTest>>testDisplay (in category 'testing') ----- testDisplay "self debug: #testDisplay" | text font bb destPoint width | text := 'test' asText. font := TextStyle default fontOfSize: 21. text addAttribute: (TextFontReference toFont: font). bb := (Form extent: 100 @ 30) getCanvas privatePort. bb combinationRule: Form paint. font installOn: bb foregroundColor: Color black backgroundColor: Color white. destPoint := font displayString: text asString on: bb from: 1 to: 4 at: 0@0 kern: 1. width := text inject: 0 into: [:max :char | max + (font widthOf: char)]. self assert: destPoint x = (width + 4). "bb destForm asMorph openInHand." ! Item was changed: + ----- Method: FontTest>>testFallback (in category 'tests') ----- - ----- Method: FontTest>>testFallback (in category 'testing') ----- testFallback "self debug: #testFallback" | text font bb destPoint | text := (Character value: 257) asString asText. font := TextStyle default fontOfSize: 21. text addAttribute: (TextFontReference toFont: font). bb := (Form extent: 100 @ 30) getCanvas privatePort. bb combinationRule: Form paint. font installOn: bb foregroundColor: Color black backgroundColor: Color white. destPoint := font displayString: text asString on: bb from: 1 to: 1 at: 0@0 kern: 1. "bb destForm asMorph openInHand." self assert: destPoint x = ((font widthOf: $?) + 1). ! Item was changed: + ----- Method: FontTest>>testMultistringFallbackFont (in category 'tests') ----- - ----- Method: FontTest>>testMultistringFallbackFont (in category 'testing') ----- testMultistringFallbackFont "self debug: #testMultistringFallbackFont" | text p style height width | [(TextStyle default fontArray at: JapaneseEnvironment leadingChar) ifNil: [^ self]] ifError: [:err :rcvr | ^ self]. text := ((#(20983874 20983876 20983878 ) collect: [:e | e asCharacter]) as: String) asText. p := NewParagraph new. style := TextStyle new leading: 0; newFontArray: {Preferences standardFlapFont}. p compose: text style: style from: 1 in: (0 @ 0 corner: 100 @ 100). "See CompositionScanner>>setActualFont: & CompositionScanner>>composeFrom:inRectangle:firstLine:leftSide:rightSide:" height := style defaultFont height + style leading. width := p caretWidth + (text inject: 0 into: [:tally :next | tally + (style defaultFont widthOf: next)]). p adjustRightX. self assert: p extent = (width @ height). "Display getCanvas paragraph: p bounds: (10 @ 10 extent: 100 @ 100) color: Color black"! Item was changed: + ----- Method: FontTest>>testMultistringFont (in category 'tests') ----- - ----- Method: FontTest>>testMultistringFont (in category 'testing') ----- testMultistringFont "self debug: #testMultistringFont" | text p style height width | [(TextStyle default fontArray at: JapaneseEnvironment leadingChar) ifNil: [^ self]] ifError: [:err :rcvr | ^ self]. text := ((#(20983874 20983876 20983878 ) collect: [:e | e asCharacter]) as: String) asText. p := NewParagraph new. style := TextStyle default. p compose: text style: style from: 1 in: (0 @ 0 corner: 100 @ 100). "See CompositionScanner>>setActualFont: & CompositionScanner>>composeFrom:inRectangle:firstLine:leftSide:rightSide:" height := style defaultFont height + style leading. width := p caretWidth + (text inject: 0 into: [:tally :next | tally + (style defaultFont widthOf: next)]). p adjustRightX. self assert: p extent = (width @ height). "Display getCanvas paragraph: p bounds: (10 @ 10 extent: 100 @ 100) color: Color black"! Item was changed: + ----- Method: FontTest>>testParagraph (in category 'tests') ----- - ----- Method: FontTest>>testParagraph (in category 'testing') ----- testParagraph "self debug: #testParagraph" | text p style height width | text := 'test' asText. p := NewParagraph new. style := TextStyle default. p compose: text style: style from: 1 in: (0 @ 0 corner: 100 @ 100). "See CompositionScanner>>setActualFont: & CompositionScanner>>composeFrom:inRectangle:firstLine:leftSide:rightSide:" height := style defaultFont height + style leading. width := (text inject: 0 into: [:tally :next | tally + (style defaultFont widthOf: next)]) + p caretWidth. "because it is added by the paragraph formatting" p adjustRightX. self assert: p extent = (width @ height)! Item was changed: + ----- Method: FontTest>>testParagraphFallback (in category 'tests') ----- - ----- Method: FontTest>>testParagraphFallback (in category 'testing') ----- testParagraphFallback "self debug: #testParagraphFallback" | text p style height width e expect | e := (Character value: 257) asString. text := ('test' , e , e , e , e , 'test') asText. expect := 'test????test'. p := NewParagraph new. style := TextStyle default. p compose: text style: style from: 1 in: (0 @ 0 corner: 100 @ 100). "See CompositionScanner>>setActualFont: & CompositionScanner>>composeFrom:inRectangle:firstLine:leftSide:rightSide:" height := style defaultFont height + style leading. width := (expect inject: 0 into: [:tally :next | tally + (style defaultFont widthOf: next)]) + p caretWidth. p adjustRightX. self assert: p extent = (width @ height). "Display getCanvas paragraph: p bounds: (10 @ 10 extent: 100 @ 100) color: Color black"! Item was changed: + ----- Method: FontTest>>testResetAfterEmphasized (in category 'tests') ----- - ----- Method: FontTest>>testResetAfterEmphasized (in category 'testing') ----- testResetAfterEmphasized "self debug: #testResetAfterEmphasized" | normal derivative | normal := TextStyle defaultFont. derivative := normal emphasized: 3. self assert: (normal derivativeFonts at: 3) == derivative. normal reset. self assert: (normal derivativeFonts select:[:any| any isSynthetic]) isEmpty ! Item was changed: + ----- Method: MultiByteFileStreamTest>>expectedFailures (in category 'failures') ----- - ----- Method: MultiByteFileStreamTest>>expectedFailures (in category 'testing') ----- expectedFailures ^ #(testLineEndConversionExpectedFailures)! Item was changed: + ----- Method: MultiByteFileStreamTest>>testAsciiBackChunk (in category 'tests') ----- - ----- Method: MultiByteFileStreamTest>>testAsciiBackChunk (in category 'testing') ----- testAsciiBackChunk fileName := 'foobackchunk.txt'. MultiByteFileStream forceNewFileNamed: fileName do: [ :file | file lineEndConvention: #cr; converter: UTF8TextConverter new; cr; nextChunkPut: 'test1' printString; cr; nextChunkPut: 'test2' printString. self assert: file backChunk = (String cr , 'test2' printString); assert: file backChunk = (String cr , 'test1' printString) ]! Item was changed: + ----- Method: MultiByteFileStreamTest>>testBinaryUpTo (in category 'tests') ----- - ----- Method: MultiByteFileStreamTest>>testBinaryUpTo (in category 'testing') ----- testBinaryUpTo "This is a non regression test for bug http://bugs.squeak.org/view.php?id=6933" fileName := 'foobug6933'. MultiByteFileStream forceNewFileNamed: fileName do: [ :file | file binary; nextPutAll: #[ 1 2 3 4 ] ]. MultiByteFileStream oldFileNamed: fileName do: [ :file | file binary. self assert: (file upTo: 3) = #[ 1 2 ] ]! Item was changed: + ----- Method: MultiByteFileStreamTest>>testByteTextConverter (in category 'tests') ----- - ----- Method: MultiByteFileStreamTest>>testByteTextConverter (in category 'testing') ----- testByteTextConverter | byteCharacters converterClasses | byteCharacters := Character allByteCharacters. converterClasses := ByteTextConverter allSubclasses copyWithoutAll: {ISO8859TextConverter . WinCPTextConverter . MacOSCPTextConverter}. converterClasses do: [ :converterClass | | converter stream encoded decoded encoded2 | converter := converterClass new. stream := byteCharacters readStream. "Find bytes that can be decoded by this converter." encoded := byteCharacters select: [ :e | (converter nextFromStream: stream) notNil ]. "Decode those bytes." stream := encoded readStream. decoded := encoded collect: [ :e | converter nextFromStream: stream ]. self assert: stream atEnd. "Re-encode the decoded bytes using #nextPutAll:toStream:, and check if they match the original bytes." encoded2 := String streamContents: [ :writeStream | converter nextPutAll: decoded toStream: writeStream ]. encoded with: encoded2 do: [ :original :reencoded | self assert: original charCode = reencoded charCode description: [ '{1} could not decode or re-encode {2} using #nextPutAll:toStream:. Instead, it yielded {3}.' format: { converterClass name. original charCode. reencoded charCode } ] ]. "Re-encode the decoded bytes using #nextPut:toStream:, and check if they match the original bytes." encoded2 := String streamContents: [ :writeStream | decoded do: [:e | converter nextPut: e toStream: writeStream ] ]. encoded with: encoded2 do: [ :original :reencoded | self assert: original charCode = reencoded charCode description: [ '{1} could not decode or re-encode {2} using #nextPut:toStream:. Instead, it yielded {3}.' format: { converterClass name. original charCode. reencoded charCode } ] ] ]! Item was changed: + ----- Method: MultiByteFileStreamTest>>testLineEndConversion (in category 'tests') ----- - ----- Method: MultiByteFileStreamTest>>testLineEndConversion (in category 'testing') ----- testLineEndConversion | failures | fileName := 'foolinendconversion.txt'. failures := OrderedCollection new. self textConvertersWithLineEndConversionSupport do: [ :textConverterClass | textConverterClass encodingNames ifNotEmpty: [ #(cr lf crlf) do: [ :lineEndConvention | self testLineEndConvention: lineEndConvention withConverter: textConverterClass ifFail: [ :expectedResult :result | failures add: { textConverterClass. lineEndConvention. expectedResult. result } ] ] ] ]. self assert: failures isEmpty. "The code below is here to help you see why those cases fail" failures do: [ :failure | self testLineEndConvention: failure second withConverter: failure first ifFail: [ :expectedResult :result | self halt ] ].! Item was changed: + ----- Method: MultiByteFileStreamTest>>testLineEndConversionExpectedFailures (in category 'tests') ----- - ----- Method: MultiByteFileStreamTest>>testLineEndConversionExpectedFailures (in category 'testing') ----- testLineEndConversionExpectedFailures "Copy of #testLineEndConversion checking for missing line conversion implementations. This test and corresponding helpers (see senders) can be removed as soon as all TextConverters support line end conversion. --fn" | failures | fileName := 'foolinendconversion_failures.txt'. failures := OrderedCollection new. self textConvertersWithoutLineEndConversionSupport do: [ :textConverterClass | textConverterClass encodingNames ifNotEmpty: [ #(cr lf crlf) do: [ :lineEndConvention | self testLineEndConvention: lineEndConvention withConverter: textConverterClass ifFail: [ :expectedResult :result | failures add: { textConverterClass. lineEndConvention. expectedResult. result } ] ] ] ]. self assert: failures isEmpty. "The code below is here to help you see why those cases fail" failures do: [ :failure | self testLineEndConvention: failure second withConverter: failure first ifFail: [ :expectedResult :result | self halt ] ].! Item was changed: + ----- Method: MultiByteFileStreamTest>>testLineEnding (in category 'tests') ----- - ----- Method: MultiByteFileStreamTest>>testLineEnding (in category 'testing') ----- testLineEnding fileName := 'foolinend.txt'. MultiByteFileStream forceNewFileNamed: fileName do: [ :file | file wantsLineEndConversion: false; nextPutAll: 'line 1'; cr; nextPutAll: 'line 2'; crlf; nextPutAll: 'line 3'; lf; nextPutAll: 'line 4' ]. { {#cr. 'line 1' , String cr , 'line 2' , String cr , 'line 3' , String cr , 'line 4'}. {#lf. 'line 1' , String cr , 'line 2' , String cr , 'line 3' , String cr , 'line 4'}. {#crlf. 'line 1' , String cr , 'line 2' , String cr , 'line 3' , String cr , 'line 4'}. {nil. 'line 1' , String cr , 'line 2' , String crlf , 'line 3' , String lf , 'line 4'} } do: [:lineEndingResult | MultiByteFileStream oldFileNamed: fileName do: [ :file | file lineEndConvention: lineEndingResult first. self assert: file upToEnd = lineEndingResult last ] ]! Item was changed: + ----- Method: MultiByteFileStreamTest>>testLineEndingChunk (in category 'tests') ----- - ----- Method: MultiByteFileStreamTest>>testLineEndingChunk (in category 'testing') ----- testLineEndingChunk | failures | fileName := 'foolinend.txt'. failures := OrderedCollection new. MultiByteFileStream forceNewFileNamed: fileName do: [ :file | file wantsLineEndConversion: false; nextPutAll: 'line 1'; cr; nextPutAll: 'line 2'; crlf; nextPutAll: 'line 3'; lf; nextPutAll: 'line 4'; nextPut: $!! ]. { {#cr. 'line 1' , String cr , 'line 2' , String cr , 'line 3' , String cr , 'line 4'}. {#lf. 'line 1' , String cr , 'line 2' , String cr , 'line 3' , String cr , 'line 4'}. {#crlf. 'line 1' , String cr , 'line 2' , String cr , 'line 3' , String cr , 'line 4'}. {nil. 'line 1' , String cr , 'line 2' , String crlf , 'line 3' , String lf , 'line 4'} } do: [:lineEndingResult | MultiByteFileStream oldFileNamed: fileName do: [ :file | | actual | file lineEndConvention: lineEndingResult first. lineEndingResult last = (actual := file nextChunk) ifFalse: [ failures add: (lineEndingResult copyWith: actual). ]. ] ]. self assert: failures isEmpty! Item was changed: + ----- Method: MultiByteFileStreamTest>>testLineEndingWithWideStrings (in category 'tests') ----- - ----- Method: MultiByteFileStreamTest>>testLineEndingWithWideStrings (in category 'testing') ----- testLineEndingWithWideStrings | cr lf crlf | fileName := 'foolinend.txt'. cr := String cr asWideString. lf := String lf asWideString. crlf := String crlf asWideString. MultiByteFileStream forceNewFileNamed: fileName do: [ :file | file wantsLineEndConversion: false; nextPutAll: 'line 1'; nextPutAll: cr; nextPutAll: 'line 2'; nextPutAll: crlf; nextPutAll: 'line 3'; nextPutAll: lf; nextPutAll: 'line 4' ]. { {#cr. 'line 1' , String cr , 'line 2' , String cr , 'line 3' , String cr , 'line 4'}. {#lf. 'line 1' , String cr , 'line 2' , String cr , 'line 3' , String cr , 'line 4'}. {#crlf. 'line 1' , String cr , 'line 2' , String cr , 'line 3' , String cr , 'line 4'}. {nil. 'line 1' , String cr , 'line 2' , String crlf , 'line 3' , String lf , 'line 4'} } do: [ :lineEndingResult | MultiByteFileStream oldFileNamed: fileName do: [ :file | file lineEndConvention: lineEndingResult first. self assert: file upToEnd = lineEndingResult last ] ]! Item was changed: + ----- Method: MultiByteFileStreamTest>>testMultiByteTextConverter (in category 'tests') ----- - ----- Method: MultiByteFileStreamTest>>testMultiByteTextConverter (in category 'testing') ----- testMultiByteTextConverter | strings converterClasses | strings := { String newFrom: ((0 to: 255) collect: [:e | Unicode value: e]). String newFrom: ((0 to: 1023) collect: [:e | Unicode value: e]). }. converterClasses := { UTF8TextConverter . UTF16TextConverter . "CompoundTextConverter ." "EUCJPTextConverter . CNGBTextConverter . ShiftJISTextConverter . EUCKRTextConverter"}. converterClasses do: [:converterClass | strings do: [:string | | converter stream | converter := converterClass new. stream := String new writeStream. converter nextPutAll: string toStream: stream. stream := stream contents readStream. string do: [:e | | decoded | decoded := converter nextFromStream: stream. self assert: e charCode = decoded charCode]. self assert: stream atEnd. stream := String new writeStream. string do: [:e | converter nextPut: e toStream: stream]. stream := stream contents readStream. string do: [:e | | decoded | decoded := converter nextFromStream: stream. self assert: e charCode = decoded charCode]. self assert: stream atEnd]]! Item was changed: + ----- Method: MultiByteFileStreamTest>>testNextLine (in category 'tests') ----- - ----- Method: MultiByteFileStreamTest>>testNextLine (in category 'testing') ----- testNextLine fileName := 'foonextline.txt'. MultiByteFileStream forceNewFileNamed: fileName do: [ :file | file wantsLineEndConversion: false; nextPutAll: 'line 1'; cr; nextPutAll: 'line 2'; crlf; nextPutAll: 'line 3'; lf; nextPutAll: 'line 4' ]. #(cr lf crlf nil) do: [:lineEnding | MultiByteFileStream oldFileNamed: fileName do: [ :file | file lineEndConvention: lineEnding. self assert: file nextLine = 'line 1'; assert: file nextLine = 'line 2'; assert: file nextLine = 'line 3'; assert: file nextLine = 'line 4'; assert: file nextLine = nil ] ]! Item was changed: + ----- Method: MultiByteFileStreamTest>>testNextPutAllStartingAt (in category 'tests') ----- - ----- Method: MultiByteFileStreamTest>>testNextPutAllStartingAt (in category 'testing') ----- testNextPutAllStartingAt | result | fileName := 'foonextputallstartingat.txt'. MultiByteFileStream forceNewFileNamed: fileName do: [ :file | { 'abcde' asWideString. 'abcde' } do: [ :string | file next: 1 putAll: string startingAt: 5; next: 3 putAll: string startingAt: 2; next: 1 putAll: string startingAt: 1 ] ]. result := StandardFileStream readOnlyFileNamed: fileName do: [ :file | file binary; contents ]. self assert: #[101 98 99 100 97 101 98 99 100 97] equals: result ! Item was changed: + ----- Method: MultiByteFileStreamTest>>testNextPutAllUtfsStartingAt (in category 'tests') ----- - ----- Method: MultiByteFileStreamTest>>testNextPutAllUtfsStartingAt (in category 'testing') ----- testNextPutAllUtfsStartingAt | result | fileName := 'foonextputallstartingat.txt'. {'utf-16' . #[0 64 216 0 220 0 216 0 220 1 216 0 220 2] . 'utf-32'. #[0 0 0 64 0 1 0 0 0 1 0 1 0 1 0 2]} pairsDo: [:encodingName :encodingResult | MultiByteFileStream forceNewFileNamed: fileName do: [ :file | | string | file converter: (TextConverter newForEncoding: encodingName). string := self unicodeString. file next: 2 putAll: string startingAt: 1; next: 1 putAll: string startingAt: 3; next: 1 putAll: string startingAt: 4 ]. result := StandardFileStream readOnlyFileNamed: fileName do: [ :file | file binary; contents ]. "See for example: https://unicode-table.com/de/10000/ --pre" self assert: encodingResult equals: result] ! Item was changed: + ----- Method: MultiByteFileStreamTest>>testNonAsciiBackChunk (in category 'tests') ----- - ----- Method: MultiByteFileStreamTest>>testNonAsciiBackChunk (in category 'testing') ----- testNonAsciiBackChunk "Note: this is an expected failure: MultiByteFileStream is not equipped to read back non ASCII String... (no comment) As a consequence, never use non ASCII in method category nor in your initials. That would make a few tools blind..." fileName := 'foobackchunk.txt'. MultiByteFileStream forceNewFileNamed: fileName do: [ :file | file lineEndConvention: #cr; converter: UTF8TextConverter new; cr; nextChunkPut: 'testé' printString; cr; nextChunkPut: 'test' printString. self assert: file backChunk = (String cr , 'test' printString). self assert: file backChunk = (String cr , 'testé' printString) ]! Item was changed: + ----- Method: MultiByteFileStreamTest>>testUpToAllAscii (in category 'tests') ----- - ----- Method: MultiByteFileStreamTest>>testUpToAllAscii (in category 'testing') ----- testUpToAllAscii "This test case is inspired by Mantis #4665." "Compare to testUpToAllUtf." | resultA resultB | fileName :='testUpToAll.in'. FileDirectory default forceNewFileNamed: fileName do: [ :out | out nextPutAll: 'A<'. "Encodes to byte sequence 413C" ]. resultA := FileDirectory default readOnlyFileNamed: fileName do: [ :in | in upToAll: '<' ]. resultB := FileDirectory default readOnlyFileNamed: fileName do: [ :in | in upTo: $< ]. self assert: resultA = resultB ! Item was changed: + ----- Method: MultiByteFileStreamTest>>testUpToAllNonZeroLength (in category 'tests') ----- - ----- Method: MultiByteFileStreamTest>>testUpToAllNonZeroLength (in category 'testing') ----- testUpToAllNonZeroLength "Ensures that upToAll: correctly skips over the nonzero-length separator." fileName :='testUpToAll.in'. FileDirectory default forceNewFileNamed: fileName do: [ :out | out nextPutAll: 231 asCharacter asString, 'a<b<<c' ]. FileDirectory default readOnlyFileNamed: fileName do: [ :in | self assert: in next = 231 asCharacter. self assert: (in upToAll: '<<') = 'a<b'. self assert: in next = $c ]! Item was changed: + ----- Method: MultiByteFileStreamTest>>testUpToAllUtf (in category 'tests') ----- - ----- Method: MultiByteFileStreamTest>>testUpToAllUtf (in category 'testing') ----- testUpToAllUtf "This test case is adapted from Mantis #4665." "MultiByteFileStream was relying on PositionableStream>>#match: to discover the position immediately following the delimiter collection. It would then use #next: to retrieve a number of *characters* computed as the difference in stream positions. However, stream positions are measured in *bytes*, not characters, so this would lead to misalignment when the skipped text included UTF-8 encoded characters." | resultA resultB | fileName :='testUpToAll.in'. FileDirectory default forceNewFileNamed: fileName do: [ :out | out nextPutAll: 231 asCharacter asString, '<'. "Encodes to byte sequence C3A73C" ]. resultA := FileDirectory default readOnlyFileNamed: fileName do: [ :in | in upToAll: '<' ]. resultB := FileDirectory default readOnlyFileNamed: fileName do: [ :in | in upTo: $< ]. self assert: resultA = resultB ! Item was changed: + ----- Method: MultiByteFileStreamTest>>testUpToAllZeroLength (in category 'tests') ----- - ----- Method: MultiByteFileStreamTest>>testUpToAllZeroLength (in category 'testing') ----- testUpToAllZeroLength "Ensures that upToAll: behaves correctly with a zero-length separator." fileName :='testUpToAll.in'. FileDirectory default forceNewFileNamed: fileName do: [ :out | out nextPutAll: 231 asCharacter asString, 'a<b<<c' ]. FileDirectory default readOnlyFileNamed: fileName do: [ :in | self assert: in next = 231 asCharacter. self assert: (in upToAll: '') = ''. self assert: in next = $a ]! Item was changed: + ----- Method: MultiByteFileStreamTest>>testUpToPositionNonZero (in category 'tests') ----- - ----- Method: MultiByteFileStreamTest>>testUpToPositionNonZero (in category 'testing') ----- testUpToPositionNonZero "Ensures that upToPosition: behaves correctly with a non-zero-length read." fileName := 'testUpToPosition.in'. FileDirectory default forceNewFileNamed: fileName do: [ :out | out nextPutAll: 231 asCharacter asString, 'a<b' ]. FileDirectory default readOnlyFileNamed: fileName do: [ :in | self assert: in next = 231 asCharacter. self assert: (in upToPosition: in position + 2) = 'a<'. self assert: in next = $b ]! Item was changed: + ----- Method: MultiByteFileStreamTest>>testUpToPositionZero (in category 'tests') ----- - ----- Method: MultiByteFileStreamTest>>testUpToPositionZero (in category 'testing') ----- testUpToPositionZero "Ensures that upToPosition: behaves correctly with a zero-length read." fileName := 'testUpToPosition.in'. FileDirectory default forceNewFileNamed: fileName do: [ :out | out nextPutAll: 231 asCharacter asString, 'a<b' ]. FileDirectory default readOnlyFileNamed: fileName do: [ :in | self assert: in next = 231 asCharacter. self assert: (in upToPosition: in position) = ''. self assert: in next = $a ]! Item was removed: - ----- Method: UTF16TextConverterTest>>testByteOrders (in category 'testing') ----- - testByteOrders - |converter originalText bytes decodedText | - originalText := 'test'. - converter := UTF16TextConverter new. - - "Default (ie useLittleEndian instvar nil)" - bytes := (originalText convertToWithConverter: converter). - decodedText := bytes convertFromWithConverter: converter. - - self assert: originalText equals: decodedText. - - "Little-endian" - converter useLittleEndian: true. - - bytes := (originalText convertToWithConverter: converter). - decodedText := bytes convertFromWithConverter: converter. - - self assert: originalText equals: decodedText. - - "Big-endian" - converter useLittleEndian: false. - - bytes := (originalText convertToWithConverter: converter). - decodedText := bytes convertFromWithConverter: converter. - - self assert: originalText equals: decodedText. - - ! Item was changed: + ----- Method: UTF8EdgeCaseTest>>expectBytesToFailDecoding: (in category 'tests') ----- - ----- Method: UTF8EdgeCaseTest>>expectBytesToFailDecoding: (in category 'asserting') ----- expectBytesToFailDecoding: aByteArray self should: [aByteArray utf8Decoded] raise: InvalidUTF8! Item was changed: + ----- Method: UTF8EdgeCaseTest>>expectHex:toDecodeToCodepoint: (in category 'tests') ----- - ----- Method: UTF8EdgeCaseTest>>expectHex:toDecodeToCodepoint: (in category 'asserting') ----- expectHex: aString toDecodeToCodepoint: anInteger self expectHex: aString toDecodeToCodepoints: { anInteger } ! Item was changed: + ----- Method: UTF8EdgeCaseTest>>expectHex:toDecodeToCodepoints: (in category 'tests') ----- - ----- Method: UTF8EdgeCaseTest>>expectHex:toDecodeToCodepoints: (in category 'asserting') ----- expectHex: aString toDecodeToCodepoints: anArray | s | s := (ByteArray readHexFrom: aString) utf8Decoded. self assert: anArray size equals: s size. self assert: anArray asArray equals: (s asArray collect: [:c | c asInteger]).! Item was changed: + ----- Method: UTF8EdgeCaseTest>>expectHexToFailDecoding: (in category 'tests') ----- - ----- Method: UTF8EdgeCaseTest>>expectHexToFailDecoding: (in category 'asserting') ----- expectHexToFailDecoding: aString self should: [(ByteArray readHexFrom: aString) utf8Decoded] raise: InvalidUTF8. ! Item was changed: + ----- Method: UTFTextConverterWithByteOrderTest class>>isAbstract (in category 'testing') ----- - ----- Method: UTFTextConverterWithByteOrderTest class>>isAbstract (in category 'as yet unclassified') ----- isAbstract ^ self = UTFTextConverterWithByteOrderTest!

1 0

The Trunk: Multilingual-pre.242.mcz
by commits＠source.squeak.org 06 Dec '18

06 Dec '18

Patrick Rein uploaded a new version of Multilingual to project The Trunk: http://source.squeak.org/trunk/Multilingual-pre.242.mcz ==================== Summary ==================== Name: Multilingual-pre.242 Author: pre Time: 6 December 2018, 8:22:23.246566 pm UUID: 9725107c-37e5-7648-b92a-69cd64ef2a9f Ancestors: Multilingual-pre.241 In the spirit of a more approachable Squeak this commit classifies all unclassified methods in Multilingual and re-categorizes some misplaced methods. There are also two tiny refactorings in this commit. =============== Diff against Multilingual-pre.241 =============== Item was changed: + ----- Method: CP1250ClipboardInterpreter>>fromSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: CP1250ClipboardInterpreter>>fromSystemClipboard: (in category 'as yet unclassified') ----- fromSystemClipboard: aString | result converter | result := WriteStream on: (String new: aString size). converter := CP1250TextConverter new. aString do: [:each | result nextPut: (converter toSqueak: each macToSqueak) asCharacter. ]. ^ result contents. ! Item was changed: + ----- Method: CP1250ClipboardInterpreter>>toSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: CP1250ClipboardInterpreter>>toSystemClipboard: (in category 'as yet unclassified') ----- toSystemClipboard: aString | result converter | aString isAsciiString ifTrue: [^ aString asOctetString]. "optimization" result := WriteStream on: (String new: aString size). converter := CP1250TextConverter new. aString do: [:each | | r | r := converter fromSqueak: each. r charCode < 255 ifTrue: [ result nextPut: r squeakToMac]]. ^ result contents. ! Item was changed: + ----- Method: CP1250InputInterpreter>>initialize (in category 'initialize-release') ----- - ----- Method: CP1250InputInterpreter>>initialize (in category 'as yet unclassified') ----- initialize converter := CP1250TextConverter new. ! Item was changed: + ----- Method: CP1250InputInterpreter>>nextCharFrom:firstEvt: (in category 'keyboard') ----- - ----- Method: CP1250InputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') ----- nextCharFrom: sensor firstEvt: evtBuf "Input from the Czech keyboard under Windows doesn't correspond to cp-1250 or iso-8859-2 encoding!!" | keyValue | keyValue := evtBuf third. ^ converter toSqueak: keyValue asCharacter macToSqueak. ! Item was changed: + ----- Method: ClipboardInterpreter>>fromSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: ClipboardInterpreter>>fromSystemClipboard: (in category 'as yet unclassified') ----- fromSystemClipboard: aString self subclassResponsibility. ! Item was changed: + ----- Method: ClipboardInterpreter>>toSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: ClipboardInterpreter>>toSystemClipboard: (in category 'as yet unclassified') ----- toSystemClipboard: aString self subclassResponsibility. ! Item was changed: + ----- Method: EFontBDFFontReader>>readCharactersInRangeFrom:to:totalNums:storeInto: (in category 'reading') ----- - ----- Method: EFontBDFFontReader>>readCharactersInRangeFrom:to:totalNums:storeInto: (in category 'as yet unclassified') ----- readCharactersInRangeFrom: start to: stop totalNums: upToNum storeInto: chars | array form code | 1 to: upToNum do: [:i | array := self readOneCharacter. code := array at: 2. code > stop ifTrue: [^ self]. (code between: start and: stop) ifTrue: [ form := array at: 1. form ifNotNil: [ chars add: array. ]. ]. ]. ! Item was changed: + ----- Method: EFontBDFFontReader>>readFrom:to: (in category 'reading') ----- - ----- Method: EFontBDFFontReader>>readFrom:to: (in category 'as yet unclassified') ----- readFrom: start to: end | xTable glyphs ascent descent chars charsNum height form blt lastAscii pointSize ret lastValue encoding bbx strikeWidth minAscii maxAscii maxWidth | form := encoding := bbx := nil. self initialize. self readAttributes. height := Integer readFromString: ((properties at: #FONTBOUNDINGBOX) at: 2). ascent := Integer readFromString: (properties at: #'FONT_ASCENT') first. descent := Integer readFromString: (properties at: #'FONT_DESCENT') first. (properties includesKey: #'POINT_SIZE') ifTrue: [ pointSize := (Integer readFromString: (properties at: #'POINT_SIZE') first) // 10. ] ifFalse: [ pointSize := (ascent + descent) * 72 // 96. ]. maxWidth := 0. minAscii := 16r200000. strikeWidth := 0. maxAscii := 0. charsNum := Integer readFromString: (properties at: #CHARS) first. chars := Set new: charsNum. self readCharactersInRangeFrom: start to: end totalNums: charsNum storeInto: chars. chars := chars sorted: [:x :y | (x at: 2) <= (y at: 2)]. charsNum := chars size. "undefined encodings make this different" chars do: [:array | | width | encoding := array at: 2. bbx := array at: 3.. width := bbx at: 1. maxWidth := maxWidth max: width. minAscii := minAscii min: encoding. maxAscii := maxAscii max: encoding. strikeWidth := strikeWidth + width. ]. glyphs := Form extent: strikeWidth@height. blt := BitBlt toForm: glyphs. "xTable := XTableForUnicodeFont new ranges: (Array with: (Array with: start with: end))." xTable := SparseLargeTable new: end + 3 chunkSize: 32 arrayClass: Array base: start + 1 defaultValue: -1. lastAscii := start. 1 to: charsNum do: [:i | form := (chars at: i) first. encoding := (chars at: i) second. bbx := (chars at: i) third. "lastAscii+1 to: encoding-1 do: [:a | xTable at: a+2 put: (xTable at: a+1)]." lastValue := xTable at: lastAscii + 1 + 1. xTable at: encoding + 1 put: lastValue. blt copy: (((xTable at: encoding+1)@(ascent - (bbx at: 2) - (bbx at: 4))) extent: (bbx at: 1)@(bbx at: 2)) from: 0@0 in: form. xTable at: encoding+2 put: (xTable at: encoding+1)+(bbx at: 1). lastAscii := encoding. ]. xTable zapDefaultOnlyEntries. ret := Array new: 8. ret at: 1 put: xTable. ret at: 2 put: glyphs. ret at: 3 put: minAscii. ret at: 4 put: maxAscii. ret at: 5 put: maxWidth. ret at: 6 put: ascent. ret at: 7 put: descent. ret at: 8 put: pointSize. ^ret. " ^{xTable. glyphs. minAscii. maxAscii. maxWidth. ascent. descent. pointSize}" ! Item was changed: + ----- Method: EFontBDFFontReaderForRanges class>>rangesForGreek (in category 'ranges') ----- - ----- Method: EFontBDFFontReaderForRanges class>>rangesForGreek (in category 'as yet unclassified') ----- rangesForGreek ^ { Array with: 16r1 with: 16rFF. Array with: 16r370 with: 16r3FF. Array with: 16r1F00 with: 16r1FFF. Array with: 16r2000 with: 16r206F. Array with: 16r20A0 with: 16r20AF }. ! Item was changed: + ----- Method: EFontBDFFontReaderForRanges class>>rangesForLatin2 (in category 'ranges') ----- - ----- Method: EFontBDFFontReaderForRanges class>>rangesForLatin2 (in category 'as yet unclassified') ----- rangesForLatin2 ^ { Array with: 0 with: 16r17F. Array with: 16r2B0 with: 16r2FF. Array with: 16r2000 with: 16r206F. Array with: 16r2122 with: 16r2122. Array with: 16rFFFF with: 16rFFFF. "sentinel" }. ! Item was changed: + ----- Method: EFontBDFFontReaderForRanges>>additionalRangesForJapanese (in category 'ranges') ----- - ----- Method: EFontBDFFontReaderForRanges>>additionalRangesForJapanese (in category 'as yet unclassified') ----- additionalRangesForJapanese | basics | basics := { Array with: 16r5C with: 16rFF3C. Array with: 16r3013 with: 16rFFFD. }. ^ basics ! Item was changed: + ----- Method: EFontBDFFontReaderForRanges>>additionalRangesForKorean (in category 'ranges') ----- - ----- Method: EFontBDFFontReaderForRanges>>additionalRangesForKorean (in category 'as yet unclassified') ----- additionalRangesForKorean | basics | basics := { Array with: 16rA1 with: 16rFFE6C. Array with: 16r3000 with: 16rFFFD. }. ^ basics ! Item was changed: + ----- Method: EFontBDFFontReaderForRanges>>override:with:ranges:transcodingTable:additionalRange: (in category 'ranges') ----- - ----- Method: EFontBDFFontReaderForRanges>>override:with:ranges:transcodingTable:additionalRange: (in category 'as yet unclassified') ----- override: chars with: otherFileName ranges: pairArray transcodingTable: table additionalRange: additionalRange | other rangeStream newChars currentRange | other := BDFFontReader openFileNamed: otherFileName. rangeStream := ReadStream on: pairArray. currentRange := rangeStream next. newChars := PluggableSet new. newChars hashBlock: [:elem | (elem at: 2) hash]. newChars equalBlock: [:a :b | (a at: 2) = (b at: 2)]. other readChars do: [:array | | code u j form | code := array at: 2. "code printStringHex printString displayAt: 0@0." code > currentRange last ifTrue: [ [rangeStream atEnd not and: [currentRange := rangeStream next. currentRange last < code]] whileTrue. rangeStream atEnd ifTrue: [ newChars addAll: chars. ^ newChars. ]. ]. (code between: currentRange first and: currentRange last) ifTrue: [ form := array at: 1. form ifNotNil: [ j := array at: 2. u := table at: (((j // 256) - 33 * 94 + ((j \\ 256) - 33)) + 1). u ~= -1 ifTrue: [ array at: 2 put: u. newChars add: array. additionalRange do: [:e | | newArray | e first = (array at: 2) ifTrue: [ newArray := array shallowCopy. newArray at: 2 put: e second. newChars add: newArray ]. ] ]. ]. ]. ]. self error: 'should not reach here'. ! Item was changed: + ----- Method: EFontBDFFontReaderForRanges>>rangesForGreek (in category 'ranges') ----- - ----- Method: EFontBDFFontReaderForRanges>>rangesForGreek (in category 'as yet unclassified') ----- rangesForGreek + ^ self class rangesForGreek - ^ { - Array with: 16r1 with: 16rFF. - Array with: 16r370 with: 16r3FF. - Array with: 16r1F00 with: 16r1FFF. - Array with: 16r2000 with: 16r206F. - Array with: 16r20A0 with: 16r20AF - }. ! Item was changed: + ----- Method: EFontBDFFontReaderForRanges>>rangesForJapanese (in category 'ranges') ----- - ----- Method: EFontBDFFontReaderForRanges>>rangesForJapanese (in category 'as yet unclassified') ----- rangesForJapanese | basics etc | basics := { Array with: 16r5C with: 16r5C. Array with: 16rA2 with: 16rA3. Array with: 16rA7 with: 16rA8. Array with: 16rAC with: 16rAC. Array with: 16rB0 with: 16rB1. Array with: 16rB4 with: 16rB4. Array with: 16rB6 with: 16rB6. Array with: 16rD7 with: 16rD7. Array with: 16rF7 with: 16rF7 }. etc := { Array with: 16r370 with: 16r3FF. "greek" Array with: 16r400 with: 16r52F. "cyrillic" Array with: 16r1D00 with: 16r1D7F. "phonetic" Array with: 16r1E00 with: 16r1EFF. "latin extended additional" Array with: 16r2000 with: 16r206F. "general punctuation" Array with: 16r20A0 with: 16r20CF. "currency symbols" Array with: 16r2100 with: 16r214F. "letterlike" Array with: 16r2150 with: 16r218F. "number form" Array with: 16r2190 with: 16r21FF. "arrows" Array with: 16r2200 with: 16r22FF. "math operators" Array with: 16r2300 with: 16r23FF. "misc tech" Array with: 16r2460 with: 16r24FF. "enclosed alnum" Array with: 16r2500 with: 16r257F. "box drawing" Array with: 16r2580 with: 16r259F. "box elem" Array with: 16r25A0 with: 16r25FF. "geometric shapes" Array with: 16r2600 with: 16r26FF. "misc symbols" Array with: 16r2700 with: 16r27BF. "dingbats" Array with: 16r27C0 with: 16r27EF. "misc math A" Array with: 16r27F0 with: 16r27FF. "supplimental arrow A" Array with: 16r2900 with: 16r297F. "supplimental arrow B" Array with: 16r2980 with: 16r29FF. "misc math B" Array with: 16r2A00 with: 16r2AFF. "supplimental math op" Array with: 16r2900 with: 16r297F. "supplimental arrow B" Array with: 16r2E80 with: 16r2EFF. "cjk radicals suppliment" Array with: 16r2F00 with: 16r2FDF. "kangxi radicals" Array with: 16r3000 with: 16r303F. "cjk symbols" Array with: 16r3040 with: 16r309F. "hiragana" Array with: 16r30A0 with: 16r30FF. "katakana" Array with: 16r3190 with: 16r319F. "kanbun" Array with: 16r31F0 with: 16r31FF. "katakana extension" Array with: 16r3200 with: 16r32FF. "enclosed CJK" Array with: 16r3300 with: 16r33FF. "CJK compatibility" Array with: 16r3400 with: 16r4DBF. "CJK unified extension A" Array with: 16r4E00 with: 16r9FAF. "CJK ideograph" Array with: 16rF900 with: 16rFAFF. "CJK compatiblity ideograph" Array with: 16rFE30 with: 16rFE4F. "CJK compatiblity forms" Array with: 16rFF00 with: 16rFFEF. "half and full" Array with: 16rFFFF with: 16rFFFF. "sentinel" }. ^ basics, etc. ! Item was changed: + ----- Method: EFontBDFFontReaderForRanges>>rangesForKorean (in category 'ranges') ----- - ----- Method: EFontBDFFontReaderForRanges>>rangesForKorean (in category 'as yet unclassified') ----- rangesForKorean | basics etc | basics := { Array with: 16rA1 with: 16rFF }. etc := { Array with: 16r100 with: 16r17F. "extended latin" Array with: 16r370 with: 16r3FF. "greek" Array with: 16r400 with: 16r52F. "cyrillic" Array with: 16r2000 with: 16r206F. "general punctuation" Array with: 16r2100 with: 16r214F. "letterlike" Array with: 16r2150 with: 16r218F. "number form" Array with: 16r2190 with: 16r21FF. "arrows" Array with: 16r2200 with: 16r22FF. "math operators" Array with: 16r2300 with: 16r23FF. "misc tech" Array with: 16r2460 with: 16r24FF. "enclosed alnum" Array with: 16r2500 with: 16r257F. "box drawing" Array with: 16r2580 with: 16r259F. "box elem" Array with: 16r25A0 with: 16r25FF. "geometric shapes" Array with: 16r2600 with: 16r26FF. "misc symbols" Array with: 16r3000 with: 16r303F. "cjk symbols" Array with: 16r3040 with: 16r309F. "hiragana" Array with: 16r30A0 with: 16r30FF. "katakana" Array with: 16r3190 with: 16r319F. "kanbun" Array with: 16r31F0 with: 16r31FF. "katakana extension" Array with: 16r3200 with: 16r32FF. "enclosed CJK" Array with: 16r3300 with: 16r33FF. "CJK compatibility" Array with: 16r4E00 with: 16r9FAF. "CJK ideograph" Array with: 16rAC00 with: 16rD7AF. "Hangul Syllables" Array with: 16rF900 with: 16rFAFF. "CJK compatiblity ideograph" Array with: 16rFF00 with: 16rFFEF. "half and full" }. ^ basics, etc. ! Item was changed: + ----- Method: EFontBDFFontReaderForRanges>>rangesForLatin2 (in category 'ranges') ----- - ----- Method: EFontBDFFontReaderForRanges>>rangesForLatin2 (in category 'as yet unclassified') ----- rangesForLatin2 ^ { Array with: 0 with: 16r17F. Array with: 16r2B0 with: 16r2FF. Array with: 16r2000 with: 16r206F. Array with: 16r2122 with: 16r2122. Array with: 16rFFFF with: 16rFFFF. "sentinel" }. ! Item was added: + ----- Method: EFontBDFFontReaderForRanges>>readCharactersInRanges2:storeInto: (in category 'reading') ----- + readCharactersInRanges2: ranges storeInto: chars + + | array form code rangeStream in | + rangeStream := ReadStream on: ranges. + [true] whileTrue: [ + array := self readOneCharacter. + array second ifNil: [^ self]. + code := array at: 2. + in := false. + ranges do: [:range | + (code between: range first and: range last) ifTrue: [ + in := true. + ]. + ]. + in ifTrue: [ + form := array at: 1. + form ifNotNil: [ + chars add: array. + ]. + ]. + ]. + ! Item was changed: + ----- Method: EFontBDFFontReaderForRanges>>readCharactersInRanges:storeInto: (in category 'reading') ----- - ----- Method: EFontBDFFontReaderForRanges>>readCharactersInRanges:storeInto: (in category 'as yet unclassified') ----- readCharactersInRanges: ranges storeInto: chars | array form code rangeStream currentRange | rangeStream := ReadStream on: ranges. currentRange := rangeStream next. [ array := self readOneCharacter. array second ifNil: [^ self]. code := array at: 2. code > currentRange last ifTrue: [ [rangeStream atEnd not and: [currentRange := rangeStream next. currentRange last < code]] whileTrue. rangeStream atEnd ifTrue: [^ self]. ]. (code between: currentRange first and: currentRange last) ifTrue: [ form := array at: 1. form ifNotNil: [ chars add: array. ]. ]. ] repeat ! Item was changed: + ----- Method: EFontBDFFontReaderForRanges>>readRanges: (in category 'reading') ----- - ----- Method: EFontBDFFontReaderForRanges>>readRanges: (in category 'as yet unclassified') ----- readRanges: ranges | xTable glyphs ascent descent chars charsNum height form blt lastAscii pointSize ret lastValue start end encoding bbx strikeWidth minAscii maxAscii maxWidth | form := encoding := bbx := nil. self initialize. self readAttributes. height := Integer readFromString: ((properties at: #FONTBOUNDINGBOX) at: 2). ascent := Integer readFromString: (properties at: #'FONT_ASCENT') first. descent := Integer readFromString: (properties at: #'FONT_DESCENT') first. (properties includesKey: #'POINT_SIZE') ifTrue: [ pointSize := (Integer readFromString: (properties at: #'POINT_SIZE') first) // 10. ] ifFalse: [ pointSize := (ascent + descent) * 72 // 96. ]. maxWidth := 0. minAscii := 16r200000. strikeWidth := 0. maxAscii := 0. charsNum := Integer readFromString: (properties at: #CHARS) first. chars := Set new: charsNum. self readCharactersInRanges: ranges storeInto: chars. chars := chars sorted: [:x :y | (x at: 2) <= (y at: 2)]. charsNum := chars size. "undefined encodings make this different" chars do: [:array | | width | encoding := array at: 2. bbx := array at: 3.. width := bbx at: 1. maxWidth := maxWidth max: width. minAscii := minAscii min: encoding. maxAscii := maxAscii max: encoding. strikeWidth := strikeWidth + width. ]. glyphs := Form extent: strikeWidth@height. blt := BitBlt toForm: glyphs. start := (ranges collect: [:r | r first]) min. end := (ranges collect: [:r | r second]) max + 3. xTable := SparseLargeTable new: end chunkSize: 64 arrayClass: Array base: start +1 defaultValue: -1. lastAscii := start. xTable at: lastAscii + 2 put: 0. 1 to: charsNum do: [:i | form := (chars at: i) first. encoding := (chars at: i) second. bbx := (chars at: i) third. "lastAscii+1 to: encoding-1 do: [:a | xTable at: a+2 put: (xTable at: a+1)]." lastValue := xTable at: lastAscii + 1 + 1. xTable at: encoding + 1 put: lastValue. blt copy: (((xTable at: encoding+1)@(ascent - (bbx at: 2) - (bbx at: 4))) extent: (bbx at: 1)@(bbx at: 2)) from: 0@0 in: form. xTable at: encoding+2 put: (xTable at: encoding+1)+(bbx at: 1). lastAscii := encoding. ]. xTable at: xTable size put: (xTable at: xTable size - 1). xTable zapDefaultOnlyEntries. ret := Array new: 8. ret at: 1 put: xTable. ret at: 2 put: glyphs. ret at: 3 put: minAscii. ret at: 4 put: maxAscii. ret at: 5 put: maxWidth. ret at: 6 put: ascent. ret at: 7 put: descent. ret at: 8 put: pointSize. ^ret. " ^{xTable. glyphs. minAscii. maxAscii. maxWidth. ascent. descent. pointSize}" ! Item was changed: + ----- Method: EFontBDFFontReaderForRanges>>readRanges:overrideWith:otherRanges:additionalOverrideRange: (in category 'reading') ----- - ----- Method: EFontBDFFontReaderForRanges>>readRanges:overrideWith:otherRanges:additionalOverrideRange: (in category 'as yet unclassified') ----- readRanges: ranges overrideWith: otherFileName otherRanges: otherRanges additionalOverrideRange: additionalRange | xTable glyphs ascent descent chars charsNum height form blt lastAscii pointSize ret lastValue start end encoding bbx strikeWidth minAscii maxAscii maxWidth | form := encoding := bbx := nil. self initialize. self readAttributes. height := Integer readFromString: ((properties at: #FONTBOUNDINGBOX) at: 2). ascent := Integer readFromString: (properties at: #'FONT_ASCENT') first. descent := Integer readFromString: (properties at: #'FONT_DESCENT') first. (properties includesKey: #'POINT_SIZE') ifTrue: [ pointSize := (Integer readFromString: (properties at: #'POINT_SIZE') first) // 10. ] ifFalse: [ pointSize := (ascent + descent) * 72 // 96. ]. maxWidth := 0. minAscii := 16r200000. strikeWidth := 0. maxAscii := 0. charsNum := Integer readFromString: (properties at: #CHARS) first. chars := Set new: charsNum. self readCharactersInRanges: ranges storeInto: chars. chars := self override: chars with: otherFileName ranges: otherRanges transcodingTable: (UCSTable jisx0208Table) additionalRange: additionalRange. chars := chars sorted: [:x :y | (x at: 2) <= (y at: 2)]. charsNum := chars size. "undefined encodings make this different" chars do: [:array | | width | encoding := array at: 2. bbx := array at: 3.. width := bbx at: 1. maxWidth := maxWidth max: width. minAscii := minAscii min: encoding. maxAscii := maxAscii max: encoding. strikeWidth := strikeWidth + width. ]. glyphs := Form extent: strikeWidth@height. blt := BitBlt toForm: glyphs. start := ((ranges collect: [:r | r first]), (additionalRange collect: [:r2 | r2 first])) min. end := ((ranges collect: [:r | r second]), (additionalRange collect: [:r2 | r2 second])) max + 3. "xRange := Array with: (Array with: ((ranges collect: [:r | r first]), (additionalRange collect: [:r2 | r2 first])) min with: (((ranges collect: [:r | r second]), (additionalRange collect: [:r2 | r2 second])) max + 2))." "xTable := XTableForUnicodeFont new ranges: xRange." xTable := SparseLargeTable new: end chunkSize: 64 arrayClass: Array base: start defaultValue: -1. lastAscii := start. xTable at: lastAscii + 2 put: 0. 1 to: charsNum do: [:i | form := (chars at: i) first. encoding := (chars at: i) second. bbx := (chars at: i) third. "lastAscii+1 to: encoding-1 do: [:a | xTable at: a+2 put: (xTable at: a+1)]." lastValue := xTable at: lastAscii + 1 + 1. xTable at: encoding + 1 put: lastValue. blt copy: (((xTable at: encoding+1)@(ascent - (bbx at: 2) - (bbx at: 4))) extent: (bbx at: 1)@(bbx at: 2)) from: 0@0 in: form. xTable at: encoding+2 put: (xTable at: encoding+1)+(bbx at: 1). lastAscii := encoding. ]. xTable at: xTable size put: (xTable at: xTable size - 1). xTable zapDefaultOnlyEntries. ret := Array new: 8. ret at: 1 put: xTable. ret at: 2 put: glyphs. ret at: 3 put: minAscii. ret at: 4 put: maxAscii. ret at: 5 put: maxWidth. ret at: 6 put: ascent. ret at: 7 put: descent. ret at: 8 put: pointSize. ^ret. " ^{xTable. glyphs. minAscii. maxAscii. maxWidth. ascent. descent. pointSize}" ! Item was added: + ----- Method: EFontBDFFontReaderForRanges>>readRangesForSimplifiedChinese:overrideWith:otherRanges:additionalOverrideRange: (in category 'reading') ----- + readRangesForSimplifiedChinese: ranges overrideWith: otherFileName otherRanges: otherRanges additionalOverrideRange: additionalRange + + | xTable strikeWidth glyphs ascent descent minAscii maxAscii maxWidth chars charsNum height form encoding bbx width blt lastAscii pointSize ret lastValue start end | + form := encoding := bbx := nil. + self initialize. + self readAttributes. + height := Integer readFromString: ((properties at: #FONTBOUNDINGBOX) at: 2). + ascent := Integer readFromString: (properties at: 'FONT_ASCENT' asSymbol) first. + descent := Integer readFromString: (properties at: 'FONT_DESCENT' asSymbol) first. + (properties includesKey: 'POINT_SIZE' asSymbol) ifTrue: [ + pointSize := (Integer readFromString: (properties at: 'POINT_SIZE' asSymbol) first) // 10. + ] ifFalse: [ + pointSize := (ascent + descent) * 72 // 96. + ]. + + + maxWidth := 0. + minAscii := 16r200000. + strikeWidth := 0. + maxAscii := 0. + + charsNum := Integer readFromString: (properties at: #CHARS) first. + chars := Set new: charsNum. + + self readCharactersInRanges2: ranges storeInto: chars. + chars := self override2: chars with: otherFileName ranges: otherRanges transcodingTable: (UCSTable jisx0208Table) additionalRange: additionalRange. + + chars := chars sorted: [:x :y | (x at: 2) <= (y at: 2)]. + charsNum := chars size. "undefined encodings make this different" + + chars do: [:array | + encoding := array at: 2. + bbx := array at: 3.. + width := bbx at: 1. + maxWidth := maxWidth max: width. + minAscii := minAscii min: encoding. + maxAscii := maxAscii max: encoding. + strikeWidth := strikeWidth + width. + ]. + + glyphs := Form extent: strikeWidth@height. + blt := BitBlt toForm: glyphs. + start := ((ranges collect: [:r | r first]), (additionalRange collect: [:r2 | r2 first])) min. + end := ((ranges collect: [:r | r second]), (additionalRange collect: [:r2 | r2 second])) max + 3. + "xRange := Array with: (Array with: ((ranges collect: [:r | r first]), (additionalRange collect: [:r2 | r2 first])) min + with: (((ranges collect: [:r | r second]), (additionalRange collect: [:r2 | r2 second])) max + 2))." + "xTable := XTableForUnicodeFont new + ranges: xRange." + xTable := SparseLargeTable new: end chunkSize: 64 arrayClass: Array base: start defaultValue: -1. + lastAscii := start. + xTable at: lastAscii + 2 put: 0. + 1 to: charsNum do: [:i | + form := (chars at: i) first. + encoding := (chars at: i) second. + bbx := (chars at: i) third. + "lastAscii+1 to: encoding-1 do: [:a | xTable at: a+2 put: (xTable at: a+1)]." + lastValue := xTable at: lastAscii + 1 + 1. + xTable at: encoding + 1 put: lastValue. + blt copy: (((xTable at: encoding+1)@(ascent - (bbx at: 2) - (bbx at: 4))) + extent: (bbx at: 1)@(bbx at: 2)) + from: 0@0 in: form. + xTable at: encoding+2 put: (xTable at: encoding+1)+(bbx at: 1). + lastAscii := encoding. + ]. + xTable at: xTable size put: (xTable at: xTable size - 1). + xTable zapDefaultOnlyEntries. + ret := Array new: 8. + ret at: 1 put: xTable. + ret at: 2 put: glyphs. + ret at: 3 put: minAscii. + ret at: 4 put: maxAscii. + ret at: 5 put: maxWidth. + ret at: 6 put: ascent. + ret at: 7 put: descent. + ret at: 8 put: pointSize. + ^ret. + " ^{xTable. glyphs. minAscii. maxAscii. maxWidth. ascent. descent. pointSize}" + ! Item was changed: + ----- Method: ISO88592ClipboardInterpreter>>fromSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: ISO88592ClipboardInterpreter>>fromSystemClipboard: (in category 'as yet unclassified') ----- fromSystemClipboard: aString ^ aString convertFromWithConverter: ISO88592TextConverter new. ! Item was changed: + ----- Method: ISO88592ClipboardInterpreter>>toSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: ISO88592ClipboardInterpreter>>toSystemClipboard: (in category 'as yet unclassified') ----- toSystemClipboard: aString | result converter | aString isAsciiString ifTrue: [^ aString asOctetString]. "optimization" result := WriteStream on: (String new: aString size). converter := ISO88592TextConverter new. aString do: [:each | | r | r := converter fromSqueak: each.]. ^ result contents. ! Item was changed: + ----- Method: ISO88592InputInterpreter>>initialize (in category 'initialize-release') ----- - ----- Method: ISO88592InputInterpreter>>initialize (in category 'as yet unclassified') ----- initialize converter := ISO88592TextConverter new. ! Item was changed: + ----- Method: ISO88592InputInterpreter>>nextCharFrom:firstEvt: (in category 'keyboard') ----- - ----- Method: ISO88592InputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') ----- nextCharFrom: sensor firstEvt: evtBuf | keyValue | keyValue := evtBuf third. ^ converter toSqueak: keyValue asCharacter. ! Item was changed: + ----- Method: InvalidUTF8>>isResumable (in category 'priv handling') ----- - ----- Method: InvalidUTF8>>isResumable (in category 'private') ----- isResumable ^true! Item was changed: + ----- Method: InvalidUTF8>>messageText (in category 'printing') ----- - ----- Method: InvalidUTF8>>messageText (in category 'private') ----- messageText "Return a textual description of the exception." ^messageText ifNil: [string ifNil: ['Invalid UTF8'] ifNotNil: ['Invalid utf8: ', string]]! Item was changed: + ----- Method: KeyboardInputInterpreter>>nextCharFrom:firstEvt: (in category 'keyboard') ----- - ----- Method: KeyboardInputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') ----- nextCharFrom: sensor firstEvt: evtBuf - - self subclassResponsibility. ! Item was changed: + ----- Method: KoreanEnvironment class>>clipboardInterpreterClass (in category 'subclass responsibilities') ----- - ----- Method: KoreanEnvironment class>>clipboardInterpreterClass (in category 'as yet unclassified') ----- clipboardInterpreterClass | platformName osVersion | platformName := Smalltalk platformName. osVersion := Smalltalk osVersion. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^NoConversionClipboardInterpreter]. platformName = 'Win32' ifTrue: [^WinKSX1001ClipboardInterpreter]. platformName = 'Mac OS' ifTrue: [('10*' match: osVersion) ifTrue: [^NoConversionClipboardInterpreter] ifFalse: [^WinKSX1001ClipboardInterpreter]]. platformName = 'unix' ifTrue: [(ShiftJISTextConverter encodingNames includes: X11Encoding getEncoding) ifTrue: [^WinKSX1001ClipboardInterpreter] ifFalse: [^NoConversionClipboardInterpreter]]. ^NoConversionClipboardInterpreter! Item was changed: + ----- Method: KoreanEnvironment class>>defaultEncodingName (in category 'public query') ----- - ----- Method: KoreanEnvironment class>>defaultEncodingName (in category 'as yet unclassified') ----- defaultEncodingName | platformName osVersion | platformName := Smalltalk platformName. osVersion := Smalltalk osVersion. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^'utf-8' copy]. (#('Win32' 'Mac OS' 'ZaurusOS') includes: platformName) ifTrue: [^'euc-kr' copy]. (#('unix') includes: platformName) ifTrue: [^'euc-kr' copy]. ^'mac-roman'! Item was changed: + ----- Method: KoreanEnvironment class>>inputInterpreterClass (in category 'subclass responsibilities') ----- - ----- Method: KoreanEnvironment class>>inputInterpreterClass (in category 'as yet unclassified') ----- inputInterpreterClass | platformName osVersion encoding | platformName := Smalltalk platformName. osVersion := Smalltalk osVersion. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^MacRomanInputInterpreter]. platformName = 'Win32' ifTrue: [^WinKSX1001InputInterpreter]. platformName = 'Mac OS' ifTrue: [('10*' match: osVersion) ifTrue: [^MacUnicodeInputInterpreter] ifFalse: [^WinKSX1001InputInterpreter]]. platformName = 'unix' ifTrue: [encoding := X11Encoding encoding. (EUCJPTextConverter encodingNames includes: encoding) ifTrue: [^MacRomanInputInterpreter]. (UTF8TextConverter encodingNames includes: encoding) ifTrue: [^MacRomanInputInterpreter]. (ShiftJISTextConverter encodingNames includes: encoding) ifTrue: [^MacRomanInputInterpreter]]. ^MacRomanInputInterpreter! Item was changed: + ----- Method: KoreanEnvironment class>>traditionalCharsetClass (in category 'language methods') ----- - ----- Method: KoreanEnvironment class>>traditionalCharsetClass (in category 'as yet unclassified') ----- traditionalCharsetClass ^ KSX1001. ! Item was changed: + ----- Method: MacRomanClipboardInterpreter>>fromSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: MacRomanClipboardInterpreter>>fromSystemClipboard: (in category 'as yet unclassified') ----- fromSystemClipboard: aString ^ aString macToSqueak. ! Item was changed: + ----- Method: MacRomanClipboardInterpreter>>toSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: MacRomanClipboardInterpreter>>toSystemClipboard: (in category 'as yet unclassified') ----- toSystemClipboard: aString | result | aString isOctetString ifTrue: [^ aString asOctetString squeakToMac]. result := WriteStream on: (String new: aString size). aString do: [:each | each asciiValue < 256 ifTrue: [result nextPut: each squeakToMac]]. ^ result contents. ! Item was changed: + ----- Method: MacRomanInputInterpreter>>nextCharFrom:firstEvt: (in category 'keyboard') ----- - ----- Method: MacRomanInputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') ----- nextCharFrom: sensor firstEvt: evtBuf | keyValue | keyValue := evtBuf third. ^ keyValue asCharacter macToSqueak. ! Item was changed: + ----- Method: MacShiftJISClipboardInterpreter>>fromSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: MacShiftJISClipboardInterpreter>>fromSystemClipboard: (in category 'as yet unclassified') ----- fromSystemClipboard: aString ^ aString convertFromWithConverter: ShiftJISTextConverter new! Item was changed: + ----- Method: MacShiftJISClipboardInterpreter>>toSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: MacShiftJISClipboardInterpreter>>toSystemClipboard: (in category 'as yet unclassified') ----- toSystemClipboard: text | string | "self halt." string := text asString. string isAsciiString ifTrue: [^ string asOctetString]. string isOctetString ifTrue: [^ string "hmm"]. ^ string convertToWithConverter: ShiftJISTextConverter new . ! Item was changed: + ----- Method: MacShiftJISInputInterpreter>>initialize (in category 'initialize-release') ----- - ----- Method: MacShiftJISInputInterpreter>>initialize (in category 'as yet unclassified') ----- initialize converter := ShiftJISTextConverter new. ! Item was changed: + ----- Method: MacShiftJISInputInterpreter>>nextCharFrom:firstEvt: (in category 'keyboard') ----- - ----- Method: MacShiftJISInputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') ----- nextCharFrom: sensor firstEvt: evtBuf | firstChar secondChar peekEvent keyValue type stream multiChar | keyValue := evtBuf third. evtBuf fourth = EventKeyChar ifTrue: [type := #keystroke]. peekEvent := sensor peekEvent. (peekEvent notNil and: [peekEvent fourth = EventKeyDown]) ifTrue: [ sensor nextEvent. peekEvent := sensor peekEvent]. (type == #keystroke and: [peekEvent notNil and: [peekEvent first = EventTypeKeyboard and: [peekEvent fourth = EventKeyChar]]]) ifTrue: [ firstChar := keyValue asCharacter. secondChar := (peekEvent third) asCharacter. stream := ReadStream on: (String with: firstChar with: secondChar). multiChar := converter nextFromStream: stream. multiChar isOctetCharacter ifFalse: [sensor nextEvent]. ^ multiChar]. ^ keyValue asCharacter! Item was changed: + ----- Method: MultiByteBinaryOrTextStream>>fileInObjectAndCodeForProject (in category 'fileIn/Out') ----- - ----- Method: MultiByteBinaryOrTextStream>>fileInObjectAndCodeForProject (in category 'as yet unclassified') ----- fileInObjectAndCodeForProject "This file may contain: 1) a fileIn of code 2) just an object in SmartReferenceStream format 3) both code and an object. File it in and return the object. Note that self must be a FileStream or RWBinaryOrTextStream. Maybe ReadWriteStream incorporate RWBinaryOrTextStream?" | refStream object | self text. self peek asciiValue = 4 ifTrue: [ "pure object file" self binary. refStream := SmartRefStream on: self. object := refStream nextAndClose] ifFalse: [ "objects mixed with a fileIn" self fileInProject. "reads code and objects, then closes the file" self binary. object := SmartRefStream scannedObject]. "set by side effect of one of the chunks" SmartRefStream scannedObject: nil. "clear scannedObject" ^ object! Item was changed: + ----- Method: MultiByteBinaryOrTextStream>>fileInProject (in category 'fileIn/Out') ----- - ----- Method: MultiByteBinaryOrTextStream>>fileInProject (in category 'as yet unclassified') ----- fileInProject self setConverterForCodeForProject. super fileIn. ! Item was changed: + ----- Method: MultiByteBinaryOrTextStream>>setConverterForCodeForProject (in category 'private') ----- - ----- Method: MultiByteBinaryOrTextStream>>setConverterForCodeForProject (in category 'as yet unclassified') ----- setConverterForCodeForProject self converter: UTF8TextConverter new. ! Item was changed: + ----- Method: MultiByteFileStream class>>guessDefaultLineEndConvention (in category 'system startup') ----- - ----- Method: MultiByteFileStream class>>guessDefaultLineEndConvention (in category 'class initialization') ----- guessDefaultLineEndConvention "Lets try to guess the line end convention from what we know about the path name delimiter from FileDirectory." FileDirectory pathNameDelimiter = $: ifTrue: [^ self defaultToCR]. FileDirectory pathNameDelimiter = $/ ifTrue: [((Smalltalk osVersion) beginsWith: 'darwin') ifTrue: [^ self defaultToCR] ifFalse: [^ self defaultToLF]]. FileDirectory pathNameDelimiter = $\ ifTrue: [^ self defaultToCRLF]. "in case we don't know" ^ self defaultToCR! Item was changed: + ----- Method: MultiByteFileStream class>>newForStdio (in category 'stdio') ----- - ----- Method: MultiByteFileStream class>>newForStdio (in category 'as yet unclassified') ----- newForStdio "Use crlf as line end convention on windows, lf on all other platforms. Also make sure that the converter is initialized." | lineEndConvention | lineEndConvention := self lineEndDefault. lineEndConvention == #crlf ifFalse: [ lineEndConvention := #lf ]. ^self new lineEndConvention: lineEndConvention; initializeConverter; yourself! Item was changed: + ----- Method: MultiByteFileStream class>>startUp: (in category 'system startup') ----- - ----- Method: MultiByteFileStream class>>startUp: (in category 'class initialization') ----- startUp: resuming resuming ifTrue: [ self guessDefaultLineEndConvention ] ! Item was changed: + ----- Method: NoConversionClipboardInterpreter>>fromSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: NoConversionClipboardInterpreter>>fromSystemClipboard: (in category 'as yet unclassified') ----- fromSystemClipboard: aString ^ aString. ! Item was changed: + ----- Method: NoConversionClipboardInterpreter>>toSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: NoConversionClipboardInterpreter>>toSystemClipboard: (in category 'as yet unclassified') ----- toSystemClipboard: aString | result | aString isOctetString ifTrue: [^ aString asOctetString]. result := WriteStream on: (String new: aString size). aString do: [:each | each value < 256 ifTrue: [result nextPut: each]]. ^ result contents. ! Item was changed: + ----- Method: NoConverterFound class>>signalFor: (in category 'exceptionInstantiator') ----- - ----- Method: NoConverterFound class>>signalFor: (in category 'as yet unclassified') ----- signalFor: encodingName self new encoding: encodingName; signal! Item was changed: + ----- Method: NoInputInterpreter>>nextCharFrom:firstEvt: (in category 'keyboard') ----- - ----- Method: NoInputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') ----- nextCharFrom: sensor firstEvt: evtBuf | keyValue | keyValue := evtBuf third. ^ keyValue asCharacter. ! Item was changed: + ----- Method: RussianEnvironment class>>clipboardInterpreterClass (in category 'subclass responsibilities') ----- - ----- Method: RussianEnvironment class>>clipboardInterpreterClass (in category 'as yet unclassified') ----- clipboardInterpreterClass ^ UTF8ClipboardInterpreter. ! Item was changed: + ----- Method: RussianEnvironment class>>fileNameConverterClass (in category 'subclass responsibilities') ----- - ----- Method: RussianEnvironment class>>fileNameConverterClass (in category 'as yet unclassified') ----- fileNameConverterClass ^UTF8TextConverter. ! Item was changed: + ----- Method: RussianEnvironment class>>inputInterpreterClass (in category 'subclass responsibilities') ----- - ----- Method: RussianEnvironment class>>inputInterpreterClass (in category 'as yet unclassified') ----- inputInterpreterClass | platformName | platformName := Smalltalk platformName. platformName = 'Win32' ifTrue: [^UTF32RussianInputInterpreter]. platformName = 'Mac OS' ifTrue: [^ (('10*' match: Smalltalk osVersion) and: [(Smalltalk getSystemAttribute: 3) isNil]) ifTrue: [MacUnicodeInputInterpreter] ifFalse: [MacRomanInputInterpreter]]. platformName = 'unix' ifTrue: [^ UTF32RussianInputInterpreter]. ^ MacRomanInputInterpreter! Item was changed: + ----- Method: RussianEnvironment class>>supportedLanguages (in category 'subclass responsibilities') ----- - ----- Method: RussianEnvironment class>>supportedLanguages (in category 'as yet unclassified') ----- supportedLanguages "Return the languages that this class supports. Any translations for those languages will use this class as their environment." ^#('ru' )! Item was changed: + ----- Method: RussianEnvironment class>>systemConverterClass (in category 'subclass responsibilities') ----- - ----- Method: RussianEnvironment class>>systemConverterClass (in category 'as yet unclassified') ----- systemConverterClass ^ UTF8TextConverter! Item was changed: + ----- Method: StrikeFontFixer>>characterFormAt:at: (in category 'accessing') ----- - ----- Method: StrikeFontFixer>>characterFormAt:at: (in category 'as yet unclassified') ----- characterFormAt: aCharacter at: aPoint | f | f := charForms at: aCharacter asciiValue + 1. (f magnifyBy: 3) displayAt: aPoint. ^ f. ! Item was changed: + ----- Method: StrikeFontFixer>>displayOn:at:magnifyBy: (in category 'displaying') ----- - ----- Method: StrikeFontFixer>>displayOn:at:magnifyBy: (in category 'as yet unclassified') ----- displayOn: aDisplayObject at: aPoint magnifyBy: aNumber | form hStep vStep bb source nextPoint | hStep := (strikeFont maxWidth * aNumber * 1.2) asInteger. vStep := (strikeFont height * aNumber * 1.2) asInteger. form := Form extent: (hStep * 16)@(vStep * 16). bb := BitBlt toForm: form. 0 to: 15 do: [:i | 1 to: 16 do: [:j | source := ((charForms at: (i * 16 + j)) magnifyBy: aNumber). nextPoint := (hStep * (j - 1)@(vStep * i)). bb copy: ((nextPoint+((hStep@vStep - source extent) // 2)) extent: source extent) from: 0@0 in: source fillColor: Color black rule: Form over. ]. ]. form displayOn: aDisplayObject at: aPoint. ! Item was changed: + ----- Method: StrikeFontFixer>>font: (in category 'accessing') ----- - ----- Method: StrikeFontFixer>>font: (in category 'as yet unclassified') ----- font: aStrikeFont strikeFont := aStrikeFont. self forms. ! Item was changed: + ----- Method: StrikeFontFixer>>forms (in category 'accessing') ----- - ----- Method: StrikeFontFixer>>forms (in category 'as yet unclassified') ----- forms 1 to: 256 do: [:i | charForms at: i put: (strikeFont characterFormAt: (Character value: (i - 1))) ]. ! Item was changed: + ----- Method: StrikeFontFixer>>mappingTable (in category 'accessing') ----- - ----- Method: StrikeFontFixer>>mappingTable (in category 'as yet unclassified') ----- mappingTable ^ MappingTable. ! Item was changed: + ----- Method: StrikeFontFixer>>storeEditedGlyphsOn: (in category 'printing') ----- - ----- Method: StrikeFontFixer>>storeEditedGlyphsOn: (in category 'as yet unclassified') ----- storeEditedGlyphsOn: aStream NoFontTable do: [:i | | n | n := strikeFont name. (n beginsWith: 'NewYork') ifTrue: [n := 'NewYork']. aStream nextPutAll: '((StrikeFont familyName: ''', n, ''' size: ', strikeFont height asString, ')'. aStream nextPutAll: ' characterFormAt: '. aStream nextPutAll: '(Character value: ', i asString, ')'. aStream nextPutAll: ' put: '. (strikeFont characterFormAt: (Character value: i)) storeOn: aStream base: 2. aStream nextPutAll: ')!!'. aStream nextPut: Character cr. aStream nextPut: Character cr. ].! Item was changed: + ----- Method: StrikeFontSet class>>createExternalFontFileForLatin2: (in category 'fileIn/Out') ----- - ----- Method: StrikeFontSet class>>createExternalFontFileForLatin2: (in category 'as yet unclassified') ----- createExternalFontFileForLatin2: fileName " StrikeFontSet createExternalFontFileForLatin2: 'latin2.out'. " | file array f installDirectory | file := FileStream newFileNamed: fileName. installDirectory := Smalltalk at: #M17nInstallDirectory ifAbsent: []. installDirectory := installDirectory ifNil: [String new] ifNotNil: [installDirectory , FileDirectory pathNameDelimiter asString]. array := Array with: (StrikeFont newFromEFontBDFFile: installDirectory , 'b10.bdf' name: 'LatinTwo9' ranges: EFontBDFFontReaderForRanges rangesForLatin2) with: (StrikeFont newFromEFontBDFFile: installDirectory , 'b12.bdf' name: 'LatinTwo10' ranges: EFontBDFFontReaderForRanges rangesForLatin2) with: (StrikeFont newFromEFontBDFFile: installDirectory , 'b14.bdf' name: 'LatinTwo12' ranges: EFontBDFFontReaderForRanges rangesForLatin2) with: (StrikeFont newFromEFontBDFFile: installDirectory , 'b16.bdf' name: 'LatingTwo14' ranges: EFontBDFFontReaderForRanges rangesForLatin2) with: (StrikeFont newFromEFontBDFFile: installDirectory , 'b24.bdf' name: 'LatinTwo20' ranges: EFontBDFFontReaderForRanges rangesForLatin2). TextConstants at: #forceFontWriting put: true. f := ReferenceStream on: file. f nextPut: array. file close. TextConstants removeKey: #forceFontWriting. ! Item was changed: + ----- Method: StrikeFontSet class>>createExternalFontFileForUnicodeJapanese: (in category 'fileIn/Out') ----- - ----- Method: StrikeFontSet class>>createExternalFontFileForUnicodeJapanese: (in category 'as yet unclassified') ----- createExternalFontFileForUnicodeJapanese: fileName " StrikeFontSet createExternalFontFileForUnicodeJapanese: 'uJapaneseFont.out'. " | file array f installDirectory | file := FileStream newFileNamed: fileName. installDirectory := Smalltalk at: #M17nInstallDirectory ifAbsent: []. installDirectory := installDirectory ifNil: [String new] ifNotNil: [installDirectory , FileDirectory pathNameDelimiter asString]. array := Array with: (StrikeFont newForJapaneseFromEFontBDFFile: installDirectory , 'b12.bdf' name: 'Japanese10' overrideWith: 'shnmk12.bdf') with: ((StrikeFont newForJapaneseFromEFontBDFFile: installDirectory , 'b14.bdf' name: 'Japanese12' overrideWith: 'shnmk14.bdf') "fixAscent: 14 andDescent: 1 head: 1") with: ((StrikeFont newForJapaneseFromEFontBDFFile: 'b16.bdf' name: 'Japanese14' overrideWith: 'shnmk16.bdf') "fixAscent: 16 andDescent: 4 head: 4") with: (StrikeFont newForJapaneseFromEFontBDFFile: installDirectory , 'b24.bdf' name: 'Japanese18' overrideWith: 'kanji24.bdf'). TextConstants at: #forceFontWriting put: true. f := ReferenceStream on: file. f nextPut: array. file close. TextConstants removeKey: #forceFontWriting. ! Item was changed: + ----- Method: StrikeFontSet class>>createExternalFontFileForUnicodeKorean: (in category 'fileIn/Out') ----- - ----- Method: StrikeFontSet class>>createExternalFontFileForUnicodeKorean: (in category 'as yet unclassified') ----- createExternalFontFileForUnicodeKorean: fileName " Smalltalk garbageCollect. StrikeFontSet createExternalFontFileForUnicodeKorean: 'uKoreanFont.out'. " | file array f installDirectory | file := FileStream newFileNamed: fileName. installDirectory := Smalltalk at: #M17nInstallDirectory ifAbsent: []. installDirectory := installDirectory ifNil: [String new] ifNotNil: [installDirectory , FileDirectory pathNameDelimiter asString]. array := Array with: (StrikeFont newForKoreanFromEFontBDFFile: installDirectory , 'b12.bdf' name: 'Japanese10' overrideWith: 'shnmk12.bdf') with: ((StrikeFont newForKoreanFromEFontBDFFile: installDirectory , 'b14.bdf' name: 'Japanese12' overrideWith: 'shnmk14.bdf') "fixAscent: 14 andDescent: 1 head: 1") with: ((StrikeFont newForKoreanFromEFontBDFFile: installDirectory , 'b16.bdf' name: 'Japanese14' overrideWith: 'hanglg16.bdf') fixAscent: 16 andDescent: 4 head: 4) with: (StrikeFont newForKoreanFromEFontBDFFile: installDirectory , 'b24.bdf' name: 'Japanese18' overrideWith: 'hanglm24.bdf'). TextConstants at: #forceFontWriting put: true. f := ReferenceStream on: file. f nextPut: array. file close. TextConstants removeKey: #forceFontWriting. ! Item was changed: + ----- Method: StrikeFontSet class>>decodedFromRemoteCanvas: (in category 'instance creation') ----- - ----- Method: StrikeFontSet class>>decodedFromRemoteCanvas: (in category 'as yet unclassified') ----- decodedFromRemoteCanvas: aString | array | array := aString findTokens: #($ ). ^ self familyName: (array at: 1) size: (array at: 2) asNumber emphasized: (array at: 3) asNumber. ! Item was changed: + ----- Method: StrikeFontSet class>>duplicateArrayElementsForLeadingCharShift (in category 'system maintenance') ----- - ----- Method: StrikeFontSet class>>duplicateArrayElementsForLeadingCharShift (in category 'as yet unclassified') ----- duplicateArrayElementsForLeadingCharShift " self duplicateArrayElementsForLeadingCharShift " self allInstances do: [:s | | array font | s emphasis = 0 ifTrue: [ array := s fontArray. 2 to: (4 min: array size) do: [:i | font := array at: i. s addNewFont: font at: ((i - 1) << 2) + 1. ]. ] ifFalse: [ s reset ]. ]. ! Item was changed: + ----- Method: StrikeFontSet class>>familyName:size: (in category 'instance creation') ----- - ----- Method: StrikeFontSet class>>familyName:size: (in category 'as yet unclassified') ----- familyName: aName size: aSize "Answer a font (or the default font if the name is unknown) in the specified size." | collection | collection := self allInstances select: [:inst | (inst name beginsWith: aName) and: [inst emphasis = 0]]. collection isEmpty ifTrue: [ (aName = 'DefaultMultiStyle') ifTrue: [ collection := (TextConstants at: #DefaultMultiStyle) fontArray. ] ifFalse: [ ^ TextStyle defaultFont ] ]. collection sort: [:a :b | a pointSize <= b pointSize]. collection do: [:s | (s pointSize >= aSize) ifTrue: [^ s]]. ^ TextStyle defaultFont. ! Item was changed: + ----- Method: StrikeFontSet class>>familyName:size:emphasized: (in category 'instance creation') ----- - ----- Method: StrikeFontSet class>>familyName:size:emphasized: (in category 'as yet unclassified') ----- familyName: aName size: aSize emphasized: emphasisCode "Create the font with this emphasis" ^ (self familyName: aName size: aSize) emphasized: emphasisCode ! Item was changed: + ----- Method: StrikeFontSet class>>findMaximumLessThan:in: (in category 'utilities') ----- - ----- Method: StrikeFontSet class>>findMaximumLessThan:in: (in category 'as yet unclassified') ----- findMaximumLessThan: f in: array array size to: 1 by: -1 do: [:i | f height >= (array at: i) height ifTrue: [^ array at: i]. ]. ^ array first. ! Item was changed: + ----- Method: StrikeFontSet class>>newFontArray: (in category 'instance creation') ----- - ----- Method: StrikeFontSet class>>newFontArray: (in category 'as yet unclassified') ----- newFontArray: anArray ^super new initializeWithFontArray: anArray ! Item was changed: + ----- Method: StrikeFontSet>>ascent (in category 'accessing') ----- - ----- Method: StrikeFontSet>>ascent (in category 'as yet unclassified') ----- ascent ^ fontArray first ascent. ! Item was changed: + ----- Method: StrikeFontSet>>ascentKern (in category 'accessing') ----- - ----- Method: StrikeFontSet>>ascentKern (in category 'as yet unclassified') ----- ascentKern ^ fontArray first ascentKern. ! Item was changed: + ----- Method: StrikeFontSet>>baseKern (in category 'accessing') ----- - ----- Method: StrikeFontSet>>baseKern (in category 'as yet unclassified') ----- baseKern ^ fontArray first baseKern. ! Item was changed: + ----- Method: StrikeFontSet>>bonk:with:at: (in category 'private') ----- - ----- Method: StrikeFontSet>>bonk:with:at: (in category 'as yet unclassified') ----- bonk: glyphForm with: bonkForm at: j "Bonking means to run through the glyphs clearing out black pixels between characters to prevent them from straying into an adjacent character as a result of, eg, bolding or italicizing" "Uses the bonkForm to erase at every character boundary in glyphs." | bb offset font x | font := (fontArray at: j). offset := bonkForm offset x. bb := BitBlt toForm: glyphForm. bb sourceForm: bonkForm; sourceRect: bonkForm boundingBox; combinationRule: Form erase; destY: 0. x := font xTable. (x isMemberOf: SparseLargeTable) ifTrue: [ x base to: x size-1 do: [:i | bb destX: (x at: i) + offset; copyBits]. ] ifFalse: [ 1 to: x size-1 do: [:i | bb destX: (x at: i) + offset; copyBits]. ]. ! Item was changed: + ----- Method: StrikeFontSet>>depth (in category 'accessing') ----- - ----- Method: StrikeFontSet>>depth (in category 'as yet unclassified') ----- depth ^ self glyphs depth! Item was changed: + ----- Method: StrikeFontSet>>derivativeFonts (in category 'accessing') ----- - ----- Method: StrikeFontSet>>derivativeFonts (in category 'as yet unclassified') ----- derivativeFonts ^derivativeFonts copyWithout: nil! Item was changed: + ----- Method: StrikeFontSet>>descent (in category 'accessing') ----- - ----- Method: StrikeFontSet>>descent (in category 'as yet unclassified') ----- descent ^ fontArray first descent. ! Item was changed: + ----- Method: StrikeFontSet>>descentKern (in category 'accessing') ----- - ----- Method: StrikeFontSet>>descentKern (in category 'as yet unclassified') ----- descentKern ^ fontArray first descentKern. ! Item was changed: + ----- Method: StrikeFontSet>>displayLine:at: (in category 'displaying') ----- - ----- Method: StrikeFontSet>>displayLine:at: (in category 'as yet unclassified') ----- displayLine: aString at: aPoint "Display the characters in aString, starting at position aPoint." self characters: (1 to: aString size) in: aString displayAt: aPoint clippedBy: Display boundingBox rule: Form over fillColor: nil kernDelta: 0 on: (BitBlt toForm: Display). ! Item was changed: + ----- Method: StrikeFontSet>>emphasis (in category 'accessing') ----- - ----- Method: StrikeFontSet>>emphasis (in category 'as yet unclassified') ----- emphasis "Answer the integer code for synthetic bold, italic, underline, and strike-out." ^ emphasis. ! Item was changed: + ----- Method: StrikeFontSet>>emphasis: (in category 'accessing') ----- - ----- Method: StrikeFontSet>>emphasis: (in category 'as yet unclassified') ----- emphasis: code "Set the integer code for synthetic bold, itallic, underline, and strike-out, where bold=1, italic=2, underlined=4, and struck out=8." emphasis := code. ! Item was changed: + ----- Method: StrikeFontSet>>emphasized: (in category 'accessing') ----- - ----- Method: StrikeFontSet>>emphasized: (in category 'as yet unclassified') ----- emphasized: code "Answer a copy of the receiver with emphasis set to include code." | derivative addedEmphasis base safeCode | code = 0 ifTrue: [^ self]. (derivativeFonts == nil or: [derivativeFonts size = 0]) ifTrue: [^ self]. derivative := derivativeFonts at: (safeCode := code min: derivativeFonts size). derivative == nil ifFalse: [^ derivative]. "Already have this style" "Dont have it -- derive from another with one with less emphasis" addedEmphasis := 1 bitShift: safeCode highBit - 1. base := self emphasized: safeCode - addedEmphasis. "Order is Bold, Ital, Under, Narrow" addedEmphasis = 1 ifTrue: "Compute synthetic bold version of the font" [derivative := (base copy name: base name , 'B') makeBoldGlyphs]. addedEmphasis = 2 ifTrue: "Compute synthetic italic version of the font" [ derivative := (base copy name: base name , 'I') makeItalicGlyphs]. addedEmphasis = 4 ifTrue: "Compute underlined version of the font" [derivative := (base copy name: base name , 'U') makeUnderlinedGlyphs]. addedEmphasis = 8 ifTrue: "Compute narrow version of the font" [derivative := (base copy name: base name , 'N') makeCondensedGlyphs]. addedEmphasis = 16 ifTrue: "Compute struck-out version of the font" [derivative := (base copy name: base name , 'X') makeStruckOutGlyphs]. derivative emphasis: safeCode. derivativeFonts at: safeCode put: derivative. ^ derivative ! Item was changed: + ----- Method: StrikeFontSet>>familyName (in category 'accessing') ----- - ----- Method: StrikeFontSet>>familyName (in category 'as yet unclassified') ----- familyName ^ fontArray first familyName. ! Item was changed: + ----- Method: StrikeFontSet>>familySizeFace (in category 'accessing') ----- - ----- Method: StrikeFontSet>>familySizeFace (in category 'as yet unclassified') ----- familySizeFace ^ Array with: fontArray first name with: self height with: fontArray first emphasis ! Item was changed: + ----- Method: StrikeFontSet>>fontArray: (in category 'accessing') ----- - ----- Method: StrikeFontSet>>fontArray: (in category 'as yet unclassified') ----- fontArray: anArray fontArray := anArray. ! Item was changed: + ----- Method: StrikeFontSet>>fontNameWithPointSize (in category 'accessing') ----- - ----- Method: StrikeFontSet>>fontNameWithPointSize (in category 'as yet unclassified') ----- fontNameWithPointSize ^ fontArray first fontNameWithPointSize. ! Item was changed: + ----- Method: StrikeFontSet>>glyphs (in category 'accessing') ----- - ----- Method: StrikeFontSet>>glyphs (in category 'as yet unclassified') ----- glyphs ^ fontArray first glyphs ! Item was changed: + ----- Method: StrikeFontSet>>glyphsEncoding: (in category 'accessing') ----- - ----- Method: StrikeFontSet>>glyphsEncoding: (in category 'as yet unclassified') ----- glyphsEncoding: anInteger ^ (fontArray at: (anInteger+1)) glyphs. ! Item was changed: + ----- Method: StrikeFontSet>>height (in category 'accessing') ----- - ----- Method: StrikeFontSet>>height (in category 'as yet unclassified') ----- height ^ fontArray first height. ! Item was changed: + ----- Method: StrikeFontSet>>initializeWithFontArray: (in category 'initialize-release') ----- - ----- Method: StrikeFontSet>>initializeWithFontArray: (in category 'as yet unclassified') ----- initializeWithFontArray: anArray "Initialize with given font array, the ascent of primary font is modified if another font has higher size" | primaryFont maxHeight newFont | fontArray := anArray. primaryFont := anArray first. emphasis := 0. name := primaryFont name. maxHeight := anArray inject: 0 into: [:theHeight :font | (font notNil and: [theHeight < font height]) ifTrue: [font height] ifFalse: [theHeight]]. primaryFont height < maxHeight ifTrue: [newFont := primaryFont copy fixAscent: primaryFont ascent + (maxHeight - primaryFont height) andDescent: primaryFont descent head: 0. fontArray at: 1 put: newFont]. self reset! Item was changed: + ----- Method: StrikeFontSet>>installOn: (in category 'displaying') ----- - ----- Method: StrikeFontSet>>installOn: (in category 'as yet unclassified') ----- installOn: aDisplayContext ^ aDisplayContext installStrikeFont: self. ! Item was changed: + ----- Method: StrikeFontSet>>installOn:foregroundColor:backgroundColor: (in category 'displaying') ----- - ----- Method: StrikeFontSet>>installOn:foregroundColor:backgroundColor: (in category 'as yet unclassified') ----- installOn: aDisplayContext foregroundColor: foregroundColor backgroundColor: backgroundColor ^ aDisplayContext installStrikeFont: self foregroundColor: foregroundColor backgroundColor: backgroundColor. ! Item was changed: + ----- Method: StrikeFontSet>>lineGrid (in category 'accessing') ----- - ----- Method: StrikeFontSet>>lineGrid (in category 'as yet unclassified') ----- lineGrid | f | f := fontArray first. ^ f ascent + f descent. ! Item was changed: + ----- Method: StrikeFontSet>>maxEncoding (in category 'accessing') ----- - ----- Method: StrikeFontSet>>maxEncoding (in category 'as yet unclassified') ----- maxEncoding ^ fontArray size. ! Item was changed: + ----- Method: StrikeFontSet>>maxWidth (in category 'accessing') ----- - ----- Method: StrikeFontSet>>maxWidth (in category 'as yet unclassified') ----- maxWidth ^ (fontArray at: 1) maxWidth. ! Item was changed: + ----- Method: StrikeFontSet>>name (in category 'testing') ----- - ----- Method: StrikeFontSet>>name (in category 'as yet unclassified') ----- name ^ name ! Item was changed: + ----- Method: StrikeFontSet>>name: (in category 'accessing') ----- - ----- Method: StrikeFontSet>>name: (in category 'as yet unclassified') ----- name: aString name := aString ! Item was changed: + ----- Method: StrikeFontSet>>objectForDataStream: (in category 'objects from disk') ----- - ----- Method: StrikeFontSet>>objectForDataStream: (in category 'as yet unclassified') ----- objectForDataStream: refStrm | dp | "I am about to be written on an object file. Write a reference to a known Font in the other system instead. " "A path to me" (TextConstants at: #forceFontWriting ifAbsent: [false]) ifTrue: [^ self]. "special case for saving the default fonts on the disk. See collectionFromFileNamed:" dp := DiskProxy global: #StrikeFontSet selector: #familyName:size:emphasized: args: (Array with: self familyName with: self pointSize with: self emphasis). refStrm replace: self with: dp. ^ dp. ! Item was changed: + ----- Method: StrikeFontSet>>pointSize (in category 'accessing') ----- - ----- Method: StrikeFontSet>>pointSize (in category 'as yet unclassified') ----- pointSize ^ fontArray first pointSize. ! Item was changed: + ----- Method: StrikeFontSet>>reset (in category 'emphasis') ----- - ----- Method: StrikeFontSet>>reset (in category 'as yet unclassified') ----- reset "Reset the cache of derivative emphasized fonts" derivativeFonts := Array new: 32. ! Item was changed: + ----- Method: StrikeFontSet>>subscript (in category 'accessing') ----- - ----- Method: StrikeFontSet>>subscript (in category 'as yet unclassified') ----- subscript ^ fontArray first subscript ! Item was changed: + ----- Method: StrikeFontSet>>superscript (in category 'accessing') ----- - ----- Method: StrikeFontSet>>superscript (in category 'as yet unclassified') ----- superscript ^ fontArray first superscript ! Item was changed: + ----- Method: StrikeFontSet>>widthOfString: (in category 'measuring') ----- - ----- Method: StrikeFontSet>>widthOfString: (in category 'as yet unclassified') ----- widthOfString: aString aString ifNil:[^0]. "Optimizing" (aString isByteString) ifTrue: [ ^ self fontArray first widthOfString: aString from: 1 to: aString size]. ^ self widthOfString: aString from: 1 to: aString size. " TextStyle default defaultFont widthOfString: 'zort' 21 " ! Item was changed: + ----- Method: StrikeFontSet>>xTable (in category 'accessing') ----- - ----- Method: StrikeFontSet>>xTable (in category 'as yet unclassified') ----- xTable "Answer an Array of the left x-coordinate of characters in glyphs." ^ fontArray first xTable. ! Item was changed: + ----- Method: StrikeFontSet>>xTableEncoding: (in category 'accessing') ----- - ----- Method: StrikeFontSet>>xTableEncoding: (in category 'as yet unclassified') ----- xTableEncoding: anInteger "Answer an Array of the left x-coordinate of characters in glyphs." ^(fontArray at: anInteger + 1) xTable. ! Item was changed: + ----- Method: SymbolInputInterpreter>>nextCharFrom:firstEvt: (in category 'keyboard') ----- - ----- Method: SymbolInputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') ----- nextCharFrom: sensor firstEvt: evtBuf | keyValue | keyValue := evtBuf third. evtBuf fifth > 1 ifTrue: [^ keyValue asCharacter macToSqueak]. ^ (self symbolKeyValueToUnicode: keyValue) asCharacter. ! Item was changed: + ----- Method: SymbolInputInterpreter>>symbolKeyValueToUnicode: (in category 'private') ----- - ----- Method: SymbolInputInterpreter>>symbolKeyValueToUnicode: (in category 'as yet unclassified') ----- symbolKeyValueToUnicode: keyValue keyValue = 127 ifTrue: [^ 127]. keyValue < 32 ifTrue: [^ keyValue]. keyValue > 255 ifTrue: [^ 0]. ^ #(0 0 0 0 0 0 0 0 0 61472 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 61472 61473 61474 61475 61476 61477 61478 61479 61480 61481 61482 61483 61484 61485 61486 61487 61488 61489 61490 61491 61492 61493 61494 61495 61496 61497 61498 61499 61500 61501 61502 61503 61504 61505 61506 61507 61508 61509 61510 61511 61512 61513 61514 61515 61516 61517 61518 61519 61520 61521 61522 61523 61524 61525 61526 61527 61528 61529 61530 61531 61532 61533 61534 61535 61536 61537 61538 61539 61540 61541 61542 61543 61544 61545 61546 61547 61548 61549 61550 61551 61552 61553 61554 61555 61556 61557 61558 61559 61560 61561 61562 61563 61564 61565 61566 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 61601 61602 61603 61604 61605 61606 61607 61608 61609 61610 61611 61612 61613 61614 61615 61616 61617 61618 61619 61620 61621 61622 61623 61624 61625 61626 61627 61628 61629 61630 61631 61632 61633 61634 61635 61636 61637 61638 61639 61640 61641 61642 61643 61644 61645 61646 61647 616 48 61649 61650 61651 61652 61653 61654 61655 61656 61657 61658 61659 61660 61661 61662 61663 61664 61665 61666 61667 61668 61669 61670 61671 61672 61673 61674 61675 61676 61677 61678 61679 0 61681 61682 61683 61684 61685 61686 61687 61688 61689 61690 61691 61692 61693 61694 0) at: keyValue + 1. ! Item was changed: ----- Method: TextConverter class>>allEncodingNames (in category 'utilities') ----- allEncodingNames "TextConverter allEncodingNames" | encodingNames | encodingNames := Set new. self allSubclasses do: [:each | | names | names := each encodingNames. names notEmpty ifTrue: [encodingNames add: names first asSymbol]]. ^encodingNames! Item was changed: + ----- Method: UTF32InputInterpreter>>nextCharFrom:firstEvt: (in category 'keyboard') ----- - ----- Method: UTF32InputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') ----- nextCharFrom: sensor firstEvt: evtBuf "Fall back on MacRoman if char is 0" ^(evtBuf at: 6) > 0 ifTrue: [(evtBuf at: 6) asCharacter] ifFalse: [(evtBuf at: 3) asCharacter macToSqueak]. ! Item was changed: + ----- Method: UTF32JPInputInterpreter>>nextCharFrom:firstEvt: (in category 'keyboard') ----- - ----- Method: UTF32JPInputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') ----- nextCharFrom: sensor firstEvt: evtBuf | keyValue mark | keyValue := evtBuf at: 6. keyValue = 0 ifTrue: [keyValue := evtBuf at: 3]. mark := self japaneseSpecialMark: keyValue. mark notNil ifTrue: [^ mark]. keyValue < 256 ifTrue: [^ (Character value: keyValue) squeakToIso]. ^ Character leadingChar: JapaneseEnvironment leadingChar code: keyValue! Item was changed: + ----- Method: UTF8ClipboardInterpreter>>fromSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: UTF8ClipboardInterpreter>>fromSystemClipboard: (in category 'as yet unclassified') ----- fromSystemClipboard: aString ^aString utf8ToSqueak! Item was changed: + ----- Method: UTF8ClipboardInterpreter>>toSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: UTF8ClipboardInterpreter>>toSystemClipboard: (in category 'as yet unclassified') ----- toSystemClipboard: aString ^aString squeakToUtf8 ! Item was changed: + ----- Method: UTF8TextConverter class>>initializeLatin1MapAndEncodings (in category 'class initialization') ----- - ----- Method: UTF8TextConverter class>>initializeLatin1MapAndEncodings (in category 'as yet unclassified') ----- initializeLatin1MapAndEncodings "Initialize the latin1Map and latin1Encodings. These variables ensure that conversions from latin1 ByteString is reasonably fast." latin1Map := (0 to: 255) collect: [ :each | each bitShift: -7 ] as: ByteArray. latin1Encodings := (0 to: 255) collect: [ :each | each <= 127 ifTrue: [ nil ] ifFalse: [ { 192 bitOr: (each bitShift: -6). (each bitAnd: 63) bitOr: 128 } asByteArray asString ] ]! Item was changed: + ----- Method: UndefinedConversion class>>signalFor:toEncoding: (in category 'exceptionInstantiator') ----- - ----- Method: UndefinedConversion class>>signalFor:toEncoding: (in category 'as yet unclassified') ----- signalFor: characterValue toEncoding: anEncoding self new unicodeValue: characterValue; targetEncoding: anEncoding; signal! Item was changed: + ----- Method: UnicodeInputInterpreter>>nextCharFrom:firstEvt: (in category 'keyboard') ----- - ----- Method: UnicodeInputInterpreter>>nextCharFrom:firstEvt: (in category 'converting') ----- nextCharFrom: sensor firstEvt: evtBuf "Compose Unicode character sequences" | peekEvent keyValue composed | "Only try this if the first event is composable and is a character event" ((Unicode isComposable: (keyValue := evtBuf sixth)) and:[evtBuf fourth = EventKeyChar]) ifTrue:[ "If we have a pending keyDown in the queue, skip that to get to the keystroke" peekEvent := sensor peekEvent. (peekEvent notNil and: [peekEvent fourth = EventKeyDown]) ifTrue: [ "skipEvent := "sensor nextEvent. peekEvent := sensor peekEvent]. "If we have another character event in the queue, compose it" (peekEvent notNil and: [peekEvent first = EventTypeKeyboard and:[peekEvent fourth = EventKeyChar]]) ifTrue:[ composed := Unicode compose: keyValue with: peekEvent sixth. composed ifNotNil:[ sensor nextEvent. ^composed]]]. "XXXX: Fixme. We should put the skipped event back if we haven't consumed it." ^keyValue asCharacter! Item was changed: + ----- Method: UnixEUCJPInputInterpreter>>initialize (in category 'initialize-release') ----- - ----- Method: UnixEUCJPInputInterpreter>>initialize (in category 'as yet unclassified') ----- initialize converter := EUCJPTextConverter new. ! Item was changed: + ----- Method: UnixEUCJPInputInterpreter>>nextCharFrom:firstEvt: (in category 'keyboard') ----- - ----- Method: UnixEUCJPInputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') ----- nextCharFrom: sensor firstEvt: evtBuf | firstChar secondChar peekEvent keyValue type stream multiChar | keyValue := evtBuf third. evtBuf fourth = EventKeyChar ifTrue: [type := #keystroke]. peekEvent := sensor peekEvent. (peekEvent notNil and: [peekEvent fourth = EventKeyDown]) ifTrue: [ sensor nextEvent. peekEvent := sensor peekEvent]. (type == #keystroke and: [peekEvent notNil and: [peekEvent first = EventTypeKeyboard and: [peekEvent fourth = EventKeyChar]]]) ifTrue: [ firstChar := keyValue asCharacter. secondChar := (peekEvent third) asCharacter. stream := ReadStream on: (String with: firstChar with: secondChar). multiChar := converter nextFromStream: stream. multiChar isOctetCharacter ifFalse: [sensor nextEvent]. ^ multiChar]. ^ keyValue asCharacter! Item was changed: + ----- Method: UnixJPClipboardInterpreter>>fromSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: UnixJPClipboardInterpreter>>fromSystemClipboard: (in category 'as yet unclassified') ----- fromSystemClipboard: aString ^ aString convertFromSystemString! Item was changed: + ----- Method: UnixJPClipboardInterpreter>>toSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: UnixJPClipboardInterpreter>>toSystemClipboard: (in category 'as yet unclassified') ----- toSystemClipboard: text | string | "self halt." string := text asString. string isAsciiString ifTrue: [^ string asOctetString]. string isOctetString ifTrue: [^ string "hmm"]. ^ string convertToSystemString . ! Item was changed: + ----- Method: UnixUTF8JPInputInterpreter>>initialize (in category 'initialize-release') ----- - ----- Method: UnixUTF8JPInputInterpreter>>initialize (in category 'as yet unclassified') ----- initialize converter := UTF8TextConverter new.! Item was changed: + ----- Method: UnixUTF8JPInputInterpreter>>nextCharFrom:firstEvt: (in category 'keyboard') ----- - ----- Method: UnixUTF8JPInputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') ----- nextCharFrom: sensor firstEvt: evtBuf | firstChar aCollection bytes peekEvent keyValue type stream multiChar | keyValue := evtBuf third. evtBuf fourth = EventKeyChar ifTrue: [type := #keystroke]. peekEvent := sensor peekEvent. (peekEvent notNil and: [peekEvent fourth = EventKeyDown]) ifTrue: [ sensor nextEvent. peekEvent := sensor peekEvent]. (type == #keystroke and: [peekEvent notNil and: [peekEvent first = EventTypeKeyboard and: [peekEvent fourth = EventKeyChar]]]) ifTrue: [ firstChar := keyValue asCharacter. aCollection := OrderedCollection new. aCollection add: firstChar. bytes := (keyValue <= 127) ifTrue: [ 0 ] ifFalse: [ (keyValue bitAnd: 16rE0) = 192 ifTrue: [ 1 ] ifFalse: [ (keyValue bitAnd: 16rF0) = 224 ifTrue: [ 2 ] ifFalse: [ 3 ] ] ]. bytes timesRepeat: [ aCollection add: sensor nextEvent third asCharacter ]. "aCollection do: [ :each | Transcript show: (each asciiValue hex , ' ')]. Transcript show: Character cr." stream := ReadStream on: (String withAll: aCollection). multiChar := converter nextFromStream: stream. multiChar isOctetCharacter ifFalse: [ sensor nextEvent ]. ^ multiChar]. ^ keyValue asCharacter! Item was changed: + ----- Method: WinCPTextConverter class>>initializeDecodeTable (in category 'class initialization') ----- - ----- Method: WinCPTextConverter class>>initializeDecodeTable (in category 'as yet unclassified') ----- initializeDecodeTable decodeTable := (0 to: 255) asArray! Item was changed: + ----- Method: WinGB2312ClipboardInterpreter>>fromSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: WinGB2312ClipboardInterpreter>>fromSystemClipboard: (in category 'as yet unclassified') ----- fromSystemClipboard: aString ^ aString squeakToMac convertFromSystemString. ! Item was changed: + ----- Method: WinGB2312ClipboardInterpreter>>toSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: WinGB2312ClipboardInterpreter>>toSystemClipboard: (in category 'as yet unclassified') ----- toSystemClipboard: text | string | "self halt." string := text asString. string isAsciiString ifTrue: [^ string asOctetString]. string isOctetString ifTrue: [^ string "hmm"]. ^ string convertToSystemString squeakToMac. ! Item was changed: + ----- Method: WinGB2312InputInterpreter>>initialize (in category 'initialize-release') ----- - ----- Method: WinGB2312InputInterpreter>>initialize (in category 'as yet unclassified') ----- initialize converter := CNGBTextConverter new. ! Item was changed: + ----- Method: WinGB2312InputInterpreter>>nextCharFrom:firstEvt: (in category 'keyboard') ----- - ----- Method: WinGB2312InputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') ----- nextCharFrom: sensor firstEvt: evtBuf | firstCharacter secondCharacter peekEvent char1Value keyValue pressType type stream multiCharacter | keyValue := evtBuf third. pressType := evtBuf fourth. pressType = EventKeyDown ifTrue: [type := #keyDown]. pressType = EventKeyUp ifTrue: [type := #keyUp]. pressType = EventKeyChar ifTrue: [type := #keystroke]. char1Value := (Character value: keyValue) macToSqueak asciiValue. ((char1Value > 127 and: [char1Value < 160]) or: [char1Value > 223 and: [char1Value < 253]]) ifFalse: [ ^ keyValue asCharacter. ]. peekEvent := sensor peekEvent. "peekEvent printString displayAt: 0@0." (peekEvent notNil and: [(peekEvent at: 4) = EventKeyDown]) ifTrue: [sensor nextEvent. peekEvent := sensor peekEvent]. (type = #keystroke and: [peekEvent notNil and: [(peekEvent at: 1) = EventTypeKeyboard and: [(peekEvent at: 4) = EventKeyChar]]]) ifTrue: [ firstCharacter := char1Value asCharacter. secondCharacter := (peekEvent at: 3) asCharacter macToSqueak. stream := ReadStream on: (String with: firstCharacter with: secondCharacter). multiCharacter := converter nextFromStream: stream. multiCharacter isOctetCharacter ifFalse: [ sensor nextEvent. ]. ^ multiCharacter. ]. ^ keyValue asCharacter. ! Item was changed: + ----- Method: WinKSX1001ClipboardInterpreter>>fromSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: WinKSX1001ClipboardInterpreter>>fromSystemClipboard: (in category 'as yet unclassified') ----- fromSystemClipboard: aString ^ aString squeakToMac convertFromSystemString. ! Item was changed: + ----- Method: WinKSX1001ClipboardInterpreter>>toSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: WinKSX1001ClipboardInterpreter>>toSystemClipboard: (in category 'as yet unclassified') ----- toSystemClipboard: text | string | "self halt." string := text asString. string isAsciiString ifTrue: [^ string asOctetString]. string isOctetString ifTrue: [^ string "hmm"]. ^ string convertToSystemString squeakToMac. ! Item was changed: + ----- Method: WinKSX1001InputInterpreter>>initialize (in category 'initialize-release') ----- - ----- Method: WinKSX1001InputInterpreter>>initialize (in category 'as yet unclassified') ----- initialize converter := EUCKRTextConverter new. ! Item was changed: + ----- Method: WinKSX1001InputInterpreter>>nextCharFrom:firstEvt: (in category 'keyboard') ----- - ----- Method: WinKSX1001InputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') ----- nextCharFrom: sensor firstEvt: evtBuf | firstCharacter secondCharacter peekEvent char1Value keyValue pressType type stream multiCharacter | keyValue := evtBuf third. pressType := evtBuf fourth. pressType = EventKeyDown ifTrue: [type := #keyDown]. pressType = EventKeyUp ifTrue: [type := #keyUp]. pressType = EventKeyChar ifTrue: [type := #keystroke]. char1Value := (Character value: keyValue) macToSqueak asciiValue. ((char1Value > 127 and: [char1Value < 160]) or: [char1Value > 223 and: [char1Value < 253]]) ifFalse: [ ^ keyValue asCharacter. ]. peekEvent := sensor peekEvent. "peekEvent printString displayAt: 0@0." (peekEvent notNil and: [(peekEvent at: 4) = EventKeyDown]) ifTrue: [sensor nextEvent. peekEvent := sensor peekEvent]. (type = #keystroke and: [peekEvent notNil and: [(peekEvent at: 1) = EventTypeKeyboard and: [(peekEvent at: 4) = EventKeyChar]]]) ifTrue: [ firstCharacter := char1Value asCharacter. secondCharacter := (peekEvent at: 3) asCharacter macToSqueak. stream := ReadStream on: (String with: firstCharacter with: secondCharacter). multiCharacter := converter nextFromStream: stream. multiCharacter isOctetCharacter ifFalse: [ sensor nextEvent. ]. ^ multiCharacter. ]. ^ keyValue asCharacter. ! Item was changed: + ----- Method: WinShiftJISClipboardInterpreter>>fromSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: WinShiftJISClipboardInterpreter>>fromSystemClipboard: (in category 'as yet unclassified') ----- fromSystemClipboard: aString ^ aString macToSqueak convertFromSystemString ! Item was changed: + ----- Method: WinShiftJISClipboardInterpreter>>toSystemClipboard: (in category 'conversion-clipboard') ----- - ----- Method: WinShiftJISClipboardInterpreter>>toSystemClipboard: (in category 'as yet unclassified') ----- toSystemClipboard: text | string | "self halt." string := text asString. string isAsciiString ifTrue: [^ string asOctetString]. string isOctetString ifTrue: [^ string "hmm"]. ^ string convertToSystemString squeakToMac. ! Item was changed: + ----- Method: WinShiftJISInputInterpreter>>initialize (in category 'initialize-release') ----- - ----- Method: WinShiftJISInputInterpreter>>initialize (in category 'as yet unclassified') ----- initialize converter := ShiftJISTextConverter new. ! Item was changed: + ----- Method: WinShiftJISInputInterpreter>>nextCharFrom:firstEvt: (in category 'keyboard') ----- - ----- Method: WinShiftJISInputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') ----- nextCharFrom: sensor firstEvt: evtBuf | firstCharacter secondCharacter peekEvent char1Value keyValue pressType type stream multiCharacter | keyValue := evtBuf third. pressType := evtBuf fourth. pressType = EventKeyDown ifTrue: [type := #keyDown]. pressType = EventKeyUp ifTrue: [type := #keyUp]. pressType = EventKeyChar ifTrue: [type := #keystroke]. char1Value := (Character value: keyValue) macToSqueak asciiValue. (char1Value < 16r81) ifTrue: [^ keyValue asCharacter]. (char1Value > 16rA0 and: [char1Value < 16rE0]) ifTrue: [^ ShiftJISTextConverter basicNew katakanaValue: char1Value]. peekEvent := sensor peekEvent. "peekEvent printString displayAt: 0@0." (peekEvent notNil and: [(peekEvent at: 4) = EventKeyDown]) ifTrue: [sensor nextEvent. peekEvent := sensor peekEvent]. (type = #keystroke and: [peekEvent notNil and: [(peekEvent at: 1) = EventTypeKeyboard and: [(peekEvent at: 4) = EventKeyChar]]]) ifTrue: [ firstCharacter := char1Value asCharacter. secondCharacter := (peekEvent at: 3) asCharacter macToSqueak. stream := ReadStream on: (String with: firstCharacter with: secondCharacter). multiCharacter := converter nextFromStream: stream. multiCharacter isOctetCharacter ifFalse: [ sensor nextEvent. ]. ^ multiCharacter. ]. ^ keyValue asCharacter. ! Item was changed: + ----- Method: X11Encoding class>>encoding (in category 'encoding') ----- - ----- Method: X11Encoding class>>encoding (in category 'as yet unclassified') ----- encoding | enc | enc := self getEncoding. enc ifNil: [ ^ nil ]. ^ enc asLowercase.! Item was changed: + ----- Method: X11Encoding class>>getEncoding (in category 'primitives') ----- - ----- Method: X11Encoding class>>getEncoding (in category 'as yet unclassified') ----- getEncoding <primitive: 'primGetEncoding' module: 'ImmX11Plugin'> ^ nil ! Item was changed: + ----- Method: X11Encoding class>>getLocaleEncoding (in category 'primitives') ----- - ----- Method: X11Encoding class>>getLocaleEncoding (in category 'as yet unclassified') ----- getLocaleEncoding <primitive: 'primGetLocaleEncoding' module: 'ImmX11Plugin'> ^ nil ! Item was changed: + ----- Method: X11Encoding class>>getPathEnc (in category 'primitives') ----- - ----- Method: X11Encoding class>>getPathEnc (in category 'as yet unclassified') ----- getPathEnc <primitive: 'primGetPathEnc' module: 'ImmX11Plugin'> ^ nil ! Item was changed: + ----- Method: X11Encoding class>>getTextEnc (in category 'primitives') ----- - ----- Method: X11Encoding class>>getTextEnc (in category 'as yet unclassified') ----- getTextEnc <primitive: 'primGetTextEnc' module: 'ImmX11Plugin'> ^ nil ! Item was changed: + ----- Method: X11Encoding class>>getXWinEnc (in category 'primitives') ----- - ----- Method: X11Encoding class>>getXWinEnc (in category 'as yet unclassified') ----- getXWinEnc <primitive: 'primGetXWinEnc' module: 'ImmX11Plugin'> ^ nil ! Item was changed: + ----- Method: X11Encoding class>>requestUTF8 (in category 'primitives') ----- - ----- Method: X11Encoding class>>requestUTF8 (in category 'as yet unclassified') ----- requestUTF8 <primitive: 'primIsTextEncUTF8' module: 'ImmX11Plugin'> ^ nil ! Item was changed: + ----- Method: X11Encoding class>>requestUTF8: (in category 'primitives') ----- - ----- Method: X11Encoding class>>requestUTF8: (in category 'as yet unclassified') ----- requestUTF8: bool <primitive: 'primSetTextEncUTF8' module: 'ImmX11Plugin'> ^ nil ! Item was changed: + ----- Method: X11Encoding class>>setEncoding: (in category 'primitives') ----- - ----- Method: X11Encoding class>>setEncoding: (in category 'as yet unclassified') ----- setEncoding: encoding <primitive: 'primSetEncoding' module: 'ImmX11Plugin'> ^ nil ! Item was changed: + ----- Method: X11Encoding class>>setEncodingToLocale (in category 'primitives') ----- - ----- Method: X11Encoding class>>setEncodingToLocale (in category 'as yet unclassified') ----- setEncodingToLocale <primitive: 'primSetEncodingToLocale' module: 'ImmX11Plugin'> ^ nil ! Item was changed: + ----- Method: X11Encoding class>>setPathEnc: (in category 'primitives') ----- - ----- Method: X11Encoding class>>setPathEnc: (in category 'as yet unclassified') ----- setPathEnc: encoding <primitive: 'primSetPathEnc' module: 'ImmX11Plugin'> ^ nil ! Item was changed: + ----- Method: X11Encoding class>>setPathEncToLocale (in category 'primitives') ----- - ----- Method: X11Encoding class>>setPathEncToLocale (in category 'as yet unclassified') ----- setPathEncToLocale <primitive: 'primSetPathEncToLocale' module: 'ImmX11Plugin'> ^ nil ! Item was changed: + ----- Method: X11Encoding class>>setTextEnc: (in category 'primitives') ----- - ----- Method: X11Encoding class>>setTextEnc: (in category 'as yet unclassified') ----- setTextEnc: encoding <primitive: 'primSetTextEnc' module: 'ImmX11Plugin'> ^ nil ! Item was changed: + ----- Method: X11Encoding class>>setTextEncToLocale (in category 'primitives') ----- - ----- Method: X11Encoding class>>setTextEncToLocale (in category 'as yet unclassified') ----- setTextEncToLocale <primitive: 'primSetTextEncToLocale' module: 'ImmX11Plugin'> ^ nil ! Item was changed: + ----- Method: X11Encoding class>>setXWinEnc: (in category 'primitives') ----- - ----- Method: X11Encoding class>>setXWinEnc: (in category 'as yet unclassified') ----- setXWinEnc: encoding <primitive: 'primSetXWinEnc' module: 'ImmX11Plugin'> ^ nil ! Item was changed: + ----- Method: X11Encoding class>>setXWinEncToLocale (in category 'primitives') ----- - ----- Method: X11Encoding class>>setXWinEncToLocale (in category 'as yet unclassified') ----- setXWinEncToLocale <primitive: 'primSetXWinEncToLocale' module: 'ImmX11Plugin'> ^ nil ! Item was changed: + ----- Method: X11Encoding class>>useEncoding: (in category 'encoding') ----- - ----- Method: X11Encoding class>>useEncoding: (in category 'as yet unclassified') ----- useEncoding: encoding self setEncoding: encoding. LanguageEnvironment startUp. ^ self encoding.! Item was changed: + ----- Method: X11Encoding class>>useLocaleEncoding (in category 'encoding') ----- - ----- Method: X11Encoding class>>useLocaleEncoding (in category 'as yet unclassified') ----- useLocaleEncoding self setEncodingToLocale. LanguageEnvironment startUp. ^ self encoding.!

1 0

The Trunk: Tools-pre.835.mcz
by commits＠source.squeak.org 03 Dec '18

03 Dec '18

Patrick Rein uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-pre.835.mcz ==================== Summary ==================== Name: Tools-pre.835 Author: pre Time: 3 December 2018, 10:41:37.808597 am UUID: 41d6096e-dc6a-e14e-a821-8a68d70f1098 Ancestors: Tools-pre.834 Pushes the refactoring of FileCOntentsBrowser instance creation methods further to eliminate all duplicate code. =============== Diff against Tools-pre.834 =============== Item was changed: ----- Method: FileContentsBrowser class>>browseFiles: (in category 'instance creation') ----- browseFiles: fileList "Open a browser on the packages found within the files in the list; we expect the list to contain acceptable filename strings. If there is more than one package found the browser will be a full system browser, otherwise it will be a category browser" + ^ (self createBrowserForPackagesFrom: fileList withEach: [:fileName | + FilePackage fromFileNamed: fileName]) buildAndOpenBrowser - | browser organizerAndPackageDict | - Cursor wait showWhile: [ - organizerAndPackageDict := self buildOrganizerWithPackagesFrom: fileList withEach: [:fileName | - FilePackage fromFileNamed: fileName]. - (browser := self systemOrganizer: organizerAndPackageDict first) - packages: organizerAndPackageDict second]. - ^ browser buildAndOpenBrowser ! Item was removed: - ----- Method: FileContentsBrowser class>>buildOrganizerWithPackagesFrom:withEach: (in category 'private') ----- - buildOrganizerWithPackagesFrom: collectionOfPackageSources withEach: filePackageCreation - - | organizer packageDict | - packageDict := Dictionary new. - organizer := SystemOrganizer defaultList: Array new. - - collectionOfPackageSources do: [:src | | package | - package := filePackageCreation value: src. - packageDict - at: package packageName - put: package. - organizer - classifyAll: package classes keys - under: package packageName]. - - ^ {organizer . packageDict}! Item was added: + ----- Method: FileContentsBrowser class>>createBrowserForPackagesFrom:withEach: (in category 'private') ----- + createBrowserForPackagesFrom: collectionOfPackageSources withEach: filePackageCreation + + | browser packageDict organizer | + Cursor wait showWhile: [ + browser := self new. + packageDict := Dictionary new. + organizer := SystemOrganizer defaultList: Array new. + + collectionOfPackageSources do: [:src | | package | + package := filePackageCreation value: src. + packageDict + at: package packageName + put: package. + organizer + classifyAll: package classes keys + under: package packageName]. + + (browser := self systemOrganizer: organizer) + packages: packageDict]. + ^ browser! Item was changed: ----- Method: FileContentsBrowser class>>createBrowserForStream:named: (in category 'private') ----- createBrowserForStream: aStream named: aString + ^ self createBrowserForPackagesFrom: {aStream} withEach: [:stream | + (FilePackage new fullName: aString; fileInFrom: aStream)]! - | browser organizerAndPackageDict | - Cursor wait showWhile: [ - browser := self new. - organizerAndPackageDict := self buildOrganizerWithPackagesFrom: {aStream} withEach: [:stream | - (FilePackage new fullName: aString; fileInFrom: aStream)]. - (browser := self systemOrganizer: organizerAndPackageDict first) - packages: organizerAndPackageDict second]. - ^ browser!

1 0

The Trunk: GraphicsTests-mt.50.mcz
by commits＠source.squeak.org 02 Dec '18

02 Dec '18

Marcel Taeumel uploaded a new version of GraphicsTests to project The Trunk: http://source.squeak.org/trunk/GraphicsTests-mt.50.mcz ==================== Summary ==================== Name: GraphicsTests-mt.50 Author: mt Time: 2 December 2018, 11:52:32.350325 am UUID: 47215a6d-cd2c-b749-8e8b-402fef91d861 Ancestors: GraphicsTests-pre.49 Fixes categories for point tests. Adds tests for infix rectangle creation. =============== Diff against GraphicsTests-pre.49 =============== Item was changed: SystemOrganization addCategory: #'GraphicsTests-Files'! SystemOrganization addCategory: #'GraphicsTests-Primitives'! - SystemOrganization addCategory: #'GraphicsTests-Transformations'! SystemOrganization addCategory: #'GraphicsTests-Text'! Item was changed: + ----- Method: PointTest>>testBasicFourDirections (in category 'tests') ----- - ----- Method: PointTest>>testBasicFourDirections (in category 'testing - testing') ----- testBasicFourDirections "fourDirections returns the four rotation of the receiver in counter clockwise order with the receiver appearing last. " | samples results rejects | self assert: (0 asPoint fourDirections) = (Array new: 4 withAll: 0 asPoint) . samples := 0 asPoint eightNeighbors . results := { { 0 @ -1 . -1 @ 0 . 0 @ 1 . 1 @ 0}. { 1 @ -1 . -1 @ -1 . -1 @ 1 . 1 @ 1}. { 1 @ 0 . 0 @ -1 . -1 @ 0 . 0 @ 1}. { 1 @ 1 . 1 @ -1 . -1 @ -1 . -1 @ 1}. { 0 @ 1 . 1 @ 0 . 0 @ -1 . -1 @ 0}. {-1 @ 1 . 1 @ 1 . 1 @ -1 . -1 @ -1}. {-1 @ 0 . 0 @ 1 . 1 @ 0 . 0 @ -1}. {-1 @ -1 . -1 @ 1 . 1 @ 1 . 1 @ -1} } . rejects := (1 to: samples size ) reject: [ :each | (samples at: each) fourDirections = (results at: each) ] . self assert: rejects isEmpty! Item was changed: + ----- Method: PointTest>>testBearingToPoint (in category 'tests') ----- - ----- Method: PointTest>>testBearingToPoint (in category 'tests - testing') ----- testBearingToPoint self assert: (0 @ 0 bearingToPoint: 0 @ 0) = 0. self assert: (0 @ 0 bearingToPoint: 0 @ -1) = 0. self assert: (0 @ 0 bearingToPoint: 1 @ 0) = 90. self assert: (0 @ 0 bearingToPoint: 0 @ 1) = 180. self assert: (0 @ 0 bearingToPoint: -1 @ 0) = 270. self assert: (0 @ 0 bearingToPoint: 1 @ 1) = 135. self assert: (0 @ 0 bearingToPoint: 0.01 @ 0) = 90. self assert: (0 @ 0 bearingToPoint: -2 @ -3) = 326. self assert: (0 @ 0 bearingToPoint: -0 @ 0) = 0. self assert: (-2 @ -3 bearingToPoint: 0 @ 0) = 146.! Item was changed: + ----- Method: PointTest>>testFourDirectionsInvarients (in category 'tests') ----- - ----- Method: PointTest>>testFourDirectionsInvarients (in category 'testing - testing') ----- testFourDirectionsInvarients " fourDirections returns the four rotation of the reciever in counter clockwise order with the reciever appearing last. " | samples rejects | samples := 0 asPoint eightNeighbors . rejects := (1 to: samples size ) reject: [ :each | (samples at: each) fourDirections last = ( samples at: each) ] . self assert: ( rejects isEmpty) . ! Item was changed: + ----- Method: PointTest>>testFourDirectionsRotationInvarients (in category 'tests') ----- - ----- Method: PointTest>>testFourDirectionsRotationInvarients (in category 'testing - testing') ----- testFourDirectionsRotationInvarients " fourDirections returns the four rotation of the reciever in counter clockwise order with the reciever appearing last. " | samples rejects | samples := 0 asPoint eightNeighbors . rejects := (1 to: samples size ) reject: [ :each | | answer | (answer := (samples at: each) fourDirections ) . (1 to: 4) allSatisfy: [ :eachDirIndex | ( answer atWrap: eachDirIndex) leftRotated = (( answer atWrap: eachDirIndex + 1) ) ] ] . self assert: ( rejects isEmpty) . ! Item was changed: + ----- Method: PointTest>>testIsZero (in category 'tests') ----- - ----- Method: PointTest>>testIsZero (in category 'tests - testing') ----- testIsZero self assert: (0@0) isZero. self deny: (0@1) isZero. self deny: (1@0) isZero. self deny: (1@1) isZero.! Item was changed: + ----- Method: PointTest>>testNormal (in category 'tests') ----- - ----- Method: PointTest>>testNormal (in category 'testing - testing') ----- testNormal "quick check of results for #normal." | samples rejects results | samples := 0 asPoint eightNeighbors , (Array with: 0 asPoint) . results := { 0.0 @ 1.0 . -0.707106781186547 @ 0.707106781186547 . -1.0 @ 0.0 . -0.707106781186547 @ -0.707106781186547 . 0.0 @ -1.0 . 0.707106781186547 @ -0.707106781186547 . 1.0 @ 0.0 . 0.707106781186547 @ 0.707106781186547 . -1 @ 0} . rejects := (1 to: samples size ) reject: [ :each | ((samples at: each) normal - (results at: each)) abs < 1e-15 asPoint ] . self assert: rejects isEmpty! Item was changed: + ----- Method: PointTest>>testNormal2 (in category 'tests') ----- - ----- Method: PointTest>>testNormal2 (in category 'testing - testing') ----- testNormal2 "quick check of results for #normal. differs from the other testNormal in the way that the difference is measured." | samples rejects results differences | samples := 0 asPoint eightNeighbors , (Array with: 0 asPoint) . results := { 0.0 @ 1.0 . -0.707106781186547 @ 0.707106781186547 . -1.0 @ 0.0 . -0.707106781186547 @ -0.707106781186547 . 0.0 @ -1.0 . 0.707106781186547 @ -0.707106781186547 . 1.0 @ 0.0 . 0.707106781186547 @ 0.707106781186547 . -1 @ 0} . differences := samples with: results collect: [ :each :eachResult | each normal - eachResult ] . rejects := differences reject: [ :each | (each x closeTo: 0.0) and: [each y closeTo: 0.0] ] . self assert: rejects isEmpty! Item was added: + ----- Method: PointTest>>testRectangleMix (in category 'tests') ----- + testRectangleMix + + { + Rectangle center: 60@60 extent: 100@100. + Rectangle origin: 10@10 extent: 100@100. + Rectangle origin: 10@10 corner: 110@110. + + 60@60 inflate: 100@100. + 10@10 extent: 100@100. + 10@10 corner: 110@110. + } permutationsDo: [:rects | + rects overlappingPairsDo: [:r1 :r2 | + self assert: r1 equals: r2]].! Item was added: + ----- Method: PointTest>>testRectangleWithCorner (in category 'tests') ----- + testRectangleWithCorner + + self + assert: (Rectangle origin: 10@10 corner: 110@110) + equals: (10@10 corner: 110@110).! Item was added: + ----- Method: PointTest>>testRectangleWithExtent (in category 'tests') ----- + testRectangleWithExtent + + self + assert: (Rectangle origin: 50@50 extent: 100@100) + equals: (50@50 extent: 100@100).! Item was added: + ----- Method: PointTest>>testRectangleWithInflate (in category 'tests') ----- + testRectangleWithInflate + + self + assert: (Rectangle center: 50@50 extent: 100@100) + equals: (50@50 inflate: 100@100).! Item was changed: + ----- Method: PointTest>>testRotations (in category 'tests') ----- - ----- Method: PointTest>>testRotations (in category 'testing - testing') ----- testRotations " Here we are testing rightRotated and leftRotated which are new. Because there is really no coverage for point functions this also serves as a tests of sorts for rotateBy:CenterAt:" | samples | samples := 0 asPoint eightNeighbors , (Array with: 0 asPoint) . self assert: (samples allSatisfy: [ :each | each rightRotated leftRotated = each ] ) . self assert: (samples allSatisfy: [ :each | each rightRotated = (each rotateBy: #right centerAt: 0 asPoint)] ) . self assert: (samples allSatisfy: [ :each | each leftRotated = (each rotateBy: #left centerAt: 0 asPoint ) ] ) . self assert: (samples allSatisfy: [ :each | each negated = (each rotateBy: #pi centerAt: 0 asPoint ) ] ) . self assert: (samples allSatisfy: [ :each | each leftRotated leftRotated leftRotated leftRotated = each ]) . self assert: (samples allSatisfy: [ :each | each rightRotated rightRotated rightRotated rightRotated = each ] ) . ! Item was changed: + ----- Method: PointTest>>testSign (in category 'tests') ----- - ----- Method: PointTest>>testSign (in category 'testing - testing') ----- testSign | samples results rejects | samples := 0 asPoint eightNeighbors , (Array with: 0 asPoint). results := samples collect: [ :each | each sign ]. rejects := (1 to: samples size ) reject: [ :each | (samples at: each) = (results at: each) ] . self assert: (rejects isEmpty) ! Item was changed: + ----- Method: PointTest>>testTheta (in category 'tests') ----- - ----- Method: PointTest>>testTheta (in category 'testing - testing') ----- testTheta | result dir tan x y | self assert: ((0 @ 1) theta - 90.0 degreesToRadians) abs < 1e-15. self assert: ((0 @ -1) theta - 270.0 degreesToRadians) abs < 1e-15. " See code of old and new theta" x := 1.0 . y := -1.0. tan := y / x . dir := tan arcTan. result := 360.0 degreesToRadians + dir. self assert: ((x @ y) theta - result) abs < 1e-15. x := -1.0. "Don't reuse old results when you want numeric precision!!" tan := y / x . dir := tan arcTan. result := 180.0 degreesToRadians + dir. self assert: ((x @ y) theta - result) abs < 1e-15. ! Item was changed: + ----- Method: PointTest>>testZeroPointNormal (in category 'tests') ----- - ----- Method: PointTest>>testZeroPointNormal (in category 'testing - testing') ----- testZeroPointNormal "old: normal of zero point raised divide by zero error. new: normal of zero point returns a direction right rotated from zero points direction." self assert: 90 equals: (0 asPoint normal bearingToPoint: 0 asPoint).!

1 0

The Trunk: Graphics-mt.404.mcz
by commits＠source.squeak.org 02 Dec '18

02 Dec '18

Marcel Taeumel uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-mt.404.mcz ==================== Summary ==================== Name: Graphics-mt.404 Author: mt Time: 2 December 2018, 11:49:55.694325 am UUID: c61bf172-8ce2-2b42-9ded-3b10fa30cf8d Ancestors: Graphics-pre.403 Adds an infix version for Rectangle >> #center:extent: for convenience. The name #inflate: is subject to discussion. :-) =============== Diff against Graphics-pre.403 =============== Item was added: + ----- Method: Point>>inflate: (in category 'converting') ----- + inflate: aPoint + "Answer a Rectangle whose center is the receiver and whose extent is + aPoint. This is one of the infix ways of expressing the creation of a + rectangle." + + ^Rectangle center: self extent: aPoint!

1 0

The Trunk: 60Deprecated-mt.27.mcz
by commits＠source.squeak.org 02 Dec '18

02 Dec '18

Marcel Taeumel uploaded a new version of 60Deprecated to project The Trunk: http://source.squeak.org/trunk/60Deprecated-mt.27.mcz ==================== Summary ==================== Name: 60Deprecated-mt.27 Author: mt Time: 2 December 2018, 11:11:20.814325 am UUID: 0133c524-d990-db4f-8a76-de226601891d Ancestors: 60Deprecated-pre.26 Deprecations from Morphic-mt.1468 =============== Diff against 60Deprecated-pre.26 =============== Item was added: + ----- Method: BorderedMorph>>setBorderWidth:borderColor: (in category '*60Deprecated-private') ----- + setBorderWidth: w borderColor: bc + + self deprecated: 'mt: Use #borderStyle: or #borderWidth:/Color: directly.'. + + self borderWidth: w. + self borderColor: bc.! Item was added: + ----- Method: BorderedMorph>>setColor:borderWidth:borderColor: (in category '*60Deprecated-private') ----- + setColor: c borderWidth: w borderColor: bc + + self deprecated: 'mt: Use #borderStyle: or #borderWidth:/Color: directly.'. + + self color: c. + self borderWidth: w. + self borderColor: bc.!

1 0

The Trunk: Morphic-mt.1468.mcz
by commits＠source.squeak.org 02 Dec '18

02 Dec '18

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1468.mcz ==================== Summary ==================== Name: Morphic-mt.1468 Author: mt Time: 2 December 2018, 11:09:37.078325 am UUID: f2fb9cd4-6b5a-9941-adf6-0ecba9b669e5 Ancestors: Morphic-mt.1467 Two minor fixes in the realm of BorderedMorph: 1) Fixes a small issue with translucent borders. 2) Deprecates two set* messages. =============== Diff against Morphic-mt.1467 =============== Item was removed: - ----- Method: BorderedMorph>>setBorderWidth:borderColor: (in category 'private') ----- - setBorderWidth: w borderColor: bc - self borderWidth: w. - self borderColor: bc.! Item was removed: - ----- Method: BorderedMorph>>setColor:borderWidth:borderColor: (in category 'private') ----- - setColor: c borderWidth: w borderColor: bc - self color: c. - self borderWidth: w. - self borderColor: bc.! Item was changed: ----- Method: FormCanvas>>frameAndFillRectangle:fillColor:borderWidth:topLeftColor:bottomRightColor: (in category 'drawing-rectangles') ----- frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth topLeftColor: topLeftColor bottomRightColor: bottomRightColor | w h rect | "First use quick code for top and left borders and fill" self frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth borderColor: topLeftColor. + + "Return here for duplicate colors. Makes translucent borders work better." + topLeftColor = bottomRightColor ifTrue: [^ self]. "Now use slow code for bevelled bottom and right borders" bottomRightColor isTransparent ifFalse: [ borderWidth isNumber ifTrue: [w := h := borderWidth] ifFalse: [w := borderWidth x. h := borderWidth y]. rect := r translateBy: origin. self setFillColor: bottomRightColor. port frameRectRight: rect width: w; frameRectBottom: rect height: h]. ! Item was changed: ----- Method: MorphHierarchyListMorph>>createContainer (in category 'private') ----- createContainer "Private - Create a container" | container | container := BorderedMorph new. container extent: (self world extent * (1 / 4 @ (2 / 3))) rounded. container layoutPolicy: TableLayout new. container hResizing: #rigid. container vResizing: #rigid. container + color: (Color gray: 0.9); + borderWidth: 1; - setColor: (Color gray: 0.9) - borderWidth: 1 borderColor: Color gray. container layoutInset: 0. "container useRoundedCorners." "" container setProperty: #morphHierarchy toValue: true. container setNameTo: 'Objects Hierarchy' translated. "" ^ container!

1 0

The Trunk: ToolsTests-pre.88.mcz
by commits＠source.squeak.org 01 Dec '18

01 Dec '18

Patrick Rein uploaded a new version of ToolsTests to project The Trunk: http://source.squeak.org/trunk/ToolsTests-pre.88.mcz ==================== Summary ==================== Name: ToolsTests-pre.88 Author: pre Time: 1 December 2018, 5:30:40.389597 pm UUID: e09a182b-d053-484f-a21d-089e43b4ee45 Ancestors: ToolsTests-pre.87 Recategorized tests into the tests category (sorry could not resist). No other changes. =============== Diff against ToolsTests-pre.87 =============== Item was changed: + ----- Method: BrowseTest>>testBrowseClass (in category 'tests') ----- - ----- Method: BrowseTest>>testBrowseClass (in category 'testing') ----- testBrowseClass "self debug: #testBrowseClass" | browsersBefore browsersAfter opened | self ensureMorphic. browsersBefore := self currentBrowsers. self withImmediatelyOpeningWindowsDo: [1 class browse]. browsersAfter := self currentBrowsers. self assert: (browsersAfter size = (browsersBefore size + 1)). opened := browsersAfter removeAll: browsersBefore; yourself. self assert: (opened size = 1). opened := opened asArray first. self assert: (opened model selectedClass == SmallInteger). opened delete ! Item was changed: + ----- Method: BrowseTest>>testBrowseHierarchyClass (in category 'tests') ----- - ----- Method: BrowseTest>>testBrowseHierarchyClass (in category 'testing') ----- testBrowseHierarchyClass "self debug: #testBrowseHierarchyClass" | browsersBefore browsersAfter opened | self ensureMorphic. browsersBefore := self currentHierarchyBrowsers. self withImmediatelyOpeningWindowsDo: [1 class browseHierarchy]. browsersAfter := self currentHierarchyBrowsers. self assert: (browsersAfter size = (browsersBefore size + 1)). opened := browsersAfter removeAll: browsersBefore; yourself. self assert: (opened size = 1). opened := opened asArray first. self assert: (opened model selectedClass == SmallInteger). opened delete ! Item was changed: + ----- Method: BrowseTest>>testBrowseHierarchyInstance (in category 'tests') ----- - ----- Method: BrowseTest>>testBrowseHierarchyInstance (in category 'testing') ----- testBrowseHierarchyInstance "self debug: #testBrowseHierarchyInstance" | browsersBefore browsersAfter opened | self ensureMorphic. browsersBefore := self currentHierarchyBrowsers. self withImmediatelyOpeningWindowsDo: [1 browseHierarchy]. browsersAfter := self currentHierarchyBrowsers. self assert: (browsersAfter size = (browsersBefore size + 1)). opened := browsersAfter removeAll: browsersBefore; yourself. self assert: (opened size = 1). opened := opened asArray first. self assert: (opened model selectedClass == SmallInteger). opened delete ! Item was changed: + ----- Method: BrowseTest>>testBrowseHierarchyMetaclass (in category 'tests') ----- - ----- Method: BrowseTest>>testBrowseHierarchyMetaclass (in category 'testing') ----- testBrowseHierarchyMetaclass "self debug: #testBrowseHierarchyMetaclass" | browsersBefore browsersAfter opened | self ensureMorphic. browsersBefore := self currentHierarchyBrowsers. self withImmediatelyOpeningWindowsDo: [1 class class browseHierarchy]. browsersAfter := self currentHierarchyBrowsers. self assert: (browsersAfter size = (browsersBefore size + 1)). opened := browsersAfter removeAll: browsersBefore; yourself. self assert: (opened size = 1). opened := opened asArray first. self assert: (opened model selectedClass == Metaclass). opened delete ! Item was changed: + ----- Method: BrowseTest>>testBrowseInstance (in category 'tests') ----- - ----- Method: BrowseTest>>testBrowseInstance (in category 'testing') ----- testBrowseInstance "self debug: #testBrowseInstance" | browsersBefore browsersAfter opened | self ensureMorphic. browsersBefore := self currentBrowsers. self withImmediatelyOpeningWindowsDo: [1 browse]. browsersAfter := self currentBrowsers. self assert: (browsersAfter size = (browsersBefore size + 1)). opened := browsersAfter removeAll: browsersBefore; yourself. self assert: (opened size = 1). opened := opened asArray first. self assert: (opened model selectedClass == SmallInteger). opened delete ! Item was changed: + ----- Method: BrowseTest>>testBrowseMetaclass (in category 'tests') ----- - ----- Method: BrowseTest>>testBrowseMetaclass (in category 'testing') ----- testBrowseMetaclass "self debug: #testBrowseMetaclass" | browsersBefore browsersAfter opened | self ensureMorphic. browsersBefore := self currentBrowsers. self withImmediatelyOpeningWindowsDo: [1 class class browse]. browsersAfter := self currentBrowsers. self assert: (browsersAfter size = (browsersBefore size + 1)). opened := browsersAfter removeAll: browsersBefore; yourself. self assert: (opened size = 1). opened := opened asArray first. self assert: (opened model selectedClass == SmallInteger). opened delete ! Item was changed: + ----- Method: BrowseTest>>testFindReferencesToFloatNaN (in category 'tests') ----- - ----- Method: BrowseTest>>testFindReferencesToFloatNaN (in category 'testing') ----- testFindReferencesToFloatNaN self assert: (SystemNavigation new allCallsOn: (Float bindingOf: #NaN)) notEmpty! Item was changed: + ----- Method: BrowseTest>>testSystemNavigationAllBehaviorsDo (in category 'tests') ----- - ----- Method: BrowseTest>>testSystemNavigationAllBehaviorsDo (in category 'testing') ----- testSystemNavigationAllBehaviorsDo | oc | oc := OrderedCollection new. SystemNavigation new allBehaviorsDo: [:c| oc add: c]. self assert: oc size = oc asSet size! Item was changed: + ----- Method: DebuggerExtensionsTest>>testBooleansGeneralise (in category 'tests - canonical argument names') ----- - ----- Method: DebuggerExtensionsTest>>testBooleansGeneralise (in category 'testing - canonical argument names') ----- testBooleansGeneralise self assert: Boolean name equals: true canonicalArgumentName. self assert: Boolean name equals: false canonicalArgumentName! Item was changed: + ----- Method: DebuggerExtensionsTest>>testByteStringsGeneralise (in category 'tests - canonical argument names') ----- - ----- Method: DebuggerExtensionsTest>>testByteStringsGeneralise (in category 'testing - canonical argument names') ----- testByteStringsGeneralise self assert: String name equals: ByteString new canonicalArgumentName! Item was changed: + ----- Method: DebuggerExtensionsTest>>testClassesGeneralise (in category 'tests - canonical argument names') ----- - ----- Method: DebuggerExtensionsTest>>testClassesGeneralise (in category 'testing - canonical argument names') ----- testClassesGeneralise self assert: Class name equals: Class new canonicalArgumentName. self assert: Class name equals: 1 class canonicalArgumentName. self assert: Class name equals: true class canonicalArgumentName! Item was changed: + ----- Method: DebuggerExtensionsTest>>testCollectionsGeneralise (in category 'tests - canonical argument names') ----- - ----- Method: DebuggerExtensionsTest>>testCollectionsGeneralise (in category 'testing - canonical argument names') ----- testCollectionsGeneralise "ArrayedCollection and subclasses answer 'Array' " self assert: Array name equals: Array new canonicalArgumentName. "Otherwise answer the more general 'Collection' " self assert: Collection name equals: OrderedCollection new canonicalArgumentName. self assert: Collection name equals: LinkedList new canonicalArgumentName! Item was changed: + ----- Method: DebuggerExtensionsTest>>testFloatsGeneralise (in category 'tests - canonical argument names') ----- - ----- Method: DebuggerExtensionsTest>>testFloatsGeneralise (in category 'testing - canonical argument names') ----- testFloatsGeneralise self assert: Number name equals: 1.0 canonicalArgumentName! Item was changed: + ----- Method: DebuggerExtensionsTest>>testFractionsGeneralise (in category 'tests - canonical argument names') ----- - ----- Method: DebuggerExtensionsTest>>testFractionsGeneralise (in category 'testing - canonical argument names') ----- testFractionsGeneralise self assert: Number name equals: (1 / 2) canonicalArgumentName! Item was changed: + ----- Method: DebuggerExtensionsTest>>testIntegersDontGeneralise (in category 'tests - canonical argument names') ----- - ----- Method: DebuggerExtensionsTest>>testIntegersDontGeneralise (in category 'testing - canonical argument names') ----- testIntegersDontGeneralise self assert: Integer name equals: 1 canonicalArgumentName! Item was changed: + ----- Method: DebuggerExtensionsTest>>testLargeNegativeIntegersGeneralise (in category 'tests - canonical argument names') ----- - ----- Method: DebuggerExtensionsTest>>testLargeNegativeIntegersGeneralise (in category 'testing - canonical argument names') ----- testLargeNegativeIntegersGeneralise self assert: Integer name equals: LargeNegativeInteger initializedInstance canonicalArgumentName! Item was changed: + ----- Method: DebuggerExtensionsTest>>testLargePositiveIntegersGeneralise (in category 'tests - canonical argument names') ----- - ----- Method: DebuggerExtensionsTest>>testLargePositiveIntegersGeneralise (in category 'testing - canonical argument names') ----- testLargePositiveIntegersGeneralise self assert: Integer name equals: LargePositiveInteger initializedInstance canonicalArgumentName! Item was changed: + ----- Method: DebuggerExtensionsTest>>testOtherObjectsDontGeneralise (in category 'tests - canonical argument names') ----- - ----- Method: DebuggerExtensionsTest>>testOtherObjectsDontGeneralise (in category 'testing - canonical argument names') ----- testOtherObjectsDontGeneralise self assert: Behavior name equals: Behavior new canonicalArgumentName. self assert: UndefinedObject name equals: nil canonicalArgumentName! Item was changed: + ----- Method: DebuggerExtensionsTest>>testScaledDecimalsGeneralise (in category 'tests - canonical argument names') ----- - ----- Method: DebuggerExtensionsTest>>testScaledDecimalsGeneralise (in category 'testing - canonical argument names') ----- testScaledDecimalsGeneralise self assert: Number name equals: 2.00s2 canonicalArgumentName! Item was changed: + ----- Method: DebuggerExtensionsTest>>testStringsDontGeneralise (in category 'tests - canonical argument names') ----- - ----- Method: DebuggerExtensionsTest>>testStringsDontGeneralise (in category 'testing - canonical argument names') ----- testStringsDontGeneralise self assert: String name equals: String new canonicalArgumentName! Item was changed: + ----- Method: DebuggerExtensionsTest>>testWideStringsGeneralise (in category 'tests - canonical argument names') ----- - ----- Method: DebuggerExtensionsTest>>testWideStringsGeneralise (in category 'testing - canonical argument names') ----- testWideStringsGeneralise self assert: String name equals: WideString new canonicalArgumentName! Item was changed: + ----- Method: DebuggerUnwindBug>>testUnwindBlock (in category 'tests') ----- - ----- Method: DebuggerUnwindBug>>testUnwindBlock (in category 'testing') ----- testUnwindBlock "test if unwind blocks work properly" | sema process | sema := Semaphore forMutualExclusion. self assert: sema isSignaled. "deadlock on the semaphore" process := [sema critical:[sema wait]] forkAt: Processor userInterruptPriority. self deny: sema isSignaled. "terminate process" process terminate. self assert: sema isSignaled. ! Item was changed: + ----- Method: DebuggerUnwindBug>>testUnwindDebugger (in category 'tests') ----- - ----- Method: DebuggerUnwindBug>>testUnwindDebugger (in category 'testing') ----- testUnwindDebugger "test if unwind blocks work properly when a debugger is closed" | sema process debugger top | sema := Semaphore forMutualExclusion. self assert: sema isSignaled. process := [sema critical:[sema wait]] forkAt: Processor userInterruptPriority. self deny: sema isSignaled. "everything set up here - open a debug notifier" debugger := Debugger openInterrupt: 'test' onProcess: process. "get into the debugger" debugger debug. top := debugger topView. "set top context" debugger toggleContextStackIndex: 1. "close debugger" top delete. "and see if unwind protection worked" self assert: sema isSignaled.! Item was changed: + ----- Method: DependencyBrowserTest>>testBrowse (in category 'tests - buttons') ----- - ----- Method: DependencyBrowserTest>>testBrowse (in category 'testing - buttons') ----- testBrowse | b | browser packageListIndex: (browser packageList indexOf: #Collections). browser packageDepsIndex: (browser packageDeps indexOf: #Compiler). browser classDepsIndex: (browser classDeps indexOf: #Scanner). browser classListIndex: (browser classList indexOf: #Symbol). browser messageListIndex: 1. b := browser browseMethodFull. self assert: b notNil. [self assert: b selectedMessageName = (browser messageList at: browser messageListIndex) ] ensure: [ToolBuilder default close: b topView]! Item was changed: + ----- Method: DependencyBrowserTest>>testClassList (in category 'tests - class list') ----- - ----- Method: DependencyBrowserTest>>testClassList (in category 'testing - class list') ----- testClassList "Warning!! When Collections' dependencies change, this test may start to fail!!" self assert: #() equals: browser classList description: 'classList before package selection'. browser packageListIndex: (browser packageList indexOf: #Collections). self assert: #() equals: browser classList description: 'classList after selecting Collections'. browser packageDepsIndex: (browser packageDeps indexOf: #Compiler). self assert: #() equals: browser classList description: 'classList after selecting Compiler'. browser classDepsIndex: (browser classDeps indexOf: #Scanner). self assert: #(Character String Symbol 'Symbol class') equals: browser classList description: 'classList after selecting Scanner class'. browser classListIndex: (browser classList indexOf: #Symbol). self assert: #(Character String Symbol 'Symbol class') equals: browser classList description: 'classList after selecting Symbol class'.! Item was changed: + ----- Method: DependencyBrowserTest>>testHasPackageSelected (in category 'tests - metaclass') ----- - ----- Method: DependencyBrowserTest>>testHasPackageSelected (in category 'testing - metaclass') ----- testHasPackageSelected self deny: browser hasPackageSelected. browser packageListIndex: 1. self assert: browser hasPackageSelected. browser packageListIndex: 0. self deny: browser hasPackageSelected.! Item was changed: + ----- Method: DependencyBrowserTest>>testSelectedClassOrMetaClass (in category 'tests - metaclass') ----- - ----- Method: DependencyBrowserTest>>testSelectedClassOrMetaClass (in category 'testing - metaclass') ----- testSelectedClassOrMetaClass "Warning!! When Collections' dependencies change, this test may start to fail!!" self assert: browser selectedClassOrMetaClass isNil. browser packageListIndex: (browser packageList indexOf: #Collections). self assert: browser selectedClassOrMetaClass isNil. browser packageDepsIndex: (browser packageDeps indexOf: #Compiler). self assert: browser selectedClassOrMetaClass isNil. browser classDepsIndex: (browser classDeps indexOf: #Scanner). self assert: browser selectedClassOrMetaClass isNil. browser classListIndex: (browser classList indexOf: #Symbol). self deny: browser selectedClassOrMetaClass isNil. self assert: browser selectedClassOrMetaClass == Symbol.! Item was changed: + ----- Method: DependencyBrowserTest>>testSelectedMessageClassSideShowsSource (in category 'tests - message list') ----- - ----- Method: DependencyBrowserTest>>testSelectedMessageClassSideShowsSource (in category 'testing - message list') ----- testSelectedMessageClassSideShowsSource "Warning!! When Collections' dependencies change, this test may start to fail!!" browser packageListIndex: (browser packageList indexOf: #'Chronology-Core'). browser packageDepsIndex: (browser packageDeps indexOf: #Collections). browser classDepsIndex: (browser classDeps indexOf: #'Array'). browser classListIndex: (browser classList indexOf: #'DateAndTime class'). browser messageListIndex: 1. self assert: browser selectedMessageName == #fromSeconds:. self assert: browser contents = (DateAndTime class sourceCodeAt: #fromSeconds:) ! Item was changed: + ----- Method: DependencyBrowserTest>>testSelectedMessageName (in category 'tests - message list') ----- - ----- Method: DependencyBrowserTest>>testSelectedMessageName (in category 'testing - message list') ----- testSelectedMessageName "Warning!! When Collections' dependencies change, this test may start to fail!!" self assert: browser selectedMessageName isNil. browser packageListIndex: (browser packageList indexOf: #Collections). self assert: browser selectedMessageName isNil. browser packageDepsIndex: (browser packageDeps indexOf: #Compiler). self assert: browser selectedMessageName isNil. browser classDepsIndex: (browser classDeps indexOf: #Scanner). self assert: browser selectedMessageName isNil. browser classListIndex: (browser classList indexOf: #Symbol). self assert: browser selectedMessageName isNil. browser messageListIndex: 1. self assert: browser selectedMessageName == #storeOn:. browser messageListIndex: 0. self assert: browser selectedMessageName isNil.! Item was changed: + ----- Method: DependencyBrowserTest>>testSelectedMessageNameClassSide (in category 'tests - message list') ----- - ----- Method: DependencyBrowserTest>>testSelectedMessageNameClassSide (in category 'testing - message list') ----- testSelectedMessageNameClassSide "Warning!! When Collections' dependencies change, this test may start to fail!!" self assert: browser selectedMessageName isNil. browser packageListIndex: (browser packageList indexOf: #'Chronology-Core'). self assert: browser selectedMessageName isNil. browser packageDepsIndex: (browser packageDeps indexOf: #Collections). self assert: browser selectedMessageName isNil. browser classDepsIndex: (browser classDeps indexOf: #Array). self assert: browser selectedMessageName isNil. browser classListIndex: (browser classList indexOf: #'DateAndTime class'). self assert: browser selectedMessageName isNil. browser messageListIndex: 1. self assert: browser selectedMessageName == #fromSeconds:. ! Item was changed: + ----- Method: FileList2ModalDialogsTest>>testModalFileSelector (in category 'tests') ----- - ----- Method: FileList2ModalDialogsTest>>testModalFileSelector (in category 'running') ----- testModalFileSelector | window fileList2 | window := FileList2 morphicViewFileSelector. window openCenteredInWorld. fileList2 := window valueOfProperty: #fileListModel. fileList2 fileListIndex: 1. window delete. self assert: fileList2 getSelectedFile isNil. fileList2 okHit. self deny: fileList2 getSelectedFile isNil ! Item was changed: + ----- Method: FileList2ModalDialogsTest>>testModalFileSelectorForSuffixes (in category 'tests') ----- - ----- Method: FileList2ModalDialogsTest>>testModalFileSelectorForSuffixes (in category 'running') ----- testModalFileSelectorForSuffixes | window fileList2 | window := FileList2 morphicViewFileSelectorForSuffixes: nil. window openCenteredInWorld. fileList2 := window valueOfProperty: #fileListModel. fileList2 fileListIndex: 1. window delete. self assert: fileList2 getSelectedFile isNil. fileList2 okHit. self deny: fileList2 getSelectedFile isNil ! Item was changed: + ----- Method: FileList2ModalDialogsTest>>testModalFolderSelector (in category 'tests') ----- - ----- Method: FileList2ModalDialogsTest>>testModalFolderSelector (in category 'running') ----- testModalFolderSelector | window fileList2 | window := FileList2 morphicViewFolderSelector. fileList2 := window model. window openInWorld: self currentWorld extent: 300@400. fileList2 fileListIndex: 1. window delete. self assert: fileList2 getSelectedDirectory withoutListWrapper isNil. fileList2 okHit. self deny: fileList2 getSelectedDirectory withoutListWrapper isNil ! Item was changed: + ----- Method: FileList2ModalDialogsTest>>testModalFolderSelectorForProjectLoad (in category 'tests') ----- - ----- Method: FileList2ModalDialogsTest>>testModalFolderSelectorForProjectLoad (in category 'running') ----- testModalFolderSelectorForProjectLoad | window fileList2 w | window := FileList2 morphicViewProjectLoader2InWorld: self currentWorld reallyLoad: false. fileList2 := window valueOfProperty: #FileList. w := self currentWorld. window position: w topLeft + (w extent - window extent // 2). window openInWorld: w. window delete. self assert: fileList2 getSelectedDirectory withoutListWrapper isNil. fileList2 okHit. self deny: fileList2 getSelectedDirectory withoutListWrapper isNil ! Item was changed: + ----- Method: FileListTest>>testAllRegisteredServices (in category 'tests') ----- - ----- Method: FileListTest>>testAllRegisteredServices (in category 'test') ----- testAllRegisteredServices "(self selector: #testAllRegisteredServices) debug" "This should not throw an exception." FileList allRegisteredServices.! Item was changed: + ----- Method: FileListTest>>testMenuReturned (in category 'tests') ----- - ----- Method: FileListTest>>testMenuReturned (in category 'test') ----- testMenuReturned "(self selector: #testToolRegistered) debug" self assert: (FileList registeredFileReaderClasses includes: DummyToolWorkingWithFileList)! Item was changed: + ----- Method: FileListTest>>testService (in category 'tests') ----- - ----- Method: FileListTest>>testService (in category 'test') ----- testService "a stupid test to check that the class returns a service" "(self selector: #testService) debug" | service | service := (DummyToolWorkingWithFileList fileReaderServicesForFile: 'abab.kkk' suffix: 'kkk') first. self assert: (self checkIsServiceIsFromDummyTool: service). service := (DummyToolWorkingWithFileList fileReaderServicesForFile: 'zkk.gz' suffix: 'gz'). self assert: service isEmpty! Item was changed: + ----- Method: FileListTest>>testServicesForFileEnding (in category 'tests') ----- - ----- Method: FileListTest>>testServicesForFileEnding (in category 'test') ----- testServicesForFileEnding "(self selector: #testServicesForFileEnding) debug" | items | items := (FileList new directory: FileDirectory default; yourself) itemsForFile: (FileDirectory default fullNameFor: 'aaa.kkk'). self assert: (items anySatisfy: [ :ea | self checkIsServiceIsFromDummyTool: ea ]). ! Item was changed: + ----- Method: FileListTest>>testToolRegistered (in category 'tests') ----- - ----- Method: FileListTest>>testToolRegistered (in category 'test') ----- testToolRegistered "(self selector: #testToolRegistered) debug" self assert: (FileList registeredFileReaderClasses includes: DummyToolWorkingWithFileList)! Item was changed: + ----- Method: FileListTest>>testToolRegisteredUsingInterface (in category 'tests') ----- - ----- Method: FileListTest>>testToolRegisteredUsingInterface (in category 'test') ----- testToolRegisteredUsingInterface "(self selector: #testToolRegisteredUsingInterface) debug" self assert: (FileList isReaderNamedRegistered: #DummyToolWorkingWithFileList)! Item was changed: + ----- Method: HierarchyBrowserTest>>setUp (in category 'running') ----- - ----- Method: HierarchyBrowserTest>>setUp (in category 'as yet unclassified') ----- setUp browser := HierarchyBrowser new.! Item was changed: + ----- Method: HierarchyBrowserTest>>testClassList (in category 'tests') ----- - ----- Method: HierarchyBrowserTest>>testClassList (in category 'as yet unclassified') ----- testClassList | c displayedClasses hierarchy | browser initHierarchyForClass: browser class. c := browser class theNonMetaClass. displayedClasses := browser classList collect: [:each | each withoutLeadingBlanks ]. hierarchy := (c allSuperclasses reversed, {browser class}, c allSubclasses) collect: [ :each | each name ]. self assert: displayedClasses = hierarchy.! Item was changed: + ----- Method: HierarchyBrowserTest>>testClassListIndex (in category 'tests') ----- - ----- Method: HierarchyBrowserTest>>testClassListIndex (in category 'as yet unclassified') ----- testClassListIndex | expectedCat | expectedCat := [:i | (Smalltalk at: (browser classList at: i) withoutLeadingBlanks asSymbol) category ]. browser initHierarchyForClass: browser class. self deny: browser classListIndex = 0. 1 to: 3 do: [:n | browser classListIndex: n. self assert: browser classListIndex = n. self assert: browser selectedSystemCategory = (expectedCat value: n)]! Item was changed: + ----- Method: HierarchyBrowserTest>>testClassListSansWhitespace (in category 'tests') ----- - ----- Method: HierarchyBrowserTest>>testClassListSansWhitespace (in category 'as yet unclassified') ----- testClassListSansWhitespace | c displayedClasses hierarchy | browser initHierarchyForClass: browser class. c := browser class theNonMetaClass. displayedClasses := browser classList collect: [:each | each withoutLeadingBlanks ]. hierarchy := (c allSuperclasses reversed, {browser class}, c allSubclasses) collect: [ :each | each name ]. self assert: displayedClasses = hierarchy.! Item was changed: + ----- Method: HierarchyBrowserTest>>testInitHierarchyForClass (in category 'tests') ----- - ----- Method: HierarchyBrowserTest>>testInitHierarchyForClass (in category 'as yet unclassified') ----- testInitHierarchyForClass | b | b := HierarchyBrowser new initHierarchyForClass: browser class. self assert: b selectedClassName = browser class name.! Item was changed: + ----- Method: HierarchyBrowserTest>>testSelectClass (in category 'tests') ----- - ----- Method: HierarchyBrowserTest>>testSelectClass (in category 'as yet unclassified') ----- testSelectClass browser initHierarchyForClass: browser class. browser selectClass: ProtoObject. self assert: browser selectedClass = ProtoObject. browser selectClass: CodeHolder. self assert: browser selectedClass = CodeHolder.! Item was changed: + ----- Method: HierarchyBrowserTest>>testSelectedClassName (in category 'tests') ----- - ----- Method: HierarchyBrowserTest>>testSelectedClassName (in category 'as yet unclassified') ----- testSelectedClassName browser initHierarchyForClass: browser class. self assert: browser selectedClassName = browser class name. browser classListIndex: 0. self assert: browser selectedClassName isNil.! Item was changed: + ----- Method: MessageNamesTest>>setUp (in category 'running') ----- - ----- Method: MessageNamesTest>>setUp (in category 'as yet unclassified') ----- setUp browser := MessageNames openMessageNames.! Item was changed: + ----- Method: MessageNamesTest>>tearDown (in category 'running') ----- - ----- Method: MessageNamesTest>>tearDown (in category 'as yet unclassified') ----- tearDown browser topView ifNotNil: [:v | ToolBuilder default close: v].! Item was changed: + ----- Method: MessageNamesTest>>testCannotUnselectCategory (in category 'tests') ----- - ----- Method: MessageNamesTest>>testCannotUnselectCategory (in category 'as yet unclassified') ----- testCannotUnselectCategory | selectorList | browser searchString: 'cull'. browser selectorListIndex: 1. selectorList := browser selectorList copy. browser selectorListIndex: 0. self assert: selectorList = browser selectorList.! Item was changed: + ----- Method: MessageNamesTest>>testOpenMessageNames (in category 'tests') ----- - ----- Method: MessageNamesTest>>testOpenMessageNames (in category 'as yet unclassified') ----- testOpenMessageNames | b | b := MessageNames openMessageNames. [self assert: (b isKindOf: MessageNames)] ensure: [ToolBuilder default close: b topView].! Item was changed: + ----- Method: MessageNamesTest>>testSearchString (in category 'tests') ----- - ----- Method: MessageNamesTest>>testSearchString (in category 'as yet unclassified') ----- testSearchString | cCount cullCount cullCullCount | browser searchString: 'c'. cCount := browser selectorList size. browser searchString: 'cull:'. cullCount := browser selectorList size. self assert: cullCount < cCount. browser searchString: 'cull:cull:'. cullCullCount := browser selectorList size. self assert: cullCullCount < cullCount.! Item was changed: + ----- Method: MessageNamesTest>>testSelectedClassOrMetaClass (in category 'tests') ----- - ----- Method: MessageNamesTest>>testSelectedClassOrMetaClass (in category 'as yet unclassified') ----- testSelectedClassOrMetaClass | firstClass | browser searchString: 'cull'. firstClass := browser messageList first actualClass. browser messageListIndex: 1. self assert: browser selectedClassOrMetaClass = firstClass. browser messageListIndex: 0. self assert: browser selectedClassOrMetaClass isNil. "And just to be sure:" browser messageListIndex: 1. self assert: browser selectedClassOrMetaClass = firstClass.! Item was changed: + ----- Method: MessageNamesTest>>testSelectedMessageCategoryName (in category 'tests') ----- - ----- Method: MessageNamesTest>>testSelectedMessageCategoryName (in category 'as yet unclassified') ----- testSelectedMessageCategoryName browser searchString: 'cull'. browser selectorListIndex: 1. browser messageListIndex: 1. self deny: browser selectedMessageCategoryName isNil. browser messageListIndex: 0. self assert: browser selectedMessageCategoryName isNil.! Item was changed: + ----- Method: MessageNamesTest>>testSelection (in category 'tests') ----- - ----- Method: MessageNamesTest>>testSelection (in category 'as yet unclassified') ----- testSelection browser searchString: 'cull'. browser selectorListIndex: 1. browser messageListIndex: 1. self assert: (browser selection isKindOf: MethodReference). browser messageListIndex: 0. self assert: browser selection isNil.! Item was changed: + ----- Method: MessageSetTest>>testAutoSelectString (in category 'tests') ----- - ----- Method: MessageSetTest>>testAutoSelectString (in category 'testing') ----- testAutoSelectString browser autoSelectString: 'browseAllImplementorsOf:'. self assert: browser autoSelectString = 'browseAllImplementorsOf:'. browser messageListIndex: 2. self assert: (updates includes: #autoSelect).! Item was changed: + ----- Method: MessageSetTest>>testContents (in category 'tests') ----- - ----- Method: MessageSetTest>>testContents (in category 'testing') ----- testContents browser messageListIndex: 0. self assert: browser contents = ''. browser messageListIndex: 1. self deny: browser contents = ''. ! Item was changed: + ----- Method: MessageSetTest>>testHasMessageSelected (in category 'tests') ----- - ----- Method: MessageSetTest>>testHasMessageSelected (in category 'testing') ----- testHasMessageSelected browser messageListIndex: 1. self assert: browser hasMessageSelected. browser messageListIndex: 0. self deny: browser hasMessageSelected. "And just to be sure:" browser messageListIndex: 1. self assert: browser hasMessageSelected.! Item was changed: + ----- Method: MessageSetTest>>testRemoveMessageFromBrowser (in category 'tests') ----- - ----- Method: MessageSetTest>>testRemoveMessageFromBrowser (in category 'testing') ----- testRemoveMessageFromBrowser | count sel | browser messageListIndex: 1. sel := browser selection. browser removeMessageFromBrowser. self deny: (browser messageList includes: sel) description: 'Method not removed'. browser messageListIndex: 0. count := browser messageList size. browser removeMessageFromBrowser. self assert: count = browser messageList size description: 'Some method was removed'.! Item was changed: + ----- Method: MessageSetTest>>testSelectedClassOrMetaClass (in category 'tests') ----- - ----- Method: MessageSetTest>>testSelectedClassOrMetaClass (in category 'testing') ----- testSelectedClassOrMetaClass | firstClass | firstClass := browser messageList first actualClass. browser messageListIndex: 1. self assert: browser selectedClassOrMetaClass = firstClass. browser messageListIndex: 0. self assert: browser selectedClassOrMetaClass isNil. "And just to be sure:" browser messageListIndex: 1. self assert: browser selectedClassOrMetaClass = firstClass.! Item was changed: + ----- Method: MessageSetTest>>testSelectedMessageCategoryName (in category 'tests') ----- - ----- Method: MessageSetTest>>testSelectedMessageCategoryName (in category 'testing') ----- testSelectedMessageCategoryName | firstCat methodRef | methodRef := browser messageList first. firstCat := methodRef actualClass organization categoryOfElement: methodRef selector. browser messageListIndex: 1. self assert: browser selectedMessageCategoryName = firstCat. browser messageListIndex: 0. self assert: browser selectedMessageCategoryName isNil. "And just to be sure:" browser messageListIndex: 1. self assert: browser selectedMessageCategoryName = firstCat.! Item was changed: + ----- Method: MessageSetTest>>testSelectedMessageName (in category 'tests') ----- - ----- Method: MessageSetTest>>testSelectedMessageName (in category 'testing') ----- testSelectedMessageName | firstSel | firstSel := browser messageList first selector. browser messageListIndex: 1. self assert: browser selectedMessageName = firstSel. browser messageListIndex: 0. self assert: browser selectedMessageName isNil. "And just to be sure:" browser messageListIndex: 1. self assert: browser selectedMessageName = firstSel.! Item was changed: + ----- Method: MessageSetTest>>testSelection (in category 'tests') ----- - ----- Method: MessageSetTest>>testSelection (in category 'testing') ----- testSelection | firstRef | firstRef := browser messageList first. browser messageListIndex: 1. self assert: browser selection = firstRef. browser messageListIndex: 0. self assert: browser selection isNil. "And just to be sure:" browser messageListIndex: 1. self assert: browser selection = firstRef.! Item was changed: + ----- Method: MessageTraceTest>>setUp (in category 'running') ----- - ----- Method: MessageTraceTest>>setUp (in category 'as yet unclassified') ----- setUp browser := (MessageTrace openMessageList: (SystemNavigation default allImplementorsOf: #browseAllImplementorsOf:) name: 'Test MessageSet' autoSelect: nil) model. browser addDependent: self.! Item was changed: + ----- Method: MessageTraceTest>>testRemoveMessageFromBrowser (in category 'tests') ----- - ----- Method: MessageTraceTest>>testRemoveMessageFromBrowser (in category 'as yet unclassified') ----- testRemoveMessageFromBrowser | count sel | browser messageListIndex: 1. sel := browser selection. browser removeMessageFromBrowser. self deny: (browser messageList includes: sel) description: 'Method not removed'. "In a MessageTrace, having an unselected message and then removing it means 'remove the first message'." browser messageListIndex: 0. count := browser messageList size. browser removeMessageFromBrowser. self assert: count - 1 = browser messageList size description: 'Method not removed'.! Item was changed: + ----- Method: OrderedCollectionInspectorTest>>testUninitialized (in category 'tests') ----- - ----- Method: OrderedCollectionInspectorTest>>testUninitialized (in category 'as yet unclassified') ----- testUninitialized "Single stepping through a debugger can observe the object state after creation but before initiialisation." "Thus 'object size' may throw an axception for trying to do arithmetic on nil." "Modified OrderedCollectionInspector>>fieldList to call 'self objectSize' to handle this exception." "Original error reproduction: [ self halt. OrderedCollectionInspector openOn: (OrderedCollection new: 5) ] " "This should not throw an exception." (OrderedCollectionInspector openOn: OrderedCollection basicNew) delete.! Item was changed: + ----- Method: PackagePaneBrowserTest>>setUp (in category 'running') ----- - ----- Method: PackagePaneBrowserTest>>setUp (in category 'as yet unclassified') ----- setUp browser := PackagePaneBrowser new.! Item was changed: + ----- Method: PackagePaneBrowserTest>>testClassList (in category 'tests') ----- - ----- Method: PackagePaneBrowserTest>>testClassList (in category 'as yet unclassified') ----- testClassList browser selectSystemCategory: browser class category. self assert: browser classList = (SystemOrganization listAtCategoryNamed: browser class category). browser selectSystemCategory: nil. self assert: browser classList isEmpty.! Item was changed: + ----- Method: PackagePaneBrowserTest>>testPackageListIndex (in category 'tests') ----- - ----- Method: PackagePaneBrowserTest>>testPackageListIndex (in category 'as yet unclassified') ----- testPackageListIndex browser packageListIndex: 0. self assert: browser selectedClass isNil. browser selectCategoryForClass: browser class. "Clicking the selected package unselects the selected class." browser packageListIndex: browser packageListIndex. self assert: browser selectedClass isNil.! Item was changed: + ----- Method: PackagePaneBrowserTest>>testSelectCategoryForClass (in category 'tests') ----- - ----- Method: PackagePaneBrowserTest>>testSelectCategoryForClass (in category 'as yet unclassified') ----- testSelectCategoryForClass | pkgName | pkgName := browser class category copyUpTo: $-. browser selectCategoryForClass: browser class. self assert: browser selectedSystemCategory = browser class category. self assert: browser packageListIndex = (browser packageList indexOf: pkgName). browser selectSystemCategory: nil. self assert: browser classList isEmpty.! Item was changed: + ----- Method: WeakSetInspectorTest>>testSymbolTableM6812 (in category 'tests') ----- - ----- Method: WeakSetInspectorTest>>testSymbolTableM6812 (in category 'testing') ----- testSymbolTableM6812 "this test is related to http://bugs.squeak.org/view.php?id=6812" | aWeakSet anInspector fieldSize | aWeakSet := (Symbol classPool at: #SymbolTable). anInspector := aWeakSet inspectorClass inspect: aWeakSet. fieldSize := anInspector fieldList size. Smalltalk garbageCollect. self assert: fieldSize = anInspector fieldList size. !

1 0

The Trunk: ToolsTests-pre.87.mcz
by commits＠source.squeak.org 01 Dec '18

01 Dec '18

Patrick Rein uploaded a new version of ToolsTests to project The Trunk: http://source.squeak.org/trunk/ToolsTests-pre.87.mcz ==================== Summary ==================== Name: ToolsTests-pre.87 Author: pre Time: 1 December 2018, 5:23:30.302597 pm UUID: 6799f95b-3e35-6246-9529-e67e1f2cd433 Ancestors: ToolsTests-pre.86 Refactors the FileContentsBrowserTest to not copy the browser creation and adds a test case for browsing change sets which does not yet show the problematic behavior. =============== Diff against ToolsTests-pre.86 =============== Item was changed: + ----- Method: FileContentsBrowserTest>>expectedFailures (in category 'failures') ----- - ----- Method: FileContentsBrowserTest>>expectedFailures (in category 'as yet unclassified') ----- expectedFailures ^ #(testChangeMessageCategoriesLeavesClassSelected) "See Mantis #7615"! Item was changed: + ----- Method: FileContentsBrowserTest>>setUp (in category 'running') ----- - ----- Method: FileContentsBrowserTest>>setUp (in category 'as yet unclassified') ----- setUp + | fileout testCat | - | fileout testCat package packageDict organizer | testCat := self class category. fileout := WriteStream on: (String new: 10000). SystemOrganization fileOutCategory: testCat on: fileout. + browser := FileContentsBrowser createBrowserForStream: fileout readStream named: testCat.! - - packageDict := Dictionary new. - browser := FileContentsBrowser new. - organizer := SystemOrganizer defaultList: Array new. - package := (FilePackage new fullName: testCat; fileInFrom: fileout readStream). - packageDict - at: package packageName - put: package. - organizer - classifyAll: package classes keys - under: package packageName. - (browser := FileContentsBrowser systemOrganizer: organizer) - packages: packageDict.! Item was added: + ----- Method: FileContentsBrowserTest>>testBrowsingAChangesetShowsMethods (in category 'tests') ----- + testBrowsingAChangesetShowsMethods + + | newChangeSet fileContents internalStream | + newChangeSet := ChangeSet basicNewNamed: 'fooTestSet' , (Random new nextLargeInt: 10000) asString. + self class compileSilently: 'theTestMethod ^ false'. + newChangeSet adoptSelector: #theTestMethod forClass: self class. + + internalStream := WriteStream on: (String new: 10000). + newChangeSet fileOutOn: internalStream. + fileContents := internalStream contents. + self class removeSelector: #theTestMethod. + + browser := FileContentsBrowser createBrowserForStream: (MultiByteBinaryOrTextStream with: fileContents) named: 'testFoo'. + + browser selectSystemCategory: browser systemCategoryList first. + browser selectClassNamed: browser classList first. + + self assert: browser messageList size = 1.! Item was changed: + ----- Method: FileContentsBrowserTest>>testChangeMessageCategoriesLeavesClassSelected (in category 'tests') ----- - ----- Method: FileContentsBrowserTest>>testChangeMessageCategoriesLeavesClassSelected (in category 'as yet unclassified') ----- testChangeMessageCategoriesLeavesClassSelected browser selectSystemCategory: browser systemCategoryList first. browser selectClassNamed: browser classList first. "This is a no-op." browser changeMessageCategories: browser classOrMetaClassOrganizer printString. self assert: browser selectedClassName = browser class name.!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages December 2018