[Pkg] DeltaStreams: Monticello-gk.322.mcz
squeak-dev-noreply at lists.squeakfoundation.org
squeak-dev-noreply at lists.squeakfoundation.org
Fri Sep 4 09:50:41 UTC 2009
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"!
More information about the Packages
mailing list