A new version of Monticello was added to project DeltaStreams: http://www.squeaksource.com/DeltaStreams/Monticello-gk.322.mcz
==================== Summary ====================
Name: Monticello-gk.322 Author: gk Time: 4 September 2009, 11:50:07 am UUID: 286d43f9-35d8-4ed5-a897-4392bfd088dd Ancestors: Monticello-ar.321, Monticello-gk.313
Merged our small changes with trunk.
=============== Diff against Monticello-gk.313 ===============
Item was added: + ----- 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>>source (in category 'accessing') ----- - ----- Method: MCScriptDefinition>>source (in category 'as yet unclassified') ----- source ^ script!
Item was changed: ----- Method: MCVersionInspector>>pickRepository (in category 'morphic ui') ----- pickRepository | index | + index := UIManager default chooseFrom: (self repositories collect: [:ea | ea description]) + title: 'Repository:'. - index := (PopUpMenu labelArray: (self repositories collect: [:ea | ea description])) - startUpWithCaption: 'Repository:'. ^ index = 0 ifFalse: [self repositories at: index]!
Item was added: + ----- Method: MCScriptDefinition>>packageName (in category 'accessing') ----- + packageName + ^ packageName!
Item was changed: ----- Method: MCWorkingCopyBrowser>>pickAncestorVersionInfo (in category 'morphic ui') ----- pickAncestorVersionInfo | ancestors index | ancestors := workingCopy ancestry breadthFirstAncestors. + index := UIManager default chooseFrom: (ancestors collect: [:ea | ea name]) + title: 'Ancestor:'. - index := (PopUpMenu labelArray: (ancestors collect: [:ea | ea name])) - startUpWithCaption: 'Ancestor:'. ^ index = 0 ifFalse: [ ancestors at: index]!
Item was added: + ----- Method: MCPoolImportDefinition>>isOrderDependend (in category 'testing') ----- + isOrderDependend + ^false!
Item was changed: + ----- Method: MCScriptDefinition>>initializeWithScript:packageName: (in category 'initializing') ----- - ----- Method: MCScriptDefinition>>initializeWithScript:packageName: (in category 'as yet unclassified') ----- initializeWithScript: aString packageName: packageString script := aString. packageName := packageString!
Item was changed: + ----- Method: MCScriptDefinition>>evaluate (in category 'installing') ----- - ----- Method: MCScriptDefinition>>evaluate (in category 'as yet unclassified') ----- evaluate Compiler evaluate: script!
Item was added: + ----- Method: MCClassVariableDefinition>>isOrderDependend (in category 'as yet unclassified') ----- + isOrderDependend + ^false!
Item was changed: ----- Method: MCHttpRepository>>user (in category 'as yet unclassified') ----- user self userAndPasswordFromSettingsDo: [:usr :pwd | ^usr]. "not in settings" + ^user ifNil: ['']! - ^user!
Item was changed: ----- Method: MCVersionInspector>>pickAncestor (in category 'morphic ui') ----- pickAncestor | index versions | versions := self version info breadthFirstAncestors. + index := UIManager default chooseFrom: (versions collect: [:ea | ea name]) + title: 'Ancestor:'. - index := (PopUpMenu labelArray: (versions collect: [:ea | ea name])) - startUpWithCaption: 'Ancestor:'. ^ index = 0 ifFalse: [versions at: index]!
Item was changed: ----- Method: MCMethodDefinitionTest>>override (in category 'mocks') ----- override ^ 1!
Item was changed: ----- Method: MCClassDefinition>>= (in category 'visiting') ----- = aDefinition ^((super = aDefinition) and: [superclassName = aDefinition superclassName] and: [self traitCompositionString = aDefinition traitCompositionString] and: [self classTraitCompositionString = aDefinition classTraitCompositionString]) and: [category = aDefinition category] and: [type = aDefinition type] + and: [self sortedVariables = aDefinition sortedVariables] - and: [variables = aDefinition variables] and: [comment = aDefinition comment] !
Item was changed: ----- Method: MCWorkingCopyBrowser>>newRepository (in category 'actions') ----- newRepository | types index | types := MCRepository allConcreteSubclasses asArray. + index := UIManager default chooseFrom: (types collect: [:ea | ea description]) + title: 'Repository type:'. - index := (PopUpMenu labelArray: (types collect: [:ea | ea description])) - startUpWithCaption: 'Repository type:'. ^ index = 0 ifFalse: [(types at: index) morphicConfigure]!
Item was changed: ----- Method: MCPatchBrowser>>methodListMenu: (in category 'menus') ----- methodListMenu: aMenu selection ifNotNil: + [aMenu addList:#( + ('install' installSelection) + ('revert' revertSelection) + -)]. - [aMenu addList:#(('install' installSelection) -)]. super methodListMenu: aMenu. ^ aMenu !
Item was changed: + ----- Method: MCScriptDefinition>>accept: (in category 'visiting') ----- - ----- Method: MCScriptDefinition>>accept: (in category 'as yet unclassified') ----- accept: aVisitor + aVisitor visitScriptDefinition: self! - "do nothing for now - this means it won't appear in the .st file"!
Item was added: + ----- Method: MCVariableDefinition>>isOrderDependend (in category 'testing') ----- + isOrderDependend + ^true!
Item was added: + ----- Method: MCPatchBrowser>>revertSelection (in category 'actions') ----- + revertSelection + | loader | + selection ifNotNil: + [loader := MCPackageLoader new. + selection inverse applyTo: loader. + loader loadWithName: self changeSetNameForInstall ]!
Item was changed: ----- Method: MCSnapshotBrowserTest>>testNoSelection (in category 'testing') ----- testNoSelection self assertAListMatches: self allCategories. self denyAListIncludesAnyOf: self definedClasses. self denyAListIncludesAnyOf: self allProtocols. self denyAListIncludesAnyOf: self allMethods. + "and if there I need to see the packages scripts (or none)" + self assertTextIs: '(package defines no scripts)'.! - self assertTextIs: ''.!
Item was changed: + ----- Method: MCClassDefinition>>initializeWithName:superclassName:traitComposition:classTraitComposition:category:instVarNames:classVarNames:poolDictionaryNames:classInstVarNames:type:comment:commentStamp: (in category 'initializing') ----- - ----- Method: MCClassDefinition>>initializeWithName:superclassName:traitComposition:classTraitComposition:category:instVarNames:classVarNames:poolDictionaryNames:classInstVarNames:type:comment:commentStamp: (in category 'visiting') ----- initializeWithName: nameString superclassName: superclassString traitComposition: traitCompositionString classTraitComposition: classTraitCompositionString category: categoryString instVarNames: ivarArray classVarNames: cvarArray poolDictionaryNames: poolArray classInstVarNames: civarArray type: typeSymbol comment: commentString commentStamp: stampStringOrNil name := nameString asSymbol. superclassName := superclassString ifNil: ['nil'] ifNotNil: [superclassString asSymbol]. traitComposition := traitCompositionString. classTraitComposition := classTraitCompositionString. category := categoryString. name = #CompiledMethod ifTrue: [type := #compiledMethod] ifFalse: [type := typeSymbol]. comment := commentString withSqueakLineEndings. commentStamp := stampStringOrNil ifNil: [self defaultCommentStamp]. variables := OrderedCollection new. self addVariables: ivarArray ofType: MCInstanceVariableDefinition. + self addVariables: cvarArray asSortedCollection ofType: MCClassVariableDefinition. + self addVariables: poolArray asSortedCollection ofType: MCPoolImportDefinition. - self addVariables: cvarArray ofType: MCClassVariableDefinition. - self addVariables: poolArray ofType: MCPoolImportDefinition. self addVariables: civarArray ofType: MCClassInstanceVariableDefinition.!
Item was changed: + ----- Method: MCScriptDefinition>>installScript: (in category 'installing') ----- - ----- Method: MCScriptDefinition>>installScript: (in category 'as yet unclassified') ----- installScript: aString | sel pi | sel := (self scriptSelector, ':') asSymbol. pi := self packageInfo. (pi respondsTo: sel) ifTrue: [pi perform: sel with: aString]!
Item was changed: + ----- Method: MCScriptDefinition>>= (in category 'comparing') ----- - ----- Method: MCScriptDefinition>>= (in category 'as yet unclassified') ----- = aDefinition ^ (super = aDefinition) and: [script = aDefinition script]!
Item was changed: + ----- Method: MCScriptDefinition>>sortKey (in category 'accessing') ----- - ----- Method: MCScriptDefinition>>sortKey (in category 'as yet unclassified') ----- sortKey ^ '!!', self scriptSelector "force to the front so it gets loaded first"!
Item was added: + MCDoItParser subclass: #MCScriptParser + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Monticello-Chunk Format'!
Item was added: + ----- Method: MCScriptParser class>>pattern (in category 'as yet unclassified') ----- + pattern + ^'(PackageInfo named: *'!
Item was changed: + ----- Method: MCPatchBrowser>>installSelection (in category 'actions') ----- - ----- Method: MCPatchBrowser>>installSelection (in category 'as yet unclassified') ----- installSelection | loader | selection ifNotNil: [loader := MCPackageLoader new. selection applyTo: loader. loader loadWithName: self changeSetNameForInstall ]!
Item was added: + ----- Method: MCScriptDefinition class>>subclassForScriptSelector: (in category 'as yet unclassified') ----- + subclassForScriptSelector: selectorString + ^self allSubclasses detect: [:ea | ea scriptSelector = selectorString]!
Item was changed: + ----- Method: MCScriptDefinition>>script (in category 'accessing') ----- - ----- Method: MCScriptDefinition>>script (in category 'as yet unclassified') ----- script ^ script!
Item was changed: ----- Method: MCPackageLoader>>basicLoad (in category 'private') ----- basicLoad errorDefinitions := OrderedCollection new. + [[ + + "FIXME. Do a separate pass on loading class definitions as the very first thing. + This is a workaround for a problem with the so-called 'atomic' loading (you wish!!) + which isn't atomic at all but mixes compilation of methods with reshapes of classes. + + Since the method is not installed until later, any class reshape in the middle *will* + affect methods in subclasses that have been compiled before. There is probably + a better way of dealing with this by ensuring that the sort order of the definition lists + superclass definitions before methods for subclasses but I need this NOW, and adding + an extra pass ensures that methods are compiled against their new class definitions." + + additions do: [:ea | self loadClassDefinition: ea] displayingProgress: 'Loading classes...'. + + additions do: [:ea | self tryToLoad: ea] displayingProgress: 'Compiling methods...'. - [[additions do: [:ea | self tryToLoad: ea] displayingProgress: 'Loading...'. removals do: [:ea | ea unload] displayingProgress: 'Cleaning up...'. self shouldWarnAboutErrors ifTrue: [self warnAboutErrors]. errorDefinitions do: [:ea | ea addMethodAdditionTo: methodAdditions] displayingProgress: 'Reloading...'. methodAdditions do: [:each | each installMethod]. methodAdditions do: [:each | each notifyObservers]. additions do: [:ea | ea postloadOver: (self obsoletionFor: ea)] displayingProgress: 'Initializing...'] on: InMidstOfFileinNotification do: [:n | n resume: true]] ensure: [self flushChangesFile]!
Item was changed: + ----- Method: MCClassDefinition>>initializeWithName:superclassName:category:instVarNames:classVarNames:poolDictionaryNames:classInstVarNames:type:comment:commentStamp: (in category 'initializing') ----- - ----- Method: MCClassDefinition>>initializeWithName:superclassName:category:instVarNames:classVarNames:poolDictionaryNames:classInstVarNames:type:comment:commentStamp: (in category 'serializing') ----- initializeWithName: nameString superclassName: superclassString category: categoryString instVarNames: ivarArray classVarNames: cvarArray poolDictionaryNames: poolArray classInstVarNames: civarArray type: typeSymbol comment: commentString commentStamp: stampStringOrNil name := nameString asSymbol. superclassName := superclassString ifNil: ['nil'] ifNotNil: [superclassString asSymbol]. category := categoryString. name = #CompiledMethod ifTrue: [type := #compiledMethod] ifFalse: [type := typeSymbol]. comment := commentString withSqueakLineEndings. commentStamp := stampStringOrNil ifNil: [self defaultCommentStamp]. variables := OrderedCollection new. self addVariables: ivarArray ofType: MCInstanceVariableDefinition. + self addVariables: cvarArray asSortedCollection ofType: MCClassVariableDefinition. + self addVariables: poolArray asSortedCollection ofType: MCPoolImportDefinition. - self addVariables: cvarArray ofType: MCClassVariableDefinition. - self addVariables: poolArray ofType: MCPoolImportDefinition. self addVariables: civarArray ofType: MCClassInstanceVariableDefinition.!
Item was changed: ----- Method: MCPatchBrowser>>widgetSpecs (in category 'morphic ui') ----- widgetSpecs Preferences annotationPanes ifFalse: [ ^#( ((listMorph:selection:menu: list selection methodListMenu:) (0 0 1 0.4) (0 0 0 0)) ((textMorph: text) (0 0.4 1 1)) ) ].
^ { + #((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0)). - #((listMorph:selection:menu: list selection methodListMenu: ) (0 0 1 0.4) (0 0 0 0)). { #(textMorph: annotations). #(0 0.4 1 0.4). { 0. 0. 0. self defaultAnnotationPaneHeight. } }. { #(textMorph: text). #(0 0.4 1 1). { 0. self defaultAnnotationPaneHeight. 0. 0. } }. }!
Item was changed: + ----- Method: MCScriptDefinition>>scriptSelector (in category 'accessing') ----- - ----- Method: MCScriptDefinition>>scriptSelector (in category 'as yet unclassified') ----- scriptSelector ^ self class scriptSelector!
Item was changed: ----- Method: ChangeList class>>recentLogOn:startingFrom: (in category '*monticello') ----- recentLogOn: origChangesFile startingFrom: initialPos "Prompt with a menu of how far back to go when browsing a changes file."
| end banners positions pos chunk i changesFile | changesFile := origChangesFile readOnlyCopy. banners := OrderedCollection new. positions := OrderedCollection new. end := changesFile size. pos := initialPos. [pos = 0 or: [banners size > 20]] whileFalse: [changesFile position: pos. chunk := changesFile nextChunk. i := chunk indexOfSubCollection: 'priorSource: ' startingAt: 1. i > 0 ifTrue: [positions addLast: pos. banners addLast: (chunk copyFrom: 5 to: i - 2). pos := Number readFrom: (chunk copyFrom: i + 13 to: chunk size)] ifFalse: [pos := 0]]. changesFile close. banners size == 0 ifTrue: [^self recent: end on: origChangesFile].
+ pos := UIManager default chooseFrom: banners values: positions + title: 'Browse as far back as...'. - pos := (SelectionMenu labelList: banners selections: positions) - startUpWithCaption: 'Browse as far back as...'. pos == nil ifTrue: [^ self]. ^self recent: end - pos on: origChangesFile!
Item was changed: ----- Method: MCSnapshotBrowser>>text (in category 'text') ----- text self switchIsComment ifTrue: [^ self classCommentString]. methodSelection ifNotNil: [^ methodSelection source]. protocolSelection ifNotNil: [^ '']. classSelection ifNotNil: [^ self classDefinitionString]. + categorySelection ifNil: [^self scriptDefinitionString]. ^ ''!
Item was changed: ----- Method: MCWorkingCopyBrowser>>pickWorkingCopySatisfying: (in category 'morphic ui') ----- pickWorkingCopySatisfying: aBlock | copies index | copies := self workingCopies select: aBlock. copies isEmpty ifTrue: [ ^nil ]. + index := UIManager default chooseFrom: (copies collect: [:ea | ea packageName]) + title: 'Package:'. - index := (PopUpMenu labelArray: (copies collect: [:ea | ea packageName])) - startUpWithCaption: 'Package:'. ^ index = 0 ifFalse: [ copies at: index]!
Item was added: + ----- Method: MCStWriter>>visitScriptDefinition: (in category 'visiting') ----- + visitScriptDefinition: definition + self writeScriptDefinition: definition + !
Item was added: + ----- Method: MCSnapshotBrowser>>scriptDefinitionString (in category 'text') ----- + scriptDefinitionString + | defs | + defs := items select: [:ea | ea isScriptDefinition]. + defs isEmpty ifTrue: [^'(package defines no scripts)']. + + ^ String streamContents: [:stream | + defs asArray sort + do: [:ea | stream nextPutAll: '---------- package '; + nextPutAll: ea scriptSelector; + nextPutAll: ' ----------'; cr; + nextPutAll: ea script; cr] + separatedBy: [stream cr]].!
Item was changed: ----- Method: MCTool>>buildWindow (in category 'morphic ui') ----- buildWindow | window | window := SystemWindow labelled: self label. window model: self. + self widgetSpecs do: [:spec | + | send fractions offsets | + send := spec first. + fractions := spec at: 2 ifAbsent: [#(0 0 1 1)]. + offsets := spec at: 3 ifAbsent: [#(0 0 0 0)]. - self widgetSpecs do: - [:pair | |send fractions offsets| - send := pair first. - fractions := pair at: 2 ifAbsent: [#(0 0 1 1)]. - offsets := pair at: 3 ifAbsent: [#(0 0 0 0)]. window + addMorph: (self perform: send first withArguments: send allButFirst) - addMorph: (self perform: send first withArguments: send allButFirst ) fullFrame: (LayoutFrame fractions: + ((fractions first)@(fractions second) corner: + (fractions third)@(fractions fourth)) - ((fractions first)@(fractions second) corner: - (fractions third)@(fractions fourth)) offsets: ((offsets first)@(offsets second) corner: (offsets third)@(offsets fourth)))]. ^ window!
Item was added: + ----- Method: MCPackageLoader>>loadClassDefinition: (in category 'private') ----- + loadClassDefinition: aDefinition + [aDefinition isClassDefinition ifTrue:[aDefinition load]] on: Error do: [errorDefinitions add: aDefinition].!
Item was changed: + ----- Method: MCScriptDefinition>>installScript (in category 'installing') ----- - ----- Method: MCScriptDefinition>>installScript (in category 'as yet unclassified') ----- installScript self installScript: script!
Item was changed: + ----- Method: MCScriptDefinition>>packageInfo (in category 'accessing') ----- - ----- Method: MCScriptDefinition>>packageInfo (in category 'as yet unclassified') ----- packageInfo ^ PackageInfo named: packageName!
Item was added: + ----- Method: MCDefinition>>isScriptDefinition (in category 'testing') ----- + isScriptDefinition + ^false!
Item was changed: + ----- Method: MCScriptDefinition>>summary (in category 'accessing') ----- - ----- Method: MCScriptDefinition>>summary (in category 'as yet unclassified') ----- summary ^ packageName, ' ', self scriptSelector!
Item was changed: ----- 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 := (PopUpMenu labelArray: names) startUpWithCaption: 'Open version:'. index = 0 ifFalse: [(self versionWithInfo: (infos at: index)) open]!
Item was changed: + ----- Method: MCScriptDefinition>>load (in category 'installing') ----- - ----- Method: MCScriptDefinition>>load (in category 'as yet unclassified') ----- load self installScript!
Item was changed: ----- Method: MCHttpRepository>>password (in category 'as yet unclassified') ----- password self userAndPasswordFromSettingsDo: [:usr :pwd | ^pwd].
+ self user isEmpty ifTrue: [^password ifNil: ['']]. - self user isEmpty ifTrue: [^password].
+ [password isEmptyOrNil] whileTrue: [ - [password isEmpty] whileTrue: [ | answer | "Give the user a chance to change the login" + answer := UIManager default request: 'User name for ', String cr, location - answer := FillInTheBlank request: 'User name for ', String cr, location initialAnswer: self user. answer isEmpty ifTrue: [^password] ifFalse: [self user: answer]. + password := UIManager default requestPassword: 'Password for "', self user, '" at ', String cr, location. - password := FillInTheBlank requestPassword: 'Password for "', self user, '" at ', String cr, location. ].
^ password!
Item was added: + ----- 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 added: + ----- Method: MCStWriter>>writeScriptDefinition: (in category 'writing') ----- + writeScriptDefinition: definition + stream nextChunkPut: ( + '(PackageInfo named: {1}) {2}: {3}' + format: { + "{1}" definition packageName printString. + "{2}" definition scriptSelector. + "{3}" definition script printString + }); cr!
Item was added: + ----- Method: MCClassDefinition>>sortedVariables (in category 'accessing') ----- + sortedVariables + "sort variables for comparison purposes" + + | sorted | + sorted := variables select: [:var | var isOrderDependend]. + sorted addAll: ((variables reject: [:var | var isOrderDependend]) + asSortedCollection: [:a :b | a name <= b name]). + ^sorted!
Item was changed: + ----- Method: MCScriptDefinition>>description (in category 'accessing') ----- - ----- Method: MCScriptDefinition>>description (in category 'as yet unclassified') ----- description ^ Array with: packageName with: self scriptSelector!
Item was added: + ----- Method: MCScriptDefinition>>isScriptDefinition (in category 'testing') ----- + isScriptDefinition + ^true!
Item was changed: + ----- Method: MCScriptDefinition>>unload (in category 'installing') ----- - ----- Method: MCScriptDefinition>>unload (in category 'as yet unclassified') ----- unload self installScript: nil!
Item was removed: - ----- Method: MCPostscriptDefinition>>accept: (in category 'as yet unclassified') ----- - accept: aWriter - "do nothing"!