[squeak-dev] The Inbox: Monticello-mt.781.mczcommits at source.squeak.org commits at source.squeak.orgThu Jul 14 14:11:34 UTC 2022
A new version of Monticello was added to project The Inbox: http://source.squeak.org/inbox/Monticello-mt.781.mcz ==================== Summary ==================== Name: Monticello-mt.781 Author: mt Time: 2 July 2022, 9:56:11.742503 am UUID: c926f650-7352-6241-927a-0e052dbbd824 Ancestors: Monticello-mt.780 Extend MC repository instantiation interface to allow HTTPS, not only HTTP. =============== Diff against Monticello-mt.780 =============== Item was removed: - SystemOrganization addCategory: #'Monticello-Base'! - SystemOrganization addCategory: #'Monticello-Chunk Format'! - SystemOrganization addCategory: #'Monticello-Environments'! - SystemOrganization addCategory: #'Monticello-Loading'! - SystemOrganization addCategory: #'Monticello-Merging'! - SystemOrganization addCategory: #'Monticello-Modeling'! - SystemOrganization addCategory: #'Monticello-Patching'! - SystemOrganization addCategory: #'Monticello-Repositories'! - SystemOrganization addCategory: #'Monticello-Storing'! - SystemOrganization addCategory: #'Monticello-UI'! - SystemOrganization addCategory: #'Monticello-Versioning'! Item was removed: - ----- Method: ByteString>>asMCVersionName (in category '*monticello') ----- - asMCVersionName - ^ MCVersionName on: self! Item was removed: - ----- Method: ByteSymbol>>asMCVersionName (in category '*monticello') ----- - asMCVersionName - ^ self asString asMCVersionName! Item was removed: - ----- Method: ChangeList class>>recent:on: (in category '*monticello') ----- - recent: charCount on: origChangesFile - "Opens a changeList on the end of the specified changes log file" - | changeList end changesFile | - changesFile := origChangesFile readOnlyCopy. - end := changesFile size. - changeList := Cursor read - showWhile: [self new - scanFile: changesFile - from: (0 max: end - charCount) - to: end]. - changesFile close. - ^changeList! Item was removed: - ----- 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 == nil - ifTrue: [^ self]. - ^self recent: end - pos on: origChangesFile! Item was removed: - ----- Method: ChangeList>>changeTo: (in category '*monticello') ----- - changeTo: changeSubset - | newList newChangeList | - - newChangeList := OrderedCollection new. - newList := OrderedCollection new. - - 1 to: changeList size do: - [:i | (changeSubset includes: (changeList at: i)) ifTrue: - [newChangeList add: (changeList at: i). - newList add: (list at: i)]]. - newChangeList size < changeList size - ifTrue: - [changeList := newChangeList. - list := newList. - listIndex := 0. - listSelections := Array new: list size withAll: false]. - self changed: #list - - ! Item was removed: - ----- Method: ChangeRecord>>asMethodDefinition (in category '*monticello') ----- - asMethodDefinition - ^ MCMethodDefinition - className: class - classIsMeta: meta - selector: self methodSelector - category: category - timeStamp: stamp - source: self string! Item was removed: - ----- Method: ChangeSet>>isForPackageLoad (in category '*Monticello-testing') ----- - isForPackageLoad - | packageName | - ^(name includes: $-) - and: [name last isDigit - and: [packageName := name first: ((name indexOf: $. ifAbsent: [name size]) - min: (name lastIndexOf: $-)) - 1. - MCWorkingCopy allManagers anySatisfy: [:wc| wc packageName = packageName]]]! Item was removed: - ----- Method: ChangeSorter>>deleteMonticelloChangeSets (in category '*Monticello-changeSet menu') ----- - deleteMonticelloChangeSets - "Destroy all change sets from Monticello loads, provided the currently selected change set is not one of those, and the user really wants to do this." - - myChangeSet isForPackageLoad ifTrue: "forms current changes for current project" - [^self inform: 'current change set is a Monticello load change set.\Please select some other change set before deleting Monticello load change sets.' withCRs]. - (self confirm: 'Are you sure you want to delete all change sets due to Monticello package loads?') ifFalse: - [^self]. - - (ChangesOrganizer allChangeSets select: [:cs| cs isForPackageLoad]) do: - [:cs| ChangesOrganizer removeChangeSet: cs]. - - self changed: #changeSetList. - self showChangeSet: ChangeSet current! Item was removed: - ----- Method: ChangeSorter>>monticelloChangeSetMenu: (in category '*Monticello-changeSet menu') ----- - monticelloChangeSetMenu: aMenu - <changeSetMenuShifted: false> - <menuPriority: 600> - aMenu add: 'delete Monticello load change sets' translated action: #deleteMonticelloChangeSets. - ^aMenu! Item was removed: - ----- Method: Class>>asClassDefinition (in category '*monticello') ----- - asClassDefinition - ^ MCClassDefinition - name: self name - superclassName: self superclass name - traitComposition: self traitCompositionString - classTraitComposition: self class traitCompositionString - category: self category - instVarNames: self instVarNames - classVarNames: self classVarNames - poolDictionaryNames: self poolDictionaryNames - classInstVarNames: self class instVarNames - type: self typeOfClass - comment: self organization classComment asString - commentStamp: self organization commentStamp ! Item was removed: - ----- Method: Class>>classDefinitions (in category '*monticello') ----- - classDefinitions - - ^{ self asClassDefinition }! Item was removed: - ----- Method: Class>>mcModel (in category '*monticello') ----- - mcModel - ^ self asClassDefinition mcModel! Item was removed: - ----- Method: Class>>mcPatchOperations (in category '*monticello') ----- - mcPatchOperations - "Answer a collection of MCPatchOperations that can be displayed in a MCPatchBrowser which will reflect the history of this methods definition in relation to each other (not simply compared to the image version)." - ^ (self mcRevisions reversed - inject: OrderedCollection new - into: - [ : coll : each | coll - ifEmpty: - [ coll - add: (MCAddition of: each) ; - yourself ] - ifNotEmpty: - [ coll - add: - (MCModification - of: - (coll last isAddition - ifTrue: [ coll last definition ] - ifFalse: [ coll last modification ]) - to: each) ; - yourself ] ]) reversed! Item was removed: - ----- Method: Class>>mcRevisions (in category '*monticello') ----- - mcRevisions - "Answer a collection of MCClassDefinitions for this Class, which are in the first Magma-backed repository in the list of repositories of my working-copy." - ^ self mcModel ifNotNil: [ : mcmodel | mcmodel revisionsOf: self asClassDefinition ]! Item was removed: - ----- Method: Class>>poolDictionaryNames (in category '*monticello') ----- - poolDictionaryNames - ^ self sharedPools collect: [:ea | self environment keyAtIdentityValue: ea ifAbsent: [ea name]]! Item was removed: - ----- Method: ClassDescription>>packageInfo (in category '*monticello') ----- - packageInfo - ^ (PackageInfo allPackages select: [ : each | each includesClass: self ]) - ifEmpty: [ nil ] - ifNotEmpty: - [ : myPackages | "Select the most-qualified match." - myPackages detectMax: [ : each | each packageName size ] ]! Item was removed: - ----- Method: ClassDescription>>workingCopy (in category '*monticello') ----- - workingCopy - "Answer the MCWorkingCopy in which I am defined." - ^ self packageInfo ifNotNil: [ : pi | pi workingCopy ]! Item was removed: - ----- Method: ClassReference>>mcModel (in category '*monticello') ----- - mcModel - - ^ self actualClass theNonMetaClass mcModel! Item was removed: - ----- Method: ClassReference>>mcPatchOperations (in category '*monticello') ----- - mcPatchOperations - - ^ self actualClass theNonMetaClass mcPatchOperations! Item was removed: - ----- Method: CodeHolder>>classListMenuMonticello: (in category '*monticello-revisions') ----- - classListMenuMonticello: aMenu - <classListMenu> - <menuPriority: 140> - - | selectedClassReference | - selectedClassReference := self selectedClassOrMetaClass - ifNotNil: [:class | ClassReference class: class ]. - selectedClassReference ifNil: [^ aMenu]. - aMenu - add: 'browse revisions' translated - target: MCRepository - selector: #browseClassRevisionsOf: - argument: selectedClassReference. - ^ aMenu! Item was removed: - ----- Method: CodeHolder>>messageListMenuMonticello: (in category '*monticello-revisions') ----- - messageListMenuMonticello: aMenu - <messageListMenu> - <menuPriority: 140> - - | selectedMethodReference | - selectedMethodReference := self selectedClassOrMetaClass - ifNotNil: [:class | self selectedMessageName ifNotNil: [:selector | - MethodReference class: class selector: selector]]. - selectedMethodReference ifNil: [^ aMenu]. - aMenu - add: 'browse revisions' translated - target: MCRepository - selector: #browseMethodRevisionsOf: - argument: selectedMethodReference. - ^ aMenu! Item was removed: - ----- Method: Environment>>provisions (in category '*Monticello-Loading') ----- - provisions - "In contrast to #keys, return also the imported names" - ^ bindings keys! Item was removed: - ----- Method: FilePackage>>classDefinition:with: (in category '*monticello') ----- - classDefinition: string with: chgRec - | tokens theClass | - - tokens := Scanner new scanTokens: string. - - "tokens size = 11 ifFalse:[^doIts add: chgRec]." - - theClass := self getClass: (tokens at: 3). - theClass definition: string. - classOrder add: theClass.! Item was removed: - ----- Method: FilePackage>>doIts (in category '*monticello') ----- - doIts - ^ doIts! Item was removed: - ----- Method: FilePackage>>traitDefinition:with: (in category '*monticello') ----- - traitDefinition: string with: chgRec - | tokens theTrait | - tokens := Scanner new scanTokens: string. - theTrait := self getTrait: (tokens at: 3). - theTrait definition: string. - classOrder add: theTrait.! Item was removed: - MCPatchOperation subclass: #MCAddition - instanceVariableNames: 'definition' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Patching'! Item was removed: - ----- Method: MCAddition class>>of: (in category 'instance creation') ----- - of: aDefinition - ^ self new intializeWithDefinition: aDefinition! Item was removed: - ----- Method: MCAddition>>= (in category 'comparing') ----- - = other - ^other isMCPatchOperation - and: [other isAddition - and: [definition = other definition]]! Item was removed: - ----- Method: MCAddition>>applyTo: (in category 'applying') ----- - applyTo: anObject - anObject addDefinition: definition! Item was removed: - ----- Method: MCAddition>>baseDefinition (in category 'accessing') ----- - baseDefinition - ^ nil! Item was removed: - ----- Method: MCAddition>>definition (in category 'accessing') ----- - definition - ^ definition! Item was removed: - ----- Method: MCAddition>>fromSource (in category 'accessing') ----- - fromSource - ^ ''! Item was removed: - ----- Method: MCAddition>>hash (in category 'comparing') ----- - hash - ^ definition hash! Item was removed: - ----- Method: MCAddition>>intializeWithDefinition: (in category 'initializing') ----- - intializeWithDefinition: aDefinition - definition := aDefinition! Item was removed: - ----- Method: MCAddition>>inverse (in category 'accessing') ----- - inverse - ^ MCRemoval of: definition! Item was removed: - ----- Method: MCAddition>>isAddition (in category 'testing') ----- - isAddition - ^ true! Item was removed: - ----- Method: MCAddition>>isClassPatch (in category 'testing') ----- - isClassPatch - ^definition isClassDefinition! Item was removed: - ----- Method: MCAddition>>sourceString (in category 'accessing') ----- - sourceString - ^(self toSource asText) - addAttribute: TextColor red; - yourself! Item was removed: - ----- Method: MCAddition>>summary (in category 'accessing') ----- - summary - ^ definition summary! Item was removed: - ----- Method: MCAddition>>targetClass (in category 'accessing') ----- - targetClass - ^definition actualClass ! Item was removed: - ----- Method: MCAddition>>targetDefinition (in category 'accessing') ----- - targetDefinition - ^ definition! Item was removed: - ----- Method: MCAddition>>toSource (in category 'accessing') ----- - toSource - ^ definition source! Item was removed: - Object subclass: #MCAncestry - instanceVariableNames: 'ancestors stepChildren' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Versioning'! - - !MCAncestry commentStamp: '<historical>' prior: 0! - Abstract superclass of records of ancestry.! Item was removed: - ----- Method: MCAncestry class>>new (in category 'instance creation') ----- - new - ^ self basicNew initialize! Item was removed: - ----- Method: MCAncestry>>allAncestors (in category 'ancestry') ----- - allAncestors - - | allAncestors | - allAncestors := Set new. - self allAncestorsDo: [ :each | ] visitedAncestors: allAncestors. - ^allAncestors ! Item was removed: - ----- Method: MCAncestry>>allAncestorsDo: (in category 'ancestry') ----- - allAncestorsDo: aBlock - - self allAncestorsDo: aBlock visitedAncestors: Set new! Item was removed: - ----- Method: MCAncestry>>allAncestorsDo:visitedAncestors: (in category 'ancestry') ----- - allAncestorsDo: aBlock visitedAncestors: visitedAncestors - self ancestors do: [ :each | - (visitedAncestors ifAbsentAdd: each) ifTrue: [ - aBlock value: each. - each allAncestorsDo: aBlock visitedAncestors: visitedAncestors ] ]! Item was removed: - ----- Method: MCAncestry>>allAncestorsOnPathTo: (in category 'ancestry') ----- - allAncestorsOnPathTo: aVersionInfo - ^ MCFilteredVersionSorter new - target: aVersionInfo; - addAllVersionInfos: self ancestors; - sortedVersionInfos! Item was removed: - ----- Method: MCAncestry>>ancestorString (in category 'ancestry') ----- - ancestorString - ^ String streamContents: - [:s | self ancestors do: [:ea | s nextPutAll: ea name] separatedBy: [s nextPutAll: ', ']]! Item was removed: - ----- Method: MCAncestry>>ancestorStringWithout: (in category 'ancestry') ----- - ancestorStringWithout: packageName - ^ String streamContents: - [:s | self ancestors do: [:ea | s nextPutAll: (ea nameWithout: packageName)] separatedBy: [s nextPutAll: ', ']]! Item was removed: - ----- Method: MCAncestry>>ancestors (in category 'ancestry') ----- - ancestors - ^ ancestors ifNil: [ Array empty ]! Item was removed: - ----- Method: MCAncestry>>ancestorsDoWhileTrue: (in category 'ancestry') ----- - ancestorsDoWhileTrue: aBlock - self ancestors do: - [:ea | - (aBlock value: ea) ifTrue: - [ea ancestorsDoWhileTrue: aBlock]]! Item was removed: - ----- Method: MCAncestry>>breadthFirstAncestors (in category 'ancestry') ----- - breadthFirstAncestors - ^ Array streamContents: [:s | self breadthFirstAncestorsDo: [:ea | s nextPut: ea]]! Item was removed: - ----- Method: MCAncestry>>breadthFirstAncestorsDo: (in category 'ancestry') ----- - breadthFirstAncestorsDo: aBlock - | seen todo next | - seen := Set with: self. - todo := OrderedCollection with: self. - [todo isEmpty] whileFalse: - [next := todo removeFirst. - next ancestors do: - [:ea | - (seen includes: ea) ifFalse: - [aBlock value: ea. - seen add: ea. - todo add: ea]]]! Item was removed: - ----- Method: MCAncestry>>clearAncestors (in category 'copying') ----- - clearAncestors - ancestors := Array empty! Item was removed: - ----- Method: MCAncestry>>clearStepChildren (in category 'copying') ----- - clearStepChildren - stepChildren := Array empty! Item was removed: - ----- Method: MCAncestry>>commonAncestorWith: (in category 'ancestry') ----- - commonAncestorWith: aNode - | commonAncestors | - commonAncestors := self commonAncestorsWith: aNode. - ^ commonAncestors at: 1 ifAbsent: [nil]! Item was removed: - ----- Method: MCAncestry>>commonAncestorsWith: (in category 'ancestry') ----- - commonAncestorsWith: aVersionInfo - - | sharedAncestors mergedOrder sorter | - sorter := MCVersionSorter new - addVersionInfo: self; - addVersionInfo: aVersionInfo. - mergedOrder := sorter sortedVersionInfos. - sharedAncestors := (sorter allAncestorsOf: self) intersection: (sorter allAncestorsOf: aVersionInfo). - ^ mergedOrder select: [:ea | sharedAncestors includes: ea]! Item was removed: - ----- Method: MCAncestry>>hasAncestor: (in category 'ancestry') ----- - hasAncestor: aVersionInfo - "Answer whether the receiver has ancestor, aVersionInfo." - "Would it be more performant to use a Set for alreadySeen:?" - ^ self - hasAncestor: aVersionInfo - alreadySeen: OrderedCollection new! Item was removed: - ----- Method: MCAncestry>>hasAncestor:alreadySeen: (in category 'ancestry') ----- - hasAncestor: aVersionInfo alreadySeen: aList - (aList includes: self) ifTrue: [^ false]. - aList add: self. - - ^ self = aVersionInfo or: [self ancestors anySatisfy: [:ea | ea hasAncestor: aVersionInfo alreadySeen: aList]] - ! Item was removed: - ----- Method: MCAncestry>>initialize (in category 'initialize-release') ----- - initialize - ancestors := #(). - stepChildren := #()! Item was removed: - ----- Method: MCAncestry>>isMCInfoProxy (in category 'testing') ----- - isMCInfoProxy - ^ false! Item was removed: - ----- Method: MCAncestry>>isRelatedTo: (in category 'ancestry') ----- - isRelatedTo: aVersionInfo - ^ aVersionInfo timeStamp < self timeStamp - ifTrue: [self hasAncestor: aVersionInfo] - ifFalse: [aVersionInfo hasAncestor: self]! Item was removed: - ----- Method: MCAncestry>>isWorkingAncestry (in category 'testing') ----- - isWorkingAncestry - - ^ self name = self nameForWorkingCopy! Item was removed: - ----- Method: MCAncestry>>lastMergeOf:and: (in category 'progeny') ----- - lastMergeOf: aNode and: anotherNode - "Find the last merge of two Nodes starting from myself. - Answer nil if there is none. - Note: there might have been several merges, in which case we take the common merge of merges. - Example: if c is a merge of a and b, d is also a merge of a and b, and e is a merge of c and d, then asnwer e." - - | common | - (self hasAncestor: aNode) ifFalse: [^nil]. - (self hasAncestor: anotherNode) ifFalse: [^nil]. - common := ancestors collect: [:e | e lastMergeOf: aNode and: anotherNode] as: Set. - common remove: nil ifAbsent: []. - common size = 1 ifTrue: [^common anyOne]. - ^self - ! Item was removed: - ----- Method: MCAncestry>>nameForWorkingCopy (in category 'ancestry') ----- - nameForWorkingCopy - - ^ '<working copy>'! Item was removed: - ----- Method: MCAncestry>>names (in category 'ancestry') ----- - names - "The names of the ancestors." - ^ self ancestors collect: [ : each | each name asMCVersionName ]! Item was removed: - ----- Method: MCAncestry>>postCopyWithTrimmedAncestry (in category 'copying') ----- - postCopyWithTrimmedAncestry - ancestors ifNotNil: - [ ancestors := ancestors collect: - [ : each | each copy - clearAncestors ; - clearStepChildren ; - yourself ] ]. - stepChildren ifNotNil: - [ stepChildren := stepChildren collect: - [ : each | each copy - clearAncestors ; - clearStepChildren ; - yourself ] ]! Item was removed: - ----- Method: MCAncestry>>stepChildren (in category 'ancestry') ----- - stepChildren - ^ stepChildren ifNil: [#()]! Item was removed: - ----- Method: MCAncestry>>stepChildrenString (in category 'ancestry') ----- - stepChildrenString - ^ String streamContents: - [:s | self stepChildren do: [:ea | s nextPutAll: ea name] separatedBy: [s nextPutAll: ', ']]! Item was removed: - ----- Method: MCAncestry>>stubAncestryFor:using: (in category 'initialize-release') ----- - stubAncestryFor: aMCWorkingCopy using: aMCRepository - "childInfo was retrieved from aMCRepository. Replace my ancestry with a Proxy that can retrieve the full tree from these two elements." - ancestors := ancestors collect: - [ : each | each isMCInfoProxy - ifTrue: [ each ] - ifFalse: - [ MCInfoProxy - info: each copyWithTrimmedAncestry - workingCopy: aMCWorkingCopy - repository: aMCRepository ] ]. - stepChildren ifNotNil: - [ stepChildren := stepChildren collect: - [ : each | each isMCInfoProxy - ifTrue: [ each ] - ifFalse: - [ MCInfoProxy - info: each copyWithTrimmedAncestry - workingCopy: aMCWorkingCopy - repository: aMCRepository ] ] ]! Item was removed: - ----- Method: MCAncestry>>topologicalAncestors (in category 'ancestry') ----- - topologicalAncestors - "Answer all ancestors in topological order (that is, children always come before all their ancestors). If multiple such orderings are possible, arbitrate by time stamp." - ^ Array streamContents: - [:s | | frontier next | - frontier := MCFrontier frontierOn: self. - next := self. - [ frontier remove: next. - s nextPut: next. - next := frontier frontier detectMax: [:v | v timeStamp]. - next isNil] whileFalse]! Item was removed: - ----- Method: MCAncestry>>withBreadthFirstAncestors (in category 'ancestry') ----- - withBreadthFirstAncestors - ^ { self }, self breadthFirstAncestors! Item was removed: - MCDirectoryRepository subclass: #MCCacheRepository - instanceVariableNames: 'packageCaches seenFiles' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Repositories'! - MCCacheRepository class - instanceVariableNames: 'default'! - MCCacheRepository class - instanceVariableNames: 'default'! Item was removed: - ----- Method: MCCacheRepository class>>cacheDirectory (in category 'accessing') ----- - cacheDirectory - ^ (FileDirectory default directoryNamed: 'package-cache') - assureExistence; - yourself! Item was removed: - ----- Method: MCCacheRepository class>>cleanUp: (in category 'initialize-release') ----- - cleanUp: aggressive - self reset! Item was removed: - ----- Method: MCCacheRepository class>>default (in category 'accessing') ----- - default - (default isNil or: [ default directory exists not ]) ifTrue: [ default := self new directory: self cacheDirectory ]. - ^ default! Item was removed: - ----- Method: MCCacheRepository class>>description (in category 'accessing') ----- - description - ^ nil! Item was removed: - ----- Method: MCCacheRepository class>>reset (in category 'initialize-release') ----- - reset - default := nil! Item was removed: - ----- Method: MCCacheRepository>>basicStoreVersion: (in category 'private') ----- - basicStoreVersion: aVersion - (aVersion isCacheable not or: [self allFileNames includes: aVersion fileName]) - ifFalse: [super basicStoreVersion: aVersion] - ! Item was removed: - ----- Method: MCCacheRepository>>cacheForPackage: (in category 'caching') ----- - cacheForPackage: aPackage - packageCaches ifNil: [packageCaches := Dictionary new]. - ^ packageCaches at: aPackage ifAbsentPut: [MCPackageCache new]! Item was removed: - ----- Method: MCCacheRepository>>newFileNames (in category 'accessing') ----- - newFileNames - ^ self allFileNames difference: self seenFileNames! Item was removed: - ----- Method: MCCacheRepository>>postCopy (in category 'copying') ----- - postCopy - super postCopy. - packageCaches := packageCaches copy. - seenFiles := seenFiles copy! Item was removed: - ----- Method: MCCacheRepository>>rescan (in category 'private') ----- - 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 removed: - ----- Method: MCCacheRepository>>seenFileNames (in category 'accessing') ----- - seenFileNames - ^ seenFiles ifNil: [seenFiles := OrderedCollection new]! Item was removed: - ----- Method: MCCacheRepository>>versionInfoForFileNamed: (in category 'caching') ----- - versionInfoForFileNamed: aString - ^ cache at: aString ifAbsentPut: [self versionReaderForFileNamed: aString do: [:r | r info]]! Item was removed: - Notification subclass: #MCChangeSelectionRequest - instanceVariableNames: 'patch label' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Versioning'! Item was removed: - ----- Method: MCChangeSelectionRequest>>defaultAction (in category 'handling') ----- - defaultAction - ^ (MCChangeSelector forPatch: patch) - label: label ; - showModally! Item was removed: - ----- Method: MCChangeSelectionRequest>>label (in category 'accessing') ----- - label - ^ label! Item was removed: - ----- Method: MCChangeSelectionRequest>>label: (in category 'accessing') ----- - label: aString - label := aString! Item was removed: - ----- Method: MCChangeSelectionRequest>>patch (in category 'accessing') ----- - patch - ^ patch! Item was removed: - ----- Method: MCChangeSelectionRequest>>patch: (in category 'accessing') ----- - patch: aPatch - patch := aPatch! Item was removed: - MCPatchBrowser subclass: #MCChangeSelector - instanceVariableNames: 'kept' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-UI'! Item was removed: - ----- Method: MCChangeSelector>>accept (in category 'actions') ----- - accept - self answer: (MCPatch operations: kept)! Item was removed: - ----- Method: MCChangeSelector>>balloonTextForAcceptButton (in category 'ui') ----- - balloonTextForAcceptButton - - ^ 'Accept the selected ', self windowTitle! Item was removed: - ----- Method: MCChangeSelector>>buttonSpecs (in category 'ui') ----- - buttonSpecs - ^ #( - ((button: (Accept accept balloonTextForAcceptButton))) - ((button: (Cancel cancel 'Cancel the operation'))) - )! Item was removed: - ----- Method: MCChangeSelector>>cancel (in category 'actions') ----- - cancel - - self wasInterrupted - ifTrue: [self close] - ifFalse: [self answer: nil].! Item was removed: - ----- Method: MCChangeSelector>>defaultLabel (in category 'ui') ----- - defaultLabel - ^ 'Change Selector'! Item was removed: - ----- Method: MCChangeSelector>>innerButtonSpecs (in category 'ui') ----- - innerButtonSpecs - - ^ #( - ((button: ('Select All' selectAll 'select all changes'))) - ((button: ('Select None' selectNone 'select no changes'))) - )! Item was removed: - ----- Method: MCChangeSelector>>kept (in category 'accessing') ----- - kept - ^ kept ifNil: [kept := Set new]! Item was removed: - ----- Method: MCChangeSelector>>listSelectionAt: (in category 'actions') ----- - listSelectionAt: aNumber - ^ self kept includes: (self items at: aNumber)! Item was removed: - ----- Method: MCChangeSelector>>listSelectionAt:put: (in category 'actions') ----- - listSelectionAt: aNumber put: aBoolean - | item | - item := self items at: aNumber. - aBoolean - ifTrue: [self kept add: item ] - ifFalse: [self kept remove: item ifAbsent: []]! Item was removed: - ----- Method: MCChangeSelector>>panelSpecs (in category 'ui') ----- - panelSpecs - ^ #( - ((textMorph: annotations) (0 0 1 0) ( 0 0 0 defaultAnnotationPaneHeight )) - ((textMorph: text) (0 0 1 1) ( 0 defaultAnnotationPaneHeight 0 0 )) - )! Item was removed: - ----- Method: MCChangeSelector>>selectAll (in category 'actions') ----- - selectAll - kept addAll: self items. - self changed: #list! Item was removed: - ----- Method: MCChangeSelector>>selectNone (in category 'actions') ----- - selectNone - kept := Set new. - self changed: #list! Item was removed: - ----- Method: MCChangeSelector>>widgetSpecs (in category 'ui') ----- - 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 defaultButtonPaneHeightNegated)) - ((buttonRowFor: innerButtonSpecs) (0 0.4 1 0.4) (0 defaultButtonPaneHeightNegated 0 0)) - ((textMorph: text) (0 0.4 1 1) (0 0 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 defaultButtonPaneHeightNegated)) - ((buttonRowFor: innerButtonSpecs) - (0 0.4 1 0.4) (0 defaultButtonPaneHeightNegated 0 0)) - ((panel) - (0 0.4 1 1) (0 0 0 0)) - )! Item was removed: - MCDefinition subclass: #MCClassDefinition - instanceVariableNames: 'name superclassName variables category type comment commentStamp traitComposition classTraitComposition' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Modeling'! Item was removed: - ----- Method: MCClassDefinition class>>name:superclassName:category:instVarNames:classVarNames:poolDictionaryNames:classInstVarNames:comment: (in category 'obsolete') ----- - name: nameString - superclassName: superclassString - category: categoryString - instVarNames: ivarArray - classVarNames: cvarArray - poolDictionaryNames: poolArray - classInstVarNames: civarArray - comment: commentString - ^ self name: nameString - superclassName: superclassString - category: categoryString - instVarNames: ivarArray - classVarNames: cvarArray - poolDictionaryNames: poolArray - classInstVarNames: civarArray - type: #normal - comment: commentString - ! Item was removed: - ----- Method: MCClassDefinition class>>name:superclassName:category:instVarNames:classVarNames:poolDictionaryNames:classInstVarNames:type:comment: (in category 'obsolete') ----- - name: nameString - superclassName: superclassString - category: categoryString - instVarNames: ivarArray - classVarNames: cvarArray - poolDictionaryNames: poolArray - classInstVarNames: civarArray - type: typeSymbol - comment: commentString - ^ self - name: nameString - superclassName: superclassString - category: categoryString - instVarNames: ivarArray - classVarNames: cvarArray - poolDictionaryNames: poolArray - classInstVarNames: civarArray - type: typeSymbol - comment: commentString - commentStamp: nil! Item was removed: - ----- Method: MCClassDefinition class>>name:superclassName:category:instVarNames:classVarNames:poolDictionaryNames:classInstVarNames:type:comment:commentStamp: (in category 'instance creation') ----- - name: nameString - superclassName: superclassString - category: categoryString - instVarNames: ivarArray - classVarNames: cvarArray - poolDictionaryNames: poolArray - classInstVarNames: civarArray - type: typeSymbol - comment: commentString - commentStamp: stampString - ^ self instanceLike: - (self new initializeWithName: nameString - superclassName: superclassString - traitComposition: '{}' - classTraitComposition: '{}' - category: categoryString - instVarNames: ivarArray - classVarNames: cvarArray - poolDictionaryNames: poolArray - classInstVarNames: civarArray - type: typeSymbol - comment: commentString - commentStamp: stampString)! Item was removed: - ----- Method: MCClassDefinition class>>name:superclassName:category:instVarNames:comment: (in category 'obsolete') ----- - name: nameString - superclassName: superclassString - category: categoryString - instVarNames: ivarArray - comment: commentString - ^ self name: nameString - superclassName: superclassString - category: categoryString - instVarNames: ivarArray - classVarNames: #() - poolDictionaryNames: #() - classInstVarNames: #() - comment: commentString - ! Item was removed: - ----- Method: MCClassDefinition class>>name:superclassName:traitComposition:classTraitComposition:category:instVarNames:classVarNames:poolDictionaryNames:classInstVarNames:type:comment:commentStamp: (in category 'instance creation') ----- - name: nameString - superclassName: superclassString - traitComposition: traitCompositionString - classTraitComposition: classTraitCompositionString - category: categoryString - instVarNames: ivarArray - classVarNames: cvarArray - poolDictionaryNames: poolArray - classInstVarNames: civarArray - type: typeSymbol - comment: commentString - commentStamp: stampString - - ^ self instanceLike: - (self new initializeWithName: nameString - superclassName: superclassString - traitComposition: traitCompositionString - classTraitComposition: classTraitCompositionString - category: categoryString - instVarNames: ivarArray - classVarNames: cvarArray - poolDictionaryNames: poolArray - classInstVarNames: civarArray - type: typeSymbol - comment: commentString - commentStamp: stampString)! Item was removed: - ----- 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: [comment = aDefinition comment]]]]]]]! Item was removed: - ----- Method: MCClassDefinition>>accept: (in category 'visiting') ----- - accept: aVisitor - aVisitor visitClassDefinition: self. - (self hasClassInstanceVariables or: [self hasClassTraitComposition]) - ifTrue: [aVisitor visitMetaclassDefinition: self]. - ! Item was removed: - ----- Method: MCClassDefinition>>actualClass (in category 'accessing') ----- - actualClass - ^ self actualClassIn: Environment current! Item was removed: - ----- Method: MCClassDefinition>>actualClassIn: (in category 'accessing') ----- - actualClassIn: anEnvironment - ^anEnvironment classNamed: self className! Item was removed: - ----- Method: MCClassDefinition>>addVariables:ofType: (in category 'initializing') ----- - addVariables: aCollection ofType: aClass - - aCollection do: [ :variable | - variables add: (aClass name: variable asString ) ]! Item was removed: - ----- Method: MCClassDefinition>>category (in category 'accessing') ----- - category - ^ category! Item was removed: - ----- Method: MCClassDefinition>>classInstVarNames (in category 'accessing') ----- - classInstVarNames - ^ self selectVariables: #isClassInstanceVariable! Item was removed: - ----- Method: MCClassDefinition>>classInstanceVariablesString (in category 'printing') ----- - classInstanceVariablesString - ^ self stringForVariablesOfType: #isClassInstanceVariable! Item was removed: - ----- Method: MCClassDefinition>>className (in category 'accessing') ----- - className - ^ name! Item was removed: - ----- Method: MCClassDefinition>>classTraitComposition (in category 'accessing') ----- - classTraitComposition - ^classTraitComposition! Item was removed: - ----- Method: MCClassDefinition>>classTraitCompositionString (in category 'accessing') ----- - classTraitCompositionString - ^self classTraitComposition ifNil: ['{}'].! Item was removed: - ----- Method: MCClassDefinition>>classVarNames (in category 'accessing') ----- - classVarNames - ^(self selectVariables: #isClassVariable) asArray sort! Item was removed: - ----- Method: MCClassDefinition>>classVariablesString (in category 'printing') ----- - classVariablesString - ^ self stringForVariablesOfType: #isClassVariable! Item was removed: - ----- Method: MCClassDefinition>>comment (in category 'accessing') ----- - comment - ^ comment! Item was removed: - ----- Method: MCClassDefinition>>commentStamp (in category 'accessing') ----- - commentStamp - ^ commentStamp! Item was removed: - ----- Method: MCClassDefinition>>createClass (in category 'installing') ----- - createClass - | environment superClass class composition | - environment := Environment current. - superClass := superclassName == #nil ifFalse: - [environment valueOf: superclassName - ifAbsent: [(KeyNotFound key: superclassName) signal]]. - [class := (ClassBuilder new) - name: name - inEnvironment: environment - subclassOf: superClass - type: type - instanceVariableNames: self instanceVariablesString - classVariableNames: self classVariablesString - poolDictionaries: self sharedPoolsString - category: category. - ] on: Warning, DuplicateVariableError do:[:ex| ex resume]. - - "The following is written to support traits unloading" - composition := self traitComposition ifNil: [Array empty] ifNotNil: [:traitComposition | Compiler evaluate: traitComposition]. - (composition isCollection and:[composition isEmpty and:[class traitComposition isEmpty]]) ifFalse:[ - class setTraitComposition: composition asTraitComposition. - ]. - - composition := self classTraitComposition ifNil: [Array new] ifNotNil: [:traitComposition | Compiler evaluate: traitComposition]. - (composition isCollection and:[composition isEmpty and:[class class traitComposition isEmpty]]) ifFalse:[ - class class setTraitComposition: composition asTraitComposition. - ]. - - ^class! Item was removed: - ----- Method: MCClassDefinition>>defaultCommentStamp (in category 'initializing') ----- - defaultCommentStamp - ^ String new - - "The version below avoids stomping on stamps already in the image - - ^ (Smalltalk at: name ifPresent: [:c | c organization commentStamp]) - ifNil: [''] - " - ! Item was removed: - ----- Method: MCClassDefinition>>definitionAndCommentString (in category 'printing') ----- - definitionAndCommentString - ^ String streamContents: [:stream | - self printDefinitionOn: stream. - stream cr; cr. - self printClassSideDefinitionOn: stream. - stream cr; cr. - self printCommentOn: stream]! Item was removed: - ----- Method: MCClassDefinition>>definitionString (in category 'printing') ----- - definitionString - ^ String streamContents: [:stream | self printDefinitionOn: stream]! Item was removed: - ----- Method: MCClassDefinition>>description (in category 'accessing') ----- - description - ^{ name } - ! Item was removed: - ----- Method: MCClassDefinition>>handlePackageRename:to: (in category 'renaming') ----- - handlePackageRename: oldPackageName to: newPackageName - (self actualClass category beginsWith: newPackageName) ifFalse: - [ self actualClass category: - (self - newCategoryNameFor: self actualClass category - givenRenameFrom: oldPackageName - to: newPackageName) ]! Item was removed: - ----- Method: MCClassDefinition>>hasClassInstanceVariables (in category 'testing') ----- - hasClassInstanceVariables - ^ (self selectVariables: #isClassInstanceVariable) isEmpty not! Item was removed: - ----- Method: MCClassDefinition>>hasClassTraitComposition (in category 'testing') ----- - hasClassTraitComposition - ^self classTraitCompositionString ~= '{}'! Item was removed: - ----- Method: MCClassDefinition>>hasComment (in category 'testing') ----- - hasComment - ^ comment isEmptyOrNil not! Item was removed: - ----- Method: MCClassDefinition>>hasTraitComposition (in category 'testing') ----- - hasTraitComposition - ^self traitCompositionString ~= '{}'! Item was removed: - ----- Method: MCClassDefinition>>hash (in category 'comparing') ----- - hash - - | hash | - hash := name hashWithInitialHash: 0. - hash := superclassName hashWithInitialHash: hash. - hash := self traitCompositionString hashWithInitialHash: hash. - hash := self classTraitComposition asString hashWithInitialHash: hash. - hash := (category ifNil: ['']) hashWithInitialHash: hash. - hash := type hashWithInitialHash: hash. - variables do: [ :v | - hash := v name hashWithInitialHash: hash ]. - ^hash! Item was removed: - ----- Method: MCClassDefinition>>initializeWithName:superclassName:category:instVarNames:classVarNames:poolDictionaryNames:classInstVarNames:type:comment:commentStamp: (in category 'initializing') ----- - 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. - type := typeSymbol. - comment := commentString withSqueakLineEndings. - commentStamp := stampStringOrNil ifNil: [self defaultCommentStamp]. - variables := OrderedCollection new. - self addVariables: ivarArray ofType: MCInstanceVariableDefinition. - self addVariables: cvarArray sorted ofType: MCClassVariableDefinition. - self addVariables: poolArray sorted ofType: MCPoolImportDefinition. - self addVariables: civarArray ofType: MCClassInstanceVariableDefinition! Item was removed: - ----- Method: MCClassDefinition>>initializeWithName:superclassName:traitComposition:classTraitComposition:category:instVarNames:classVarNames:poolDictionaryNames:classInstVarNames:type:comment:commentStamp: (in category 'initializing') ----- - 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. - type := typeSymbol. - comment := commentString withSqueakLineEndings. - commentStamp := stampStringOrNil ifNil: [self defaultCommentStamp]. - variables := OrderedCollection new. - self addVariables: ivarArray ofType: MCInstanceVariableDefinition. - self addVariables: cvarArray sorted ofType: MCClassVariableDefinition. - self addVariables: poolArray sorted ofType: MCPoolImportDefinition. - self addVariables: civarArray ofType: MCClassInstanceVariableDefinition! Item was removed: - ----- Method: MCClassDefinition>>instVarNames (in category 'accessing') ----- - instVarNames - ^ self selectVariables: #isInstanceVariable! Item was removed: - ----- Method: MCClassDefinition>>instanceVariablesString (in category 'printing') ----- - instanceVariablesString - ^ self stringForVariablesOfType: #isInstanceVariable! Item was removed: - ----- Method: MCClassDefinition>>isClassDefinition (in category 'testing') ----- - isClassDefinition - ^ true! Item was removed: - ----- Method: MCClassDefinition>>isCodeDefinition (in category 'testing') ----- - isCodeDefinition - ^ true! Item was removed: - ----- Method: MCClassDefinition>>kindOfSubclass (in category 'printing') ----- - kindOfSubclass - type = #normal ifTrue: [^' subclass: ']. - type = #variable ifTrue: [^' variableSubclass: ']. - type = #bytes ifTrue: [^' variableByteSubclass: ']. - type = #compiledMethod ifTrue: [^' variableByteSubclass: ' ]. - type = #shorts ifTrue: [^' variableDoubleByteSubclass: ']. - type = #words ifTrue: [^' variableWordSubclass: ']. - type = #longs ifTrue: [^' variableDoubleWordSubclass: ']. - type = #weak ifTrue: [^' weakSubclass: ' ]. - type = #ephemeron ifTrue: [^' ephemeronSubclass: ' ]. - type = #immediate ifTrue: [^' immediateSubclass: ' ]. - self error: 'Unrecognized class type' - ! Item was removed: - ----- Method: MCClassDefinition>>load (in category 'installing') ----- - load - self createClass ifNotNil: - [:class | - class class instanceVariableNames: self classInstanceVariablesString. - self hasComment ifTrue: [class classComment: comment stamp: commentStamp]]! Item was removed: - ----- Method: MCClassDefinition>>poolDictionaries (in category 'accessing') ----- - poolDictionaries - ^ self selectVariables: #isPoolImport! Item was removed: - ----- Method: MCClassDefinition>>printAnnotations:on: (in category 'annotations') ----- - printAnnotations: requests on: aStream - "Add a string for an annotation pane, trying to fulfill the annotation requests. - These might include anything that - Preferences defaultAnnotationRequests - might return. Which includes anything in - Preferences annotationInfo - To edit these, use:" - "Preferences editAnnotations" - - requests do: [ :aRequest | - aRequest == #requirements ifTrue: [ - self requirements do: [ :req | aStream nextPutAll: req ] separatedBy: [ aStream space ]] - ] separatedBy: [ aStream space ].! Item was removed: - ----- Method: MCClassDefinition>>printClassSideDefinitionOn: (in category 'printing') ----- - printClassSideDefinitionOn: stream - - stream - nextPutAll: self className; - nextPutAll: ' class '; - cr; tab. - self hasClassTraitComposition ifTrue: [ - stream - nextPutAll: 'uses: '; - nextPutAll: self classTraitCompositionString; - cr; tab ]. - stream - nextPutAll: 'instanceVariableNames: '; - store: self classInstanceVariablesString! Item was removed: - ----- Method: MCClassDefinition>>printCommentOn: (in category 'printing') ----- - printCommentOn: stream - stream - nextPut: $"; - nextPutAll: self comment asString; - nextPut: $" - ! Item was removed: - ----- Method: MCClassDefinition>>printDefinitionOn: (in category 'printing') ----- - printDefinitionOn: stream - stream - nextPutAll: self superclassName; - nextPutAll: self kindOfSubclass; - nextPut: $# ; - nextPutAll: self className; - cr; tab. - self hasTraitComposition ifTrue: [ - stream - nextPutAll: 'uses: '; - nextPutAll: self traitCompositionString; - cr; tab ]. - stream - nextPutAll: 'instanceVariableNames: '; - store: self instanceVariablesString; - cr; tab; - nextPutAll: 'classVariableNames: '; - store: self classVariablesString; - cr; tab; - nextPutAll: 'poolDictionaries: '; - store: self sharedPoolsString; - cr; tab; - nextPutAll: 'category: '; - store: self category asString! Item was removed: - ----- Method: MCClassDefinition>>provisions (in category 'comparing') ----- - provisions - ^{ name }! Item was removed: - ----- Method: MCClassDefinition>>requirements (in category 'comparing') ----- - requirements - ^superclassName == #nil - ifTrue: [self poolDictionaries] - ifFalse: [{ superclassName }, self poolDictionaries, - (self hasTraitComposition - ifTrue: [(Scanner new scanTokens: self traitComposition) flattened select: [:each | each first isUppercase]] - ifFalse: [#()])].! Item was removed: - ----- Method: MCClassDefinition>>selectVariables: (in category 'accessing') ----- - selectVariables: aSelector - ^ variables select: [:v | v perform: aSelector] thenCollect: [:v | v name]! Item was removed: - ----- Method: MCClassDefinition>>sharedPoolsString (in category 'printing') ----- - sharedPoolsString - ^ self stringForVariablesOfType: #isPoolImport! Item was removed: - ----- Method: MCClassDefinition>>sortKey (in category 'accessing') ----- - sortKey - ^ self className! Item was removed: - ----- Method: MCClassDefinition>>sortedVariables (in category 'accessing') ----- - sortedVariables - "sort variables for comparison purposes" - - | orderDependents toSort | - orderDependents := OrderedCollection new: variables size. - toSort := OrderedCollection new. - variables do: [ :variable | - variable isOrderDependend - ifTrue: [ orderDependents addLast: variable ] - ifFalse: [ toSort addLast: variable ] ]. - toSort sort: [ :a :b | a name <= b name ]. - ^orderDependents - addAllLast: toSort; - yourself! Item was removed: - ----- Method: MCClassDefinition>>source (in category 'printing') ----- - source - ^ self definitionAndCommentString! Item was removed: - ----- Method: MCClassDefinition>>storeDataOn: (in category 'serializing') ----- - storeDataOn: aDataStream - | instVarSize | - instVarSize := (self hasTraitComposition or: [ self hasClassTraitComposition ]) - ifTrue: [ self class instSize ] - ifFalse: [ self class instSize - 2 ]. - aDataStream - beginInstance: self class - size: instVarSize. - 1 to: instVarSize do: [ :index | - aDataStream nextPut: (self instVarAt: index) ].! Item was removed: - ----- Method: MCClassDefinition>>stringForVariablesOfType: (in category 'installing') ----- - stringForVariablesOfType: aSymbol - ^ String streamContents: - [:stream | - (self selectVariables: aSymbol) - do: [:ea | stream nextPutAll: ea] - separatedBy: [stream space]]! Item was removed: - ----- Method: MCClassDefinition>>summary (in category 'printing') ----- - summary - ^ name! Item was removed: - ----- Method: MCClassDefinition>>superclassName (in category 'accessing') ----- - superclassName - ^ superclassName! Item was removed: - ----- Method: MCClassDefinition>>traitComposition (in category 'accessing') ----- - traitComposition - ^traitComposition! Item was removed: - ----- Method: MCClassDefinition>>traitCompositionString (in category 'accessing') ----- - traitCompositionString - ^self traitComposition ifNil: ['{}'].! Item was removed: - ----- Method: MCClassDefinition>>type (in category 'accessing') ----- - type - ^ type! Item was removed: - ----- Method: MCClassDefinition>>unload (in category 'installing') ----- - unload - Environment current removeClassNamed: name! Item was removed: - ----- Method: MCClassDefinition>>variables (in category 'accessing') ----- - variables - ^ variables! Item was removed: - ----- Method: MCClassDefinition>>workingCopy (in category 'accessing') ----- - workingCopy - ^ self actualClass workingCopy! Item was removed: - MCVariableDefinition subclass: #MCClassInstanceVariableDefinition - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Modeling'! Item was removed: - ----- Method: MCClassInstanceVariableDefinition class>>type (in category 'accessing') ----- - type - ^ #classInstance! Item was removed: - ----- Method: MCClassInstanceVariableDefinition>>isClassInstanceVariable (in category 'testing') ----- - isClassInstanceVariable - ^ true! Item was removed: - MCDefinition subclass: #MCClassTraitDefinition - instanceVariableNames: 'baseTrait classTraitComposition' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Modeling'! Item was removed: - ----- Method: MCClassTraitDefinition class>>baseTraitName:classTraitComposition: (in category 'instance creation') ----- - baseTraitName: aString classTraitComposition: classTraitCompositionString - ^self instanceLike: ( - self new - initializeWithBaseTraitName: aString - classTraitComposition: classTraitCompositionString).! Item was removed: - ----- Method: MCClassTraitDefinition>>= (in category 'accessing') ----- - = aDefinition - ^ (super = aDefinition) - and: [baseTrait = aDefinition baseTrait - and: [self classTraitCompositionString = aDefinition classTraitCompositionString]] - - ! Item was removed: - ----- Method: MCClassTraitDefinition>>accept: (in category 'visiting') ----- - accept: aVisitor - ^ aVisitor visitClassTraitDefinition: self.! Item was removed: - ----- Method: MCClassTraitDefinition>>baseTrait (in category 'accessing') ----- - baseTrait - ^baseTrait - ! Item was removed: - ----- Method: MCClassTraitDefinition>>className (in category 'accessing') ----- - className - ^self baseTrait! Item was removed: - ----- Method: MCClassTraitDefinition>>classTraitComposition (in category 'accessing') ----- - classTraitComposition - ^classTraitComposition - - ! Item was removed: - ----- Method: MCClassTraitDefinition>>classTraitCompositionString (in category 'accessing') ----- - classTraitCompositionString - ^self classTraitComposition ifNil: ['{}']. - - ! Item was removed: - ----- Method: MCClassTraitDefinition>>definitionString (in category 'accessing') ----- - definitionString - ^self baseTrait , ' classTrait - uses: ' , self classTraitCompositionString. - ! Item was removed: - ----- Method: MCClassTraitDefinition>>description (in category 'accessing') ----- - description - ^{ - baseTrait . - classTraitComposition }! Item was removed: - ----- Method: MCClassTraitDefinition>>hash (in category 'accessing') ----- - hash - - | hash | - hash := baseTrait hashWithInitialHash: 0. - hash := self classTraitCompositionString hashWithInitialHash: hash. - ^hash - ! Item was removed: - ----- Method: MCClassTraitDefinition>>initializeWithBaseTraitName:classTraitComposition: (in category 'initialization') ----- - initializeWithBaseTraitName: aTraitName classTraitComposition: aString - baseTrait := aTraitName. - classTraitComposition := aString.! Item was removed: - ----- Method: MCClassTraitDefinition>>load (in category 'installing') ----- - load - Compiler evaluate: self definitionString environment: Environment current! Item was removed: - ----- Method: MCClassTraitDefinition>>requirements (in category 'accessing') ----- - requirements - ^{ baseTrait }! Item was removed: - ----- Method: MCClassTraitDefinition>>sortKey (in category 'accessing') ----- - sortKey - ^ self baseTrait name , '.classTrait'! Item was removed: - ----- Method: MCClassTraitDefinition>>source (in category 'accessing') ----- - source - ^self definitionString! Item was removed: - ----- Method: MCClassTraitDefinition>>summary (in category 'accessing') ----- - summary - ^self baseTrait , ' classTrait' - ! Item was removed: - MCDoItParser subclass: #MCClassTraitParser - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Modeling'! Item was removed: - ----- Method: MCClassTraitParser class>>pattern (in category 'constants') ----- - pattern - ^ '*classTrait*uses:*'! Item was removed: - ----- Method: MCClassTraitParser>>addDefinitionsTo: (in category 'reader') ----- - addDefinitionsTo: aCollection - | tokens definition traitCompositionString | - tokens := Scanner new scanTokens: source. - traitCompositionString := ((ReadStream on: source) - match: 'uses:'; - upToEnd) withBlanksTrimmed. - definition := MCClassTraitDefinition - baseTraitName: (tokens at: 1) - classTraitComposition: traitCompositionString. - aCollection add: definition - ! Item was removed: - MCVariableDefinition subclass: #MCClassVariableDefinition - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Modeling'! Item was removed: - ----- Method: MCClassVariableDefinition class>>type (in category 'accessing') ----- - type - ^ #class! Item was removed: - ----- Method: MCClassVariableDefinition>>isClassVariable (in category 'testing') ----- - isClassVariable - ^ true! Item was removed: - ----- Method: MCClassVariableDefinition>>isOrderDependend (in category 'testing') ----- - isOrderDependend - ^false! Item was removed: - MCTool subclass: #MCCodeTool - instanceVariableNames: 'items environmentInDisplayingImage' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-UI'! - - !MCCodeTool commentStamp: 'nk 11/10/2003 22:00' prior: 0! - MCCodeTool is an abstract superclass for those Monticello browsers that display code. - It contains copies of the various CodeHolder methods that perform the various menu operations in the method list. - ! Item was removed: - ----- Method: MCCodeTool>>adoptMessageInCurrentChangeset (in category 'menus') ----- - adoptMessageInCurrentChangeset - "Add the receiver's method to the current change set if not already there" - - self selectedClassOrMetaClass ifNotNil: [ :cl | - self selectedMessageName ifNotNil: [ :sel | - ChangeSet current adoptSelector: sel forClass: cl. - self changed: #annotations ]] - ! Item was removed: - ----- Method: MCCodeTool>>annotations (in category 'subclassResponsibility') ----- - annotations - "Build an annotations string for the various browsers" - ^''! Item was removed: - ----- Method: MCCodeTool>>browseClassHierarchy (in category 'menus') ----- - browseClassHierarchy - "Create and schedule a class list browser on the receiver's hierarchy." - - self systemNavigation - spawnHierarchyForClass: self selectedClassOrMetaClass - selector: self selectedMessageName "OK if nil"! Item was removed: - ----- Method: MCCodeTool>>browseFullProtocol (in category 'menus') ----- - browseFullProtocol - "Open up a protocol-category browser on the value of the receiver's current selection. If in mvc, an old-style protocol browser is opened instead. Someone who still uses mvc might wish to make the protocol-category-browser work there too, thanks." - - (Smalltalk isMorphic and: [Smalltalk hasClassNamed: #Lexicon]) ifFalse: [^ self spawnFullProtocol]. - self selectedClassOrMetaClass ifNotNil: [:class | - ^ (Smalltalk at: #Lexicon) new - openOnClass: class - inWorld: self currentWorld - showingSelector: self selectedMessageName]. - ^ nil! Item was removed: - ----- Method: MCCodeTool>>browseMessages (in category 'menus') ----- - browseMessages - "Present a menu of the currently selected message, as well as all messages sent by it. Open a message set browser of all implementors of the selector chosen." - - self systemNavigation browseAllImplementorsOf: (self selectedMessageName ifNil: [ ^nil ])! Item was removed: - ----- Method: MCCodeTool>>browseMethodFull (in category 'menus') ----- - browseMethodFull - "Create and schedule a full Browser and then select the current class and message, or just the current class if viewing a class definition." - ^ self selectedClassOrMetaClass ifNotNil: [ :cls | - self selectedMessageName - ifNil: [ToolSet browseClass: cls] - ifNotNil: [:sel | ToolSet browse: cls selector: sel]]! Item was removed: - ----- Method: MCCodeTool>>browseSendersOfMessages (in category 'menus') ----- - browseSendersOfMessages - "Present a menu of the currently selected message, as well as all messages sent by it. Open a message set browser of all senders of the selector chosen." - - self systemNavigation browseAllCallsOn: (self selectedMessageName ifNil: [ ^nil ])! Item was removed: - ----- Method: MCCodeTool>>browseVersions (in category 'menus') ----- - browseVersions - "Create and schedule a message set browser on all versions of the currently selected message selector." - (ToolSet - browseVersionsOf: self selectedClassOrMetaClass - selector: (self selectedMessageName ifNil: [^ self])) ifNil: [self changed: #flash]! Item was removed: - ----- Method: MCCodeTool>>classListMenu: (in category 'menus') ----- - classListMenu: aMenu - - aMenu addList: #( - - - ('browse full (b)' browseMethodFull) - ('browse hierarchy (h)' browseClassHierarchy) - ('browse protocol (p)' browseFullProtocol) - " - - ('printOut' printOutClass) - ('fileOut' fileOutClass) - " - - ('show hierarchy' methodHierarchy) - " ('show definition' editClass) - ('show comment' editComment) - " - " - - ('inst var refs...' browseInstVarRefs) - ('inst var defs...' browseInstVarDefs) - - - ('class var refs...' browseClassVarRefs) - ('class vars' browseClassVariables) - ('class refs (N)' browseClassRefs) - - - ('rename class ...' renameClass) - ('copy class' copyClass) - ('remove class (x)' removeClass) - " - - - ('find method...' findMethodInChangeSets)). - - ^aMenu! Item was removed: - ----- Method: MCCodeTool>>copyReference (in category 'menus') ----- - copyReference - "Copy the selected selector to the clipboard" - self selectedMessageName ifNotNil: - [ : selector | Clipboard clipboardText: - (self selectedClassOrMetaClass - ifNil: [ selector asString ] - ifNotNil: [ : cls | (cls >> selector) reference ]) ]! Item was removed: - ----- Method: MCCodeTool>>copySelector (in category 'menus') ----- - copySelector - "Copy the selected selector to the clipboard" - - | selector | - (selector := self selectedMessageName) ifNotNil: - [Clipboard clipboardText: selector asString]! Item was removed: - ----- Method: MCCodeTool>>doItContext (in category 'accessing') ----- - doItContext - ^ nil! Item was removed: - ----- Method: MCCodeTool>>doItReceiver (in category 'accessing') ----- - doItReceiver - ^ self selectedClass! Item was removed: - ----- Method: MCCodeTool>>environmentInDisplayingImage (in category 'accessing') ----- - environmentInDisplayingImage - ^ environmentInDisplayingImage ifNil: [Smalltalk globals]! Item was removed: - ----- Method: MCCodeTool>>environmentInDisplayingImage: (in category 'accessing') ----- - environmentInDisplayingImage: anEnvironment - environmentInDisplayingImage := anEnvironment! Item was removed: - ----- Method: MCCodeTool>>fileOutMessage (in category 'menus') ----- - fileOutMessage - "Put a description of the selected message on a file" - - | fileName | - self selectedMessageName ifNotNil: - [Cursor write showWhile: - [self selectedClassOrMetaClass fileOutMethod: self selectedMessageName]. - ^self]. - items isEmpty ifTrue: - [^self]. - fileName := UIManager default saveFilenameRequest: 'File out on which file?' initialAnswer: 'methods'. - fileName isEmptyOrNil ifTrue: [^self]. - Cursor write showWhile: - [| definitionStream removalInitStream | - definitionStream := WriteStream on: (String new: 1000). - removalInitStream := WriteStream on: (String new: 100). - definitionStream header; timeStamp. - items do: - [:patchOp| | def | - def := patchOp definition. - def isMethodDefinition ifTrue: - [(def actualClass notNil - and: [def actualClass includesSelector: def selector]) - ifTrue: - [def actualClass - printMethodChunk: def selector - withPreamble: true - on: definitionStream - moveSource: false - toFile: nil. - (def selector == #initialize and: [def classIsMeta]) ifTrue: - [removalInitStream nextChunkPut: def className, ' initialize'; cr]] - ifFalse: - [removalInitStream nextChunkPut: def className, (def classIsMeta ifTrue: [' class'] ifFalse: ['']), ' removeSelector: ', def selector printString; cr]]. - def isClassDefinition ifTrue: - [def actualClass - ifNotNil: - [definitionStream nextChunkPut: def actualClass definition. - def comment ifNotNil: - [def actualClass organization - putCommentOnFile: definitionStream - numbered: 1 - moveSource: false - forClass: def actualClass]] - ifNil: - [removalInitStream nextChunkPut: def className, ' removeFromSystem'; cr]]]. - definitionStream nextPutAll: removalInitStream contents. - FileStream writeSourceCodeFrom: definitionStream baseName: fileName isSt: true useHtml: false]! Item was removed: - ----- Method: MCCodeTool>>findMethodInChangeSets (in category 'menus') ----- - findMethodInChangeSets - "Find and open a changeSet containing the current method." - - | aName | - (aName := self selectedMessageName) ifNotNil: [ - ChangeSorter - browseChangeSetsWithClass: self selectedClassOrMetaClass - selector: aName]! Item was removed: - ----- Method: MCCodeTool>>items (in category 'accessing') ----- - items - ^ items! Item was removed: - ----- Method: MCCodeTool>>methodHierarchy (in category 'menus') ----- - methodHierarchy - "Create and schedule a method browser on the hierarchy of implementors." - - self systemNavigation methodHierarchyBrowserForClass: self selectedClassOrMetaClass - selector: self selectedMessageName! Item was removed: - ----- Method: MCCodeTool>>methodListKey:from: (in category 'menus') ----- - methodListKey: aKeystroke from: aListMorph - aKeystroke caseOf: { - [$b] -> [self browseMethodFull]. - [$h] -> [self browseClassHierarchy]. - [$p] -> [self browseFullProtocol]. - [$o] -> [self fileOutMessage]. - [$c] -> [self copySelector]. - [$C] -> [self copyReference]. - [$n] -> [self browseSendersOfMessages]. - [$m] -> [self browseMessages]. - [$i] -> [self methodHierarchy]. - [$v] -> [self browseVersions]} - otherwise: []! Item was removed: - ----- Method: MCCodeTool>>methodListMenu: (in category 'menus') ----- - methodListMenu: aMenu - "Build the menu for the selected method, if any." - - self selectedMessageName - ifNil: [items notEmpty ifTrue: - [aMenu addList:#( - ('fileOut (o)' fileOutMessage))]] - ifNotNil: [ - aMenu addList:#( - ('browse full (b)' browseMethodFull) - ('browse hierarchy (h)' browseClassHierarchy) - ('browse protocol (p)' browseFullProtocol) - - - ('fileOut (o)' fileOutMessage) - ('printOut' printOutMessage) - ('copy selector (c)' copySelector) - ('copy reference (C)' copyReference)). - aMenu addList: #( - - - ('browse senders (n)' browseSendersOfMessages) - ('browse implementors (m)' browseMessages) - ('inheritance (i)' methodHierarchy) - ('versions (v)' browseVersions) - ('change sets with this method' findMethodInChangeSets) - " ('x revert to previous version' revertToPreviousVersion)" - ('remove from current change set' removeFromCurrentChanges) - " ('x revert & remove from changes' revertAndForget)" - ('add to current change set' adoptMessageInCurrentChangeset) - " ('x copy up or copy down...' copyUpOrCopyDown)" - " ('x remove method (x)' removeMessage)" - "-" - ). - ]. - " aMenu addList: #( - ('x inst var refs...' browseInstVarRefs) - ('x inst var defs...' browseInstVarDefs) - ('x class var refs...' browseClassVarRefs) - ('x class variables' browseClassVariables) - ('x class refs (N)' browseClassRefs) - ). - " - ^ aMenu - ! Item was removed: - ----- Method: MCCodeTool>>printOutMessage (in category 'menus') ----- - printOutMessage - "Write a file with the text of the selected message, for printing by a web browser" - - self selectedMessageName ifNotNil: [ - self selectedClassOrMetaClass fileOutMethod: self selectedMessageName - asHtml: true]! Item was removed: - ----- Method: MCCodeTool>>removeFromCurrentChanges (in category 'menus') ----- - removeFromCurrentChanges - "Tell the changes mgr to forget that the current msg was changed." - - ChangeSet current removeSelectorChanges: self selectedMessageName - class: self selectedClassOrMetaClass. - self changed: #annotations! Item was removed: - ----- Method: MCCodeTool>>selectedClass (in category 'subclassResponsibility') ----- - selectedClass - "Answer the class that is selected, or nil" - self subclassResponsibility! Item was removed: - ----- Method: MCCodeTool>>selectedClassOrMetaClass (in category 'subclassResponsibility') ----- - selectedClassOrMetaClass - "Answer the class that is selected, or nil" - self subclassResponsibility! Item was removed: - ----- Method: MCCodeTool>>selectedMessageCategoryName (in category 'subclassResponsibility') ----- - selectedMessageCategoryName - "Answer the method category of the method that is selected, or nil" - self subclassResponsibility! Item was removed: - ----- Method: MCCodeTool>>selectedMessageName (in category 'subclassResponsibility') ----- - selectedMessageName - "Answer the name of the selected message" - self subclassResponsibility! Item was removed: - ----- Method: MCCodeTool>>setItems: (in category 'initialize-release') ----- - setItems: aCollection - items := aCollection! Item was removed: - Object subclass: #MCConflict - instanceVariableNames: 'operation chooseRemote' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Merging'! Item was removed: - ----- Method: MCConflict class>>operation: (in category 'instance creation') ----- - operation: anOperation - ^ self new operation: anOperation ! Item was removed: - ----- Method: MCConflict>>annotations (in category 'accessing') ----- - annotations - ^operation ifNotNil: [ :op | op annotations ]! Item was removed: - ----- Method: MCConflict>>applyTo: (in category 'applying') ----- - applyTo: anObject - self isResolved ifFalse: [self error: 'Cannot continue until this conflict has been resolved']. - self remoteChosen ifTrue: [operation applyTo: anObject].! Item was removed: - ----- Method: MCConflict>>chooseLocal (in category 'resolving ') ----- - chooseLocal - chooseRemote := false! Item was removed: - ----- Method: MCConflict>>chooseNewer (in category 'resolving ') ----- - chooseNewer - self isLocalNewer ifTrue: [ self chooseLocal ] - ifFalse: [ self isRemoteNewer ifTrue: [ self chooseRemote ]]! Item was removed: - ----- Method: MCConflict>>chooseOlder (in category 'resolving ') ----- - chooseOlder - self isRemoteNewer ifTrue: [ self chooseLocal ] - ifFalse: [ self isLocalNewer ifTrue: [ self chooseRemote ]]! Item was removed: - ----- Method: MCConflict>>chooseRemote (in category 'resolving ') ----- - chooseRemote - chooseRemote := true! Item was removed: - ----- Method: MCConflict>>chooseSameAST (in category 'resolving ') ----- - 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 removed: - ----- Method: MCConflict>>clearChoice (in category 'resolving ') ----- - clearChoice - chooseRemote := nil! Item was removed: - ----- Method: MCConflict>>definition (in category 'accessing') ----- - definition - ^operation ifNotNil: [ :op | op definition ]! Item was removed: - ----- Method: MCConflict>>isConflict (in category 'testing') ----- - isConflict - ^true! Item was removed: - ----- Method: MCConflict>>isLocalNewer (in category 'testing') ----- - isLocalNewer - ^ (self localDefinition fullTimeStamp ifNil: [^ false]) > self remoteDefinition fullTimeStamp! Item was removed: - ----- Method: MCConflict>>isRemoteNewer (in category 'testing') ----- - isRemoteNewer - ^ (self localDefinition fullTimeStamp ifNil: [^ false]) < self remoteDefinition fullTimeStamp! Item was removed: - ----- Method: MCConflict>>isResolved (in category 'testing') ----- - isResolved - ^ chooseRemote notNil! Item was removed: - ----- Method: MCConflict>>localChosen (in category 'testing') ----- - localChosen - ^ chooseRemote notNil and: [chooseRemote not]! Item was removed: - ----- Method: MCConflict>>localDefinition (in category 'accessing') ----- - localDefinition - ^ operation baseDefinition! Item was removed: - ----- Method: MCConflict>>operation (in category 'accessing') ----- - operation - ^ operation! Item was removed: - ----- Method: MCConflict>>operation: (in category 'accessing') ----- - operation: anOperation - operation := anOperation! Item was removed: - ----- Method: MCConflict>>remoteChosen (in category 'testing') ----- - remoteChosen - ^ chooseRemote notNil and: [chooseRemote]! Item was removed: - ----- Method: MCConflict>>remoteDefinition (in category 'testing') ----- - remoteDefinition - ^ operation targetDefinition! Item was removed: - ----- Method: MCConflict>>source (in category 'accessing') ----- - source - ^ self localChosen - ifTrue: [operation fromSource] - ifFalse: [operation source]! Item was removed: - ----- Method: MCConflict>>status (in category 'accessing') ----- - status - ^ self isResolved - ifFalse: [''] - ifTrue: [self remoteChosen - ifFalse: ['L'] - ifTrue: ['R']]! Item was removed: - ----- Method: MCConflict>>summary (in category 'accessing') ----- - summary - | attribute | - attribute := - self isResolved - ifTrue: [self remoteChosen ifTrue: [#underlined] ifFalse: [#struckOut]] - ifFalse: [#bold]. - ^ Text string: operation summary attribute: (TextEmphasis perform: attribute)! Item was removed: - Object subclass: #MCDefinition - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Base'! - MCDefinition class - instanceVariableNames: 'instances'! - - !MCDefinition commentStamp: 'hjh 1/22/2013 22:25' prior: 0! - A MCDefinition is a model for Smalltalk code. A package snapshot (MCSnapshot) is a collection of these definitions. - - ! - MCDefinition class - instanceVariableNames: 'instances'! Item was removed: - ----- Method: MCDefinition class>>cleanUp (in category 'class initialization') ----- - cleanUp - "Flush caches" - - self clearInstances.! Item was removed: - ----- Method: MCDefinition class>>clearInstances (in category 'as yet unclassified') ----- - clearInstances - - instances := nil. - self subclassesDo: #clearInstances! Item was removed: - ----- Method: MCDefinition class>>instanceLike: (in category 'as yet unclassified') ----- - instanceLike: aDefinition - - ^(instances ifNil: [ instances := WeakSet new ]) - like: aDefinition - ifAbsent: [ instances add: aDefinition ]! Item was removed: - ----- Method: MCDefinition>><= (in category 'comparing') ----- - <= other - ^ self sortKey <= other sortKey! Item was removed: - ----- Method: MCDefinition>>= (in category 'comparing') ----- - = aDefinition - ^(aDefinition isKindOf: MCDefinition) and: [self isRevisionOf: aDefinition]! Item was removed: - ----- Method: MCDefinition>>actualClass (in category 'accessing') ----- - actualClass - - ^nil! Item was removed: - ----- Method: MCDefinition>>actualClassIn: (in category 'accessing') ----- - actualClassIn: anEnvironment - - ^nil! Item was removed: - ----- Method: MCDefinition>>addMethodAdditionTo: (in category 'installing') ----- - addMethodAdditionTo: aCollection - Transcript show: self printString. - self load! Item was removed: - ----- Method: MCDefinition>>annotations (in category 'annotations') ----- - annotations - ^self annotations: Preferences defaultAnnotationRequests! Item was removed: - ----- Method: MCDefinition>>annotations: (in category 'annotations') ----- - annotations: requests - "Answer a string for an annotation pane, trying to fulfill the annotation requests. - These might include anything that - Preferences defaultAnnotationRequests - might return. Which includes anything in - Preferences annotationInfo - To edit these, use:" - "Preferences editAnnotations" - - ^String streamContents: [ :s | self printAnnotations: requests on: s ].! Item was removed: - ----- Method: MCDefinition>>description (in category 'comparing') ----- - description - self subclassResponsibility! Item was removed: - ----- Method: MCDefinition>>fullTimeStamp (in category 'comparing') ----- - fullTimeStamp - ^TimeStamp current! Item was removed: - ----- Method: MCDefinition>>handlePackageRename:to: (in category 'renaming') ----- - handlePackageRename: oldPackageName to: newPackageName - "Overridden as necessary in subclasses."! Item was removed: - ----- Method: MCDefinition>>hash (in category 'comparing') ----- - hash - ^ self description hash! Item was removed: - ----- Method: MCDefinition>>isClassDefinition (in category 'testing') ----- - isClassDefinition - ^false! Item was removed: - ----- Method: MCDefinition>>isClassDefinitionExtension (in category 'testing') ----- - isClassDefinitionExtension - "Answer true if this definition extends the regular class definition" - ^false! Item was removed: - ----- Method: MCDefinition>>isMethodDefinition (in category 'testing') ----- - isMethodDefinition - ^false! Item was removed: - ----- Method: MCDefinition>>isOrganizationDefinition (in category 'testing') ----- - isOrganizationDefinition - ^false! Item was removed: - ----- Method: MCDefinition>>isRevisionOf: (in category 'comparing') ----- - isRevisionOf: aDefinition - ^ aDefinition description = self description! Item was removed: - ----- Method: MCDefinition>>isSameRevisionAs: (in category 'comparing') ----- - isSameRevisionAs: aDefinition - ^ self = aDefinition! Item was removed: - ----- Method: MCDefinition>>isScriptDefinition (in category 'testing') ----- - isScriptDefinition - ^false! Item was removed: - ----- Method: MCDefinition>>load (in category 'installing') ----- - load - ! Item was removed: - ----- Method: MCDefinition>>loadOver: (in category 'installing') ----- - loadOver: aDefinition - self load - ! Item was removed: - ----- Method: MCDefinition>>mcModel (in category 'private') ----- - mcModel - "Find my WorkingCopy, use the first mcModel-capable repository in its reposigoryGroup." - self repositoryGroup ifNotNil: - [ : group | group repositoriesDo: - [ : each | each mcModel ifNotNil: - [ : mcModel | ^ mcModel ] ] ]. - ^ nil! Item was removed: - ----- Method: MCDefinition>>newCategoryNameFor:givenRenameFrom:to: (in category 'renaming') ----- - newCategoryNameFor: categoryName givenRenameFrom: oldPackageName to: newPackageName - ^ oldPackageName size < categoryName size - ifTrue: - [ newPackageName , - (categoryName - copyFrom: oldPackageName size + 1 - to: categoryName size) ] - ifFalse: [ newPackageName ]! Item was removed: - ----- Method: MCDefinition>>postload (in category 'installing') ----- - postload! Item was removed: - ----- Method: MCDefinition>>postloadOver: (in category 'installing') ----- - postloadOver: aDefinition - self postload! Item was removed: - ----- Method: MCDefinition>>printAnnotations:on: (in category 'annotations') ----- - printAnnotations: requests on: aStream - "Add a string for an annotation pane, trying to fulfill the annotation requests. - These might include anything that - Preferences defaultAnnotationRequests - might return. Which includes anything in - Preferences annotationInfo - To edit these, use:" - "Preferences editAnnotations" - - aStream nextPutAll: 'not yet implemented'! Item was removed: - ----- Method: MCDefinition>>printOn: (in category 'printing') ----- - printOn: aStream - super printOn: aStream. - aStream nextPutAll: '(', self summary, ')'! Item was removed: - ----- Method: MCDefinition>>provisions (in category 'accessing') ----- - provisions - ^ #()! Item was removed: - ----- Method: MCDefinition>>repositoryGroup (in category 'repositories') ----- - repositoryGroup - "Answer the MCRepositoryGroup from which this this object was loaded." - ^ self workingCopy ifNotNil: [ : wc | wc repositoryGroup ]! Item was removed: - ----- Method: MCDefinition>>requirements (in category 'accessing') ----- - requirements - ^ #()! Item was removed: - ----- Method: MCDefinition>>sortKey (in category 'comparing') ----- - sortKey - self subclassResponsibility ! Item was removed: - ----- Method: MCDefinition>>summary (in category 'printing') ----- - summary - self subclassResponsibility ! Item was removed: - ----- Method: MCDefinition>>summaryAndRevision (in category 'printing') ----- - summaryAndRevision - ^self summary! Item was removed: - ----- Method: MCDefinition>>summarySuffixOver: (in category 'printing') ----- - summarySuffixOver: previousDefinition - ^self source = previousDefinition source - ifTrue: [ ' (source same but rev changed)' ] - ifFalse: [ ' (changed)' ]! Item was removed: - ----- Method: MCDefinition>>unload (in category 'installing') ----- - unload! Item was removed: - ----- Method: MCDefinition>>wantsToBeOutermost (in category 'testing') ----- - wantsToBeOutermost - "Outermost definitions are installed after all other definitions. In particular, this hook is crucial for the correct behavior of removal preambles. See MCDependencySorter >> #addDeferred:." - - ^ false! Item was removed: - ----- Method: MCDefinition>>workingCopy (in category 'repositories') ----- - workingCopy - self subclassResponsibility! Item was removed: - Object subclass: #MCDefinitionIndex - instanceVariableNames: 'definitions' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Patching'! - - !MCDefinitionIndex commentStamp: 'ul 10/22/2018 22:39' prior: 0! - I'm just a wrapper for a KeyedSet with keyBlock [ :definition | definition description ] translating #add: to #put:.! Item was removed: - ----- Method: MCDefinitionIndex class>>definitions: (in category 'instance creation') ----- - definitions: aCollection - - ^self basicNew - initialize: aCollection size; - addAll: aCollection; - yourself! Item was removed: - ----- Method: MCDefinitionIndex>>add: (in category 'adding') ----- - add: aDefinition - - ^definitions put: aDefinition! Item was removed: - ----- Method: MCDefinitionIndex>>addAll: (in category 'adding') ----- - addAll: aCollection - - aCollection do: [ :each | - definitions put: each ]! Item was removed: - ----- Method: MCDefinitionIndex>>definitionLike:ifPresent:ifAbsent: (in category 'accessing') ----- - definitionLike: aDefinition ifPresent: foundBlock ifAbsent: absentBlock - - ^(definitions like: aDefinition ifAbsent: nil) - ifNil: [ absentBlock value ] - ifNotNil: [ :definition | - foundBlock value: definition ]! Item was removed: - ----- Method: MCDefinitionIndex>>definitions (in category 'accessing') ----- - definitions - - ^definitions asArray! Item was removed: - ----- Method: MCDefinitionIndex>>definitionsDo: (in category 'enumerating') ----- - definitionsDo: aBlock - - definitions do: aBlock! Item was removed: - ----- Method: MCDefinitionIndex>>initialize (in category 'initialize-release') ----- - initialize - - self initialize: 10! Item was removed: - ----- Method: MCDefinitionIndex>>initialize: (in category 'initialize-release') ----- - initialize: initialCapacity - - definitions := (KeyedSet new: initialCapacity) - keyBlock: [ :object | object description ]; - yourself! Item was removed: - ----- Method: MCDefinitionIndex>>remove: (in category 'removing') ----- - remove: aDefinition - - ^definitions remove: aDefinition ifAbsent: nil! Item was removed: - Object subclass: #MCDependencySorter - instanceVariableNames: 'nondeferred deferred required provided' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Loading'! - - !MCDependencySorter commentStamp: 'ct 4/18/2020 16:38' prior: 0! - I sort a set of passed MCDefinitions, resolving all dependency conflicts automatically. - - To use me, first add some items to me using the building protocol or my class-side #items: selector. After that, send #orderedItems to me and I will tell you all items in a loadable order. - - Instance Variables - nondeferred: <SequenceableCollection> - Usual items that do not require special sorting mechanics. - deferred: <SequenceableCollection> - Items that are added after all nondeferred items. See MCDefinition >> #wantsToBeOutermost. - required: <Set> - provided: <Set>! Item was removed: - ----- Method: MCDependencySorter class>>items: (in category 'instance creation') ----- - items: aCollection - ^ self new addAll: aCollection! Item was removed: - ----- Method: MCDependencySorter class>>new (in category 'instance creation') ----- - new - ^ self basicNew initialize! Item was removed: - ----- Method: MCDependencySorter class>>sortItems: (in category 'utility') ----- - sortItems: aCollection - | sorter | - sorter := self items: aCollection. - sorter externalRequirements do: [:req | sorter addProvision: req]. - ^ sorter orderedItems! Item was removed: - ----- Method: MCDependencySorter>>add: (in category 'building') ----- - add: anItem - | requirements | - (anItem wantsToBeOutermost) - ifTrue: [^self addDeferred: anItem]. - requirements := self unresolvedRequirementsFor: anItem. - requirements isEmpty - ifTrue: [self addToOrder: anItem] - ifFalse: [self addRequirements: requirements for: anItem]. - ^anItem! Item was removed: - ----- Method: MCDependencySorter>>addAll: (in category 'building') ----- - addAll: aCollection - aCollection asArray sort do: [:ea | self add: ea]! Item was removed: - ----- Method: MCDependencySorter>>addDeferred: (in category 'private') ----- - addDeferred: anItem - "Add an item to the derred list. Deferred items will be appended to #orderedItems after all nondeferred items. See #wantsToBeOutermost." - - ^ deferred add: anItem! Item was removed: - ----- Method: MCDependencySorter>>addExternalProvisions: (in category 'building') ----- - addExternalProvisions: aCollection - (aCollection intersection: self externalRequirements) - do: [:ea | self addProvision: ea]! Item was removed: - ----- Method: MCDependencySorter>>addProvision: (in category 'private') ----- - addProvision: anObject - | newlySatisfied | - provided add: anObject. - newlySatisfied := required removeKey: anObject ifAbsent: [#()]. - self addAll: newlySatisfied.! Item was removed: - ----- Method: MCDependencySorter>>addRequirement:for: (in category 'private') ----- - addRequirement: reqObject for: itemObject - (self itemsRequiring: reqObject) add: itemObject! Item was removed: - ----- Method: MCDependencySorter>>addRequirements:for: (in category 'private') ----- - addRequirements: aCollection for: anObject - aCollection do: [:ea | self addRequirement: ea for: anObject]! Item was removed: - ----- Method: MCDependencySorter>>addToOrder: (in category 'private') ----- - addToOrder: anItem - nondeferred add: anItem. - anItem provisions do: [:ea | self addProvision: ea].! Item was removed: - ----- Method: MCDependencySorter>>externalRequirements (in category 'accessing') ----- - externalRequirements - | unloaded providedByUnloaded | - unloaded := self itemsWithMissingRequirements. - providedByUnloaded := (unloaded gather: [:e | e provisions]) asSet. - ^ required keys reject: [:ea | providedByUnloaded includes: ea ]! Item was removed: - ----- Method: MCDependencySorter>>initialize (in category 'initialize-release') ----- - initialize - provided := Set new. - required := Dictionary new. - nondeferred := OrderedCollection new. - deferred := OrderedCollection new.! Item was removed: - ----- Method: MCDependencySorter>>itemsRequiring: (in category 'private') ----- - itemsRequiring: anObject - ^ required at: anObject ifAbsentPut: [Set new]! Item was removed: - ----- Method: MCDependencySorter>>itemsWithMissingRequirements (in category 'accessing') ----- - itemsWithMissingRequirements - | items | - items := Set new. - required do: [:ea | items addAll: ea]. - ^ items - ! Item was removed: - ----- Method: MCDependencySorter>>orderedItems (in category 'accessing') ----- - orderedItems - "Return all ordered items, first nondeferred items, second deferred (outermost) items." - - ^ nondeferred , deferred! Item was removed: - ----- Method: MCDependencySorter>>unresolvedRequirementsFor: (in category 'private') ----- - unresolvedRequirementsFor: anItem - ^ anItem requirements difference: provided! Item was removed: - ListItemWrapper subclass: #MCDependentsWrapper - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-UI'! Item was removed: - ----- Method: MCDependentsWrapper>>asString (in category 'converting') ----- - asString - ^item description! Item was removed: - ----- Method: MCDependentsWrapper>>contents (in category 'accessing') ----- - 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 removed: - ----- Method: MCDependentsWrapper>>hasContents (in category 'testing') ----- - hasContents - ^item requiredPackages isEmpty not! Item was removed: - ----- Method: MCDependentsWrapper>>item (in category 'accessing') ----- - item - ^item! Item was removed: - MCRepository subclass: #MCDictionaryRepository - instanceVariableNames: 'description dict' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Repositories'! Item was removed: - ----- Method: MCDictionaryRepository>>= (in category 'testing') ----- - = other - ^ self == other! Item was removed: - ----- Method: MCDictionaryRepository>>allPackageNames (in category 'packages') ----- - allPackageNames - - ^ self allVersionNames collect: [:versionName | versionName packageName] as: Set! Item was removed: - ----- Method: MCDictionaryRepository>>allVersionInfos (in category 'accessing') ----- - allVersionInfos - ^ dict values collect: [:ea | ea info]! Item was removed: - ----- Method: MCDictionaryRepository>>allVersionNames (in category 'versions') ----- - allVersionNames - "Answers all the version names in this repository" - - ^ dict values collect: [:ea | ea info name] - ! Item was removed: - ----- Method: MCDictionaryRepository>>basicStoreVersion: (in category 'private') ----- - basicStoreVersion: aVersion - dict at: aVersion info put: aVersion! Item was removed: - ----- Method: MCDictionaryRepository>>closestAncestorVersionFor:ifNone: (in category 'accessing') ----- - closestAncestorVersionFor: anAncestry ifNone: errorBlock - | info | - info := anAncestry breadthFirstAncestors - detect: [:ea | self includesVersionWithInfo: ea] - ifNone: [^ errorBlock value]. - ^ self versionWithInfo: info! Item was removed: - ----- Method: MCDictionaryRepository>>description (in category 'accessing') ----- - description - - ^ description ifNil: ['cache']! Item was removed: - ----- Method: MCDictionaryRepository>>description: (in category 'accessing') ----- - description: aString - - description := aString ! Item was removed: - ----- Method: MCDictionaryRepository>>dictionary (in category 'accessing') ----- - dictionary - - ^ dict! Item was removed: - ----- Method: MCDictionaryRepository>>dictionary: (in category 'accessing') ----- - dictionary: aDictionary - - dict := aDictionary! Item was removed: - ----- Method: MCDictionaryRepository>>includesVersionNamed: (in category 'versions') ----- - includesVersionNamed: aString - | mcVersionName | - mcVersionName := aString asMCVersionName. - ^ dict anySatisfy: - [ : ea | ea info versionName = mcVersionName ]! Item was removed: - ----- Method: MCDictionaryRepository>>includesVersionWithInfo: (in category 'testing') ----- - includesVersionWithInfo: aVersionInfo - ^ dict includesKey: aVersionInfo! Item was removed: - ----- Method: MCDictionaryRepository>>initialize (in category 'initialize-release') ----- - initialize - - dict := Dictionary new. - ! Item was removed: - ----- Method: MCDictionaryRepository>>morphicOpen: (in category 'user interface') ----- - 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 removed: - ----- Method: MCDictionaryRepository>>postCopy (in category 'copying') ----- - postCopy - super postCopy. - dict := dict copy! Item was removed: - ----- Method: MCDictionaryRepository>>sortedVersionInfos (in category 'accessing') ----- - sortedVersionInfos - | sorter | - sorter := MCVersionSorter new. - self allVersionInfos do: [:ea | sorter addVersionInfo: ea]. - ^ sorter sortedVersionInfos - ! Item was removed: - ----- Method: MCDictionaryRepository>>versionNamed: (in category 'versions') ----- - versionNamed: aMCVersionName - - ^ self versionWithInfo: (dict keys detect: [:info | info name = aMCVersionName] ifNone: [^ nil])! Item was removed: - ----- Method: MCDictionaryRepository>>versionNamesForPackageNamed: (in category 'versions') ----- - versionNamesForPackageNamed: aString - - ^ self allVersionNames select: [:versionName | versionName packageName = aString]! Item was removed: - ----- Method: MCDictionaryRepository>>versionWithInfo:ifAbsent: (in category 'versions') ----- - versionWithInfo: aVersionInfo ifAbsent: errorBlock - ^ dict at: aVersionInfo ifAbsent: errorBlock! Item was removed: - MCVersion subclass: #MCDiffyVersion - instanceVariableNames: 'base patch' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Versioning'! Item was removed: - ----- Method: MCDiffyVersion class>>baseNameFrom: (in category 'name utilities') ----- - baseNameFrom: diffName - | baseId verName | - baseId := (diffName copyAfter: $() copyUpTo: $). - baseId ifEmpty: [^baseId]. - (baseId beginsWith: '@') - ifTrue: [^baseId copyAfter: $@]. - verName := self verNameFrom: diffName. - ^(baseId includes: $.) - ifTrue: [(verName copyUpToLast: $-), '-', baseId] - ifFalse: [(verName copyUpToLast: $.), '.', baseId] - ! Item was removed: - ----- Method: MCDiffyVersion class>>nameForVer:base: (in category 'name utilities') ----- - nameForVer: versionName base: baseName - | baseId | - baseId := versionName packageName = baseName packageName - ifFalse: [ '@' , baseName ] - ifTrue: [ - versionName author = baseName author - ifTrue: [ baseName versionNumber asString ] - ifFalse: [ baseName author, '.', baseName versionNumber asString ] ]. - ^ versionName versionName , '(' , baseId , ')'! Item was removed: - ----- Method: MCDiffyVersion class>>package:info:dependencies:baseInfo:patch: (in category 'instance creation') ----- - package: aPackage info: aVersionInfo dependencies: aCollection baseInfo: baseVersionInfo patch: - aPatch - ^ self basicNew initializeWithPackage: aPackage info: aVersionInfo dependencies: aCollection baseInfo: baseVersionInfo patch: - aPatch! Item was removed: - ----- Method: MCDiffyVersion class>>package:info:snapshot:dependencies:baseVersion: (in category 'instance creation') ----- - package: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection baseVersion: aVersion - ^ self - package: aPackage - info: aVersionInfo - dependencies: aCollection - baseInfo: aVersion info - patch: (aSnapshot patchRelativeToBase: aVersion snapshot)! Item was removed: - ----- Method: MCDiffyVersion class>>verNameFrom: (in category 'name utilities') ----- - verNameFrom: diffName - ^diffName copyUpTo: $(! Item was removed: - ----- Method: MCDiffyVersion>>baseInfo (in category 'accessing') ----- - baseInfo - ^ base! Item was removed: - ----- Method: MCDiffyVersion>>baseSnapshot (in category 'accessing') ----- - baseSnapshot - | baseVersion | - baseVersion := self workingCopy repositoryGroup versionWithInfo: base. - baseVersion ifNil: [Error signal: 'Missing snapshot: ', self baseInfo name]. - ^ baseVersion snapshot! Item was removed: - ----- Method: MCDiffyVersion>>canOptimizeLoading (in category 'testing') ----- - 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 removed: - ----- Method: MCDiffyVersion>>fileName (in category 'accessing') ----- - fileName - ^ ((self class - nameForVer: info name - base: base name) , '.' , self writerClass extension) asMCVersionName! Item was removed: - ----- Method: MCDiffyVersion>>fileOutOn: (in category 'actions') ----- - 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 removed: - ----- Method: MCDiffyVersion>>initializeWithPackage:info:dependencies:baseInfo:patch: (in category 'initialize-release') ----- - 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 removed: - ----- Method: MCDiffyVersion>>isDiffy (in category 'testing') ----- - isDiffy - ^ true! Item was removed: - ----- Method: MCDiffyVersion>>patch (in category 'accessing') ----- - patch - ^ patch! Item was removed: - ----- Method: MCDiffyVersion>>snapshot (in category 'accessing') ----- - snapshot - ^ snapshot ifNil: [snapshot := MCPatcher apply: patch to: self baseSnapshot]! Item was removed: - ----- Method: MCDiffyVersion>>summary (in category 'accessing') ----- - summary - ^ '(Diff against ', self baseInfo name, ')', String cr, super summary! Item was removed: - ----- Method: MCDiffyVersion>>writerClass (in category 'accessing') ----- - writerClass - ^ MCMcdWriter ! Item was removed: - MCFileBasedRepository subclass: #MCDirectoryRepository - instanceVariableNames: 'directory' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Repositories'! Item was removed: - ----- Method: MCDirectoryRepository class>>creationTemplateLocation: (in category 'configuring') ----- - creationTemplateLocation: location - ^ self name , ' path: {1}' format: {location printString}! Item was removed: - ----- Method: MCDirectoryRepository class>>description (in category 'configuring') ----- - description - ^ 'directory'! Item was removed: - ----- Method: MCDirectoryRepository class>>directory: (in category 'instance creation') ----- - directory: aFileDirectory - ^ self new - directory: aFileDirectory ; - yourself! Item was removed: - ----- Method: MCDirectoryRepository class>>fillInTheBlankRequest (in category 'configuring') ----- - fillInTheBlankRequest - ^ 'Directory Location:'! Item was removed: - ----- Method: MCDirectoryRepository class>>morphicConfigure (in category 'configuring') ----- - morphicConfigure - ^ UIManager default chooseDirectory - ifNotNil: [:directory | self new directory: directory]! Item was removed: - ----- Method: MCDirectoryRepository class>>path: (in category 'instance creation') ----- - path: fullyQualifiedName - ^ self directory: (FileDirectory on: fullyQualifiedName)! Item was removed: - ----- Method: MCDirectoryRepository>>allFileNames (in category 'accessing') ----- - allFileNames - - ^directory entries - sort: [ :a :b | a modificationTime >= b modificationTime ]; - replace: [ :ea | ea name asMCVersionName ]! Item was removed: - ----- Method: MCDirectoryRepository>>creationTemplate (in category 'accessing') ----- - creationTemplate - ^ super creationTemplate - ifNil: - [ self creationTemplate: (self class creationTemplateLocation: self directory pathName). - creationTemplate ]! Item was removed: - ----- Method: MCDirectoryRepository>>description (in category 'user interface') ----- - description - ^ directory pathName! Item was removed: - ----- Method: MCDirectoryRepository>>directory (in category 'accessing') ----- - directory - ^ directory! Item was removed: - ----- Method: MCDirectoryRepository>>directory: (in category 'accessing') ----- - directory: aDirectory - directory = aDirectory ifFalse: [ self flushCache ]. - directory := aDirectory! Item was removed: - ----- Method: MCDirectoryRepository>>hash (in category 'comparing') ----- - hash - ^ directory pathName hash! Item was removed: - ----- Method: MCDirectoryRepository>>includesVersionNamed: (in category 'versions') ----- - includesVersionNamed: aString - - | comparable | - comparable := ((aString endsWith: '.mcz') and: [ aString size > 4 ]) - ifTrue: [ aString allButLast: 4 ] - ifFalse: [ aString ]. - allVersionNamesCache ifNil: [ - "Instead of reading the contents of the entire directory in #allVersionNames, look up a single .mcz file. - This is just an optimization. If the file does not exist, the version may still be there as an mcd." - (directory fileExists: comparable, '.mcz') ifTrue: [ ^true ] ]. - ^ self allVersionNames includes: comparable! Item was removed: - ----- Method: MCDirectoryRepository>>initialize (in category 'initialize-release') ----- - initialize - directory := FileDirectory default! Item was removed: - ----- Method: MCDirectoryRepository>>isValid (in category 'testing') ----- - isValid - ^directory exists! Item was removed: - ----- Method: MCDirectoryRepository>>readStreamForFileNamed:do: (in category 'private') ----- - readStreamForFileNamed: aString do: aBlock - | file val | - file := FileStream readOnlyFileNamed: (directory fullNameFor: aString). - val := aBlock value: file. - file close. - ^ val! Item was removed: - ----- Method: MCDirectoryRepository>>writeStreamForFileNamed:replace:do: (in category 'private') ----- - 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 removed: - Object subclass: #MCDoItParser - instanceVariableNames: 'source' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Chunk Format'! Item was removed: - ----- Method: MCDoItParser class>>concreteSubclasses (in category 'accessing class hierarchy') ----- - concreteSubclasses - ^ self allSubclasses reject: [:c | c isAbstract]! Item was removed: - ----- Method: MCDoItParser class>>forDoit: (in category 'instance creation') ----- - forDoit: aString - ^ (self subclassForDoit: aString) ifNotNil: [:c | c new source: aString]! Item was removed: - ----- Method: MCDoItParser class>>isAbstract (in category 'testing') ----- - isAbstract - ^ self pattern isNil! Item was removed: - ----- Method: MCDoItParser class>>pattern (in category 'constants') ----- - pattern - ^ nil! Item was removed: - ----- Method: MCDoItParser class>>subclassForDoit: (in category 'private') ----- - subclassForDoit: aString - ^ self concreteSubclasses detect: [:ea | ea pattern match: aString] ifNone: []! Item was removed: - ----- Method: MCDoItParser>>addDefinitionsTo: (in category 'evaluating') ----- - addDefinitionsTo: aCollection - self subclassResponsibility ! Item was removed: - ----- Method: MCDoItParser>>source (in category 'accessing') ----- - source - ^ source! Item was removed: - ----- Method: MCDoItParser>>source: (in category 'accessing') ----- - source: aString - source := aString! Item was removed: - MCEmptyVersion subclass: #MCEmptyDiffyVersion - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Storing'! Item was removed: - ----- Method: MCEmptyDiffyVersion class>>signal (in category 'exceptionInstantiator') ----- - signal - - self signal: 'About to serialize an empty diffy version.' ! Item was removed: - Warning subclass: #MCEmptyVersion - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Storing'! Item was removed: - ----- Method: MCEmptyVersion class>>signal (in category 'exceptionInstantiator') ----- - signal - - self signal: 'About to serialize an empty mcz version.'! Item was removed: - MCRepository subclass: #MCFileBasedRepository - instanceVariableNames: 'cache allFileNamesCache allVersionNamesCache' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Repositories'! Item was removed: - ----- Method: MCFileBasedRepository class>>cleanUp (in category 'release') ----- - cleanUp - "Flush caches" - - self flushAllCaches.! Item was removed: - ----- Method: MCFileBasedRepository class>>flushAllCaches (in category 'release') ----- - flushAllCaches - self allSubInstancesDo: [:ea | ea flushCache]! Item was removed: - ----- Method: MCFileBasedRepository>>allFileNames (in category 'private-files') ----- - allFileNames - self subclassResponsibility! Item was removed: - ----- Method: MCFileBasedRepository>>allFileNamesForVersionNamed: (in category 'private-files') ----- - allFileNamesForVersionNamed: aMCVersionName - ^ self - filterFileNames: self readableFileNames - forVersionNamed: aMCVersionName! Item was removed: - ----- Method: MCFileBasedRepository>>allFileNamesOrCache (in category 'private-files') ----- - allFileNamesOrCache - - ^allFileNamesCache ifNil: [ self allFileNames ]! Item was removed: - ----- Method: MCFileBasedRepository>>allPackageAndBranchNames (in category 'packages') ----- - allPackageAndBranchNames - ^ self validNames: #packageAndBranchName! Item was removed: - ----- Method: MCFileBasedRepository>>allPackageNames (in category 'packages') ----- - allPackageNames - ^ self validNames: #packageName! Item was removed: - ----- Method: MCFileBasedRepository>>allVersionNames (in category 'private-files') ----- - allVersionNames - - ^allVersionNamesCache ifNil: [ - self readableFileNames collect: [ :each | each versionName ] ]! Item was removed: - ----- Method: MCFileBasedRepository>>basicStoreVersion: (in category 'private') ----- - 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 removed: - ----- Method: MCFileBasedRepository>>cache (in category 'private') ----- - cache - ^ cache ifNil: [cache := Dictionary new]! Item was removed: - ----- Method: MCFileBasedRepository>>cacheAllFileNamesDuring: (in category 'private') ----- - cacheAllFileNamesDuring: aBlock - "Cache the result of #allFileNames and #allVersionNames during aBlock" - allFileNamesCache ifNotNil: [ ^ aBlock value ]. - self cacheAllFilenames. - ^ aBlock ensure: [ allFileNamesCache := allVersionNamesCache := nil ]! Item was removed: - ----- Method: MCFileBasedRepository>>cacheAllFilenames (in category 'private') ----- - cacheAllFilenames - allFileNamesCache ifNil: - [ allFileNamesCache := self allFileNames. - allVersionNamesCache := self allVersionNames ]! Item was removed: - ----- Method: MCFileBasedRepository>>cachedFileNames (in category 'private') ----- - cachedFileNames - ^cache == nil - ifTrue: [#()] - ifFalse: [cache keys]! Item was removed: - ----- Method: MCFileBasedRepository>>canReadFileNamed: (in category 'private-files') ----- - canReadFileNamed: aString - | reader | - reader := MCVersionReader readerClassForFileNamed: aString. - ^ reader notNil! Item was removed: - ----- Method: MCFileBasedRepository>>closestAncestorVersionFor:ifNone: (in category 'accessing') ----- - closestAncestorVersionFor: anAncestry ifNone: errorBlock - ^ self cacheAllFileNamesDuring: - [super closestAncestorVersionFor: anAncestry ifNone: errorBlock]! Item was removed: - ----- Method: MCFileBasedRepository>>filterFileNames:forVersionNamed: (in category 'private-files') ----- - filterFileNames: aCollection forVersionNamed: aMCVersionName - ^ aCollection select: - [ : ea | aMCVersionName = ea ]! Item was removed: - ----- Method: MCFileBasedRepository>>flushAllFilenames (in category 'private') ----- - flushAllFilenames - allFileNamesCache := allVersionNamesCache := nil! Item was removed: - ----- Method: MCFileBasedRepository>>flushCache (in category 'private') ----- - flushCache - self flushAllFilenames. - cache := nil! Item was removed: - ----- Method: MCFileBasedRepository>>includesVersionNamed: (in category 'versions') ----- - includesVersionNamed: aString - - | comparable | - comparable := ((aString endsWith: '.mcz') and: [ aString size > 4 ]) - ifTrue: [ aString allButLast: 4 ] - ifFalse: [ aString ]. - ^ self allVersionNames includes: comparable! Item was removed: - ----- Method: MCFileBasedRepository>>loadVersionFromFileNamed: (in category 'private-files') ----- - loadVersionFromFileNamed: aString - ^ self versionReaderForFileNamed: aString do: [:r | r version]! Item was removed: - ----- Method: MCFileBasedRepository>>loadVersionInfoFromFileNamed: (in category 'private-files') ----- - loadVersionInfoFromFileNamed: aString - ^ self versionReaderForFileNamed: aString do: [:r | r info] - ! Item was removed: - ----- Method: MCFileBasedRepository>>maxCacheSize (in category 'private') ----- - maxCacheSize - ^ 8! Item was removed: - ----- Method: MCFileBasedRepository>>morphicOpen: (in category 'user interface') ----- - morphicOpen: aWorkingCopy - (MCFileRepositoryInspector repository: self workingCopy: aWorkingCopy) - show! Item was removed: - ----- Method: MCFileBasedRepository>>notifyList (in category 'notifying') ----- - notifyList - (self allFileNames includes: 'notify') ifFalse: [^ #()]. - ^ self readStreamForFileNamed: 'notify' do: - [:s | - s upToEnd lines]! Item was removed: - ----- Method: MCFileBasedRepository>>postCopy (in category 'copying') ----- - postCopy - super postCopy. - cache := cache copy. - allFileNamesCache := allFileNamesCache copy. - allVersionNamesCache := allVersionNamesCache copy! Item was removed: - ----- Method: MCFileBasedRepository>>readableFileNames (in category 'private-files') ----- - readableFileNames - "Answer an Array of MCVersionNames representing every file in this repository; first the ones from the cache (whether or not they still exist in the repository) followed by every other file in this repository that Monticello can read." - | all cached new | - all := self allFileNamesOrCache. "from repository" - cached := self cachedFileNames. "in memory" - "Create a sparse Set, so we can avoid #= for MCVersionNames during the difference calculation." - new := all difference: ( - (Set new: (cached size * 8 min: all size)) - addAll: cached; - yourself). - ^ (cached asArray, new) - select: [:ea | self canReadFileNamed: ea]! Item was removed: - ----- Method: MCFileBasedRepository>>refresh (in category 'accessing') ----- - refresh - super refresh. - self flushCache! Item was removed: - ----- Method: MCFileBasedRepository>>resizeCache: (in category 'private') ----- - resizeCache: aDictionary - [aDictionary size <= self maxCacheSize] whileFalse: - [aDictionary removeKey: aDictionary keys atRandom]! Item was removed: - ----- Method: MCFileBasedRepository>>validNames: (in category 'private') ----- - 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 removed: - ----- Method: MCFileBasedRepository>>versionInfoFromFileNamed: (in category 'private-files') ----- - versionInfoFromFileNamed: aString - self cache at: aString ifPresent: [:v | ^ v info]. - ^ self loadVersionInfoFromFileNamed: aString! Item was removed: - ----- Method: MCFileBasedRepository>>versionNamed: (in category 'versions') ----- - versionNamed: aMCVersionName - "For FileBased repositories, aMCVersionName must have the appropriate extension!! :-(" - | version | - version := self cache - at: aMCVersionName - ifAbsent: - [ [ self loadVersionFromFileNamed: aMCVersionName ] - on: FileDoesNotExistException , NotFound - do: [ : err | nil ] ]. - self resizeCache: cache. - (version notNil and: [ version isCacheable ]) ifTrue: - [ cache - at: aMCVersionName asMCVersionName - put: version ]. - ^ version! Item was removed: - ----- Method: MCFileBasedRepository>>versionNamesForPackageNamed: (in category 'versions') ----- - versionNamesForPackageNamed: packageName - ^ Array streamContents: - [ : stream | | wantBranch | - wantBranch := packageName includes: $.. - self allFileNamesOrCache do: - [ : each | | mcVersionName branchName | - mcVersionName := each asMCVersionName. - branchName := wantBranch - ifTrue: [mcVersionName packageAndBranchName] - ifFalse: [mcVersionName packageName]. - packageName = branchName ifTrue: [ stream nextPut: mcVersionName ] ] ]! Item was removed: - ----- Method: MCFileBasedRepository>>versionReaderForFileNamed:do: (in category 'private-files') ----- - versionReaderForFileNamed: aString do: aBlock - ^ self - readStreamForFileNamed: aString - do: [:s | - (MCVersionReader readerClassForFileNamed: aString) ifNotNil: - [:class | aBlock value: (class on: s fileName: aString)]] - ! Item was removed: - ----- Method: MCFileBasedRepository>>versionWithInfo:ifAbsent: (in category 'versions') ----- - versionWithInfo: aVersionInfo ifAbsent: errorBlock - (self allFileNamesForVersionNamed: aVersionInfo versionName) do: - [:fileName | | version | - version := self versionNamed: fileName. - version info = aVersionInfo ifTrue: [^ version]]. - ^ errorBlock value! Item was removed: - ----- Method: MCFileBasedRepository>>writeStreamForFileNamed:do: (in category 'private-files') ----- - writeStreamForFileNamed: aString do: aBlock - ^ self writeStreamForFileNamed: aString replace: false do: aBlock! Item was removed: - MCRepositoryInspector subclass: #MCFileRepositoryInspector - instanceVariableNames: 'allVersionNames' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-UI'! Item was removed: - ----- Method: MCFileRepositoryInspector>>allVersionNames (in category 'private') ----- - allVersionNames - ^ allVersionNames ifNil: - [ self initializeVersionNames. - allVersionNames ]! Item was removed: - ----- Method: MCFileRepositoryInspector>>initializeVersionNames (in category 'private') ----- - initializeVersionNames - repository cacheAllFileNamesDuring: - [ super initializeVersionNames. - allVersionNames := repository readableFileNames ]! Item was removed: - ----- Method: MCFileRepositoryInspector>>refresh (in category 'morphic ui') ----- - refresh - allVersionNames := nil. - super refresh! Item was removed: - ----- Method: MCFileRepositoryInspector>>versionInfo (in category 'private') ----- - versionInfo - ^ versionInfo ifNil: [versionInfo := repository versionInfoFromFileNamed: selectedVersion]! Item was removed: - ----- Method: MCFileRepositoryInspector>>versionNamesForNoPackageSelection (in category 'private') ----- - versionNamesForNoPackageSelection - ^ self allVersionNames! Item was removed: - ----- Method: MCFileRepositoryInspector>>versionNamesForSelectedPackage (in category 'private') ----- - versionNamesForSelectedPackage - ^ self allVersionNames select: - (self class browseBranchedVersionsSeparately - ifTrue: [[:each| each packageAndBranchName = selectedPackage]] - ifFalse: [[:each| each packageName = selectedPackage]])! Item was removed: - ----- Method: MCFileRepositoryInspector>>versionSelection: (in category 'private') ----- - versionSelection: aNumber - versionInfo := nil. - super versionSelection: aNumber! Item was removed: - ----- Method: MCFileRepositoryInspector>>versionSummary (in category 'morphic ui') ----- - versionSummary - ^ version - ifNotNil: [version summary] - ifNil: [self versionInfo summary]! Item was removed: - MCVersionSorter subclass: #MCFilteredVersionSorter - instanceVariableNames: 'target' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Versioning'! Item was removed: - ----- Method: MCFilteredVersionSorter>>addVersionInfo: (in category 'accessing') ----- - addVersionInfo: aVersionInfo - (aVersionInfo hasAncestor: target) - ifTrue: [super addVersionInfo: aVersionInfo] - ! Item was removed: - ----- Method: MCFilteredVersionSorter>>processVersionInfo: (in category 'private') ----- - 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 removed: - ----- Method: MCFilteredVersionSorter>>target: (in category 'accessing') ----- - target: aVersionInfo - target := aVersionInfo! Item was removed: - Object subclass: #MCFrontier - instanceVariableNames: 'frontier bag' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Versioning'! Item was removed: - ----- Method: MCFrontier class>>frontierOn: (in category 'instance creation') ----- - frontierOn: aVersionInfo - ^ self frontierOnAll: { aVersionInfo }! Item was removed: - ----- Method: MCFrontier class>>frontierOn:and: (in category 'instance creation') ----- - frontierOn: aVersionInfo and: otherVersionInfo - ^ self frontierOnAll: { aVersionInfo. otherVersionInfo }! Item was removed: - ----- Method: MCFrontier class>>frontierOnAll: (in category 'instance creation') ----- - frontierOnAll: aCollection - | remaining allVersions | - remaining := Bag new. - allVersions := (aCollection gather: [:ea | ea withBreadthFirstAncestors]) asSet. - allVersions do: [:ea | remaining addAll: ea ancestors]. - ^self new frontier: aCollection bag: remaining! Item was removed: - ----- Method: MCFrontier>>frontier (in category 'accessing') ----- - frontier - ^frontier asArray "not safe to hand out the frontier itself"! Item was removed: - ----- Method: MCFrontier>>frontier:bag: (in category 'initialization') ----- - frontier: f bag: remaining - frontier := f asOrderedCollection. - bag := remaining! Item was removed: - ----- Method: MCFrontier>>remove: (in category 'advancing') ----- - remove: aVersionInfo - frontier remove: aVersionInfo. - aVersionInfo ancestors do: - [ :ancestor | - bag remove: ancestor. - (bag occurrencesOf: ancestor) = 0 - ifTrue: [frontier add: ancestor]]. - ^aVersionInfo! Item was removed: - ----- Method: MCFrontier>>removeAll: (in category 'advancing') ----- - removeAll: collection - collection do: [ :n | self remove: n]! Item was removed: - MCFileBasedRepository subclass: #MCFtpRepository - instanceVariableNames: 'host directory user password' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Repositories'! Item was removed: - ----- Method: MCFtpRepository class>>creationTemplate (in category 'configuring') ----- - creationTemplate - ^ - 'MCFtpRepository - host: ''modules.squeakfoundation.org'' - directory: ''mc'' - user: ''squeak'' - password: ''squeak''' - ! Item was removed: - ----- Method: MCFtpRepository class>>description (in category 'configuring') ----- - description - ^ 'FTP'! Item was removed: - ----- Method: MCFtpRepository class>>fillInTheBlankRequest (in category 'configuring') ----- - fillInTheBlankRequest - ^ 'FTP Repository:' - - ! Item was removed: - ----- Method: MCFtpRepository class>>host:directory:user:password: (in category 'instance creation') ----- - host: host directory: directory user: user password: password - ^ self new - host: host; - directory: directory; - user: user; - password: password! Item was removed: - ----- Method: MCFtpRepository class>>morphicConfigure (in category 'configuring') ----- - morphicConfigure - ^ self fillInTheBlankConfigure! Item was removed: - ----- Method: MCFtpRepository class>>templateCreationSelector (in category 'constants') ----- - templateCreationSelector - ^ #host:directory:user:password: ! Item was removed: - ----- Method: MCFtpRepository>>allFileNames (in category 'required') ----- - allFileNames - ^ self clientDo: - [:client | - self parseDirectoryListing: client getDirectory]! Item was removed: - ----- Method: MCFtpRepository>>clientDo: (in category 'private') ----- - 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 removed: - ----- Method: MCFtpRepository>>description (in category 'required') ----- - description - ^ 'ftp://', user, '@', host, '/', directory! Item was removed: - ----- Method: MCFtpRepository>>directory: (in category 'accessing') ----- - directory: dirPath - directory = dirPath ifFalse: [ self flushCache ]. - directory := dirPath! Item was removed: - ----- Method: MCFtpRepository>>host: (in category 'accessing') ----- - host: hostname - host := hostname! Item was removed: - ----- Method: MCFtpRepository>>parseDirectoryListing: (in category 'protocol handling') ----- - 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 removed: - ----- Method: MCFtpRepository>>password: (in category 'accessing') ----- - password: passwordString - password := passwordString! Item was removed: - ----- Method: MCFtpRepository>>readStreamForFileNamed:do: (in category 'required') ----- - readStreamForFileNamed: aString do: aBlock - - ^ self clientDo: - [:client | | stream | - client binary. - stream := RWBinaryOrTextStream on: String new. - stream nextPutAll: (client getFileNamed: aString). - aBlock value: stream reset]! Item was removed: - ----- Method: MCFtpRepository>>user: (in category 'accessing') ----- - user: userString - user := userString! Item was removed: - ----- Method: MCFtpRepository>>writeStreamForFileNamed:replace:do: (in category 'required') ----- - writeStreamForFileNamed: aString replace: ignoreBoolean do: aBlock - | stream | - stream := RWBinaryOrTextStream on: String new. - aBlock value: stream. - self clientDo: - [:client | - client binary. - client putFileStreamContents: stream reset as: aString]! Item was removed: - MCRepository subclass: #MCGOODSRepository - instanceVariableNames: 'hostname port connection' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Repositories'! - - !MCGOODSRepository commentStamp: 'cmm 3/6/2011 16:56' prior: 0! - A MCGOODSRepository simply stores a Dictionary of aVersionInfo-> aMCVersion.! Item was removed: - ----- Method: MCGOODSRepository class>>creationTemplate (in category 'configuring') ----- - creationTemplate - ^ - 'MCGOODSRepository - host: ''localhost'' - port: 6100'! Item was removed: - ----- Method: MCGOODSRepository class>>description (in category 'configuring') ----- - description - ^ 'GOODS'! Item was removed: - ----- Method: MCGOODSRepository class>>fillInTheBlankRequest (in category 'configuring') ----- - fillInTheBlankRequest - ^ 'GOODS Repository:'! Item was removed: - ----- Method: MCGOODSRepository class>>host:port: (in category 'instance creation') ----- - host: hostname port: portNumber - ^ self new - host: hostname; - port: portNumber! Item was removed: - ----- Method: MCGOODSRepository class>>morphicConfigure (in category 'configuring') ----- - morphicConfigure - ^ self fillInTheBlankConfigure! Item was removed: - ----- Method: MCGOODSRepository>>allPackageNames (in category 'packages') ----- - allPackageNames - ^ self root collect: - [ : ea | ea package name ]! Item was removed: - ----- Method: MCGOODSRepository>>basicStoreVersion: (in category 'private') ----- - basicStoreVersion: aVersion - self root at: aVersion info put: aVersion. - self db commit.! Item was removed: - ----- Method: MCGOODSRepository>>db (in category 'private') ----- - db - (connection isNil or: [connection isConnected not]) ifTrue: [ - connection := Smalltalk at: #KKDatabase ifPresent: [:cl | - cl onHost:hostname port: port - ] - ]. - ^ connection! Item was removed: - ----- Method: MCGOODSRepository>>description (in category 'user interface') ----- - description - ^ 'goods://', hostname asString, ':', port asString! Item was removed: - ----- Method: MCGOODSRepository>>host: (in category 'accessing') ----- - host: aString - hostname := aString! Item was removed: - ----- Method: MCGOODSRepository>>includesVersionNamed: (in category 'versions') ----- - includesVersionNamed: aString - ^ (self versionNamed: aString) notNil! Item was removed: - ----- Method: MCGOODSRepository>>port: (in category 'accessing') ----- - port: aNumber - port := aNumber! Item was removed: - ----- Method: MCGOODSRepository>>root (in category 'accessing') ----- - root - self db root ifNil: [self db root: Dictionary new]. - ^ self db root! Item was removed: - ----- Method: MCGOODSRepository>>versionNamed: (in category 'versions') ----- - versionNamed: aString - | versionName | - versionName := aString asMCVersionName. - self root keysDo: - [ : each | each versionName = versionName ifTrue: [ ^ each ] ]. - ^ nil! Item was removed: - ----- Method: MCGOODSRepository>>versionNamesForPackageNamed: (in category 'versions') ----- - versionNamesForPackageNamed: aString - ^ Array streamContents: - [ : stream | self root keysDo: - [ : each | each versionName packageName = aString ifTrue: [ stream nextPut: each ] ] ]! Item was removed: - ----- Method: MCGOODSRepository>>versionWithInfo:ifAbsent: (in category 'versions') ----- - versionWithInfo: aVersionInfo ifAbsent: errorBlock - ^ self root at: aVersionInfo ifAbsent: errorBlock! Item was removed: - MCFileBasedRepository subclass: #MCHttpRepository - instanceVariableNames: 'location user password readerCache indexed webClient' - classVariableNames: 'URLRewriteRules UseSharedWebClientInstance' - poolDictionaries: '' - category: 'Monticello-Repositories'! Item was removed: - ----- Method: MCHttpRepository class>>cleanUp: (in category 'class initialization') ----- - cleanUp: aggressive - - aggressive ifTrue: [ self clearCredentials ]! Item was removed: - ----- Method: MCHttpRepository class>>clearCredentials (in category 'class initialization') ----- - clearCredentials - self allSubInstancesDo: [ : each | each clearCredentials ]! Item was removed: - ----- Method: MCHttpRepository class>>creationTemplate (in category 'ui-support') ----- - creationTemplate - ^self creationTemplateLocation: 'https://www.squeaksource.com/ProjectName' - user: 'squeak' - password: 'squeak' - ! Item was removed: - ----- Method: MCHttpRepository class>>creationTemplateLocation:user:password: (in category 'ui-support') ----- - creationTemplateLocation: location user: user password: password - ^ - 'MCHttpRepository - location: {1} - user: {2} - password: {3}' format: {location printString. user printString. password printString}! Item was removed: - ----- Method: MCHttpRepository class>>description (in category 'ui-support') ----- - description - ^ 'HTTP'! Item was removed: - ----- Method: MCHttpRepository class>>fillInTheBlankRequest (in category 'ui-support') ----- - fillInTheBlankRequest - ^ 'HTTP Repository:' - ! Item was removed: - ----- Method: MCHttpRepository class>>inbox (in category 'well-known repositories') ----- - inbox - ^ MCRepositoryGroup default repositories - detect: - [ : each | each isInbox ] - ifNone: - [ MCHttpRepository - location: MCHttpRepository inboxUrlString - user: 'squeak' - password: 'squeak' ]! Item was removed: - ----- Method: MCHttpRepository class>>inboxUrlString (in category 'accessing') ----- - inboxUrlString - ^ 'https://source.squeak.org/inbox'! Item was removed: - ----- Method: MCHttpRepository class>>location:user:password: (in category 'ui-support') ----- - location: location user: user password: password - ^ self new - location: location; - user: user; - password: password! Item was removed: - ----- Method: MCHttpRepository class>>morphicConfigure (in category 'ui-support') ----- - morphicConfigure - ^ self fillInTheBlankConfigure! Item was removed: - ----- Method: MCHttpRepository class>>rewriteUrl:forDownload: (in category 'url rewrite') ----- - rewriteUrl: aString forDownload: forDownload - - | result | - result := aString. - self urlRewriteRules groupsDo: [ :regexString :replacement :downloadOnly | - (forDownload or: [ downloadOnly not ]) ifTrue: [ - result := result copyWithRegex: regexString matchesReplacedWith: replacement ] ]. - ^result - - " - self assert: 'https://squeaksource.com/foo/bar?baz=1' = (self rewriteUrl: 'http://squeaksource.com/foo/bar?baz=1' forDownload: true). - self assert: 'https://squeaksource.com/foo/bar?baz=1' = (self rewriteUrl: 'https://squeaksource.com/foo/bar?baz=1' forDownload: true). - self assert: 'https://source.squeak.org/foo/bar?baz=1' = (self rewriteUrl: 'http://source.squeak.org/foo/bar?baz=1' forDownload: true). - self assert: 'https://source.squeak.org/foo/bar?baz=1' = (self rewriteUrl: 'https://source.squeak.org/foo/bar?baz=1' forDownload: true). - self assert: 'http://static.smalltalkhub.com/foo/bar?baz=1' = (self rewriteUrl: 'http://smalltalkhub.com/foo/bar?baz=1' forDownload: true). - self assert: 'http://smalltalkhub.com/foo/bar?baz=1' = (self rewriteUrl: 'http://smalltalkhub.com/foo/bar?baz=1' forDownload: false). - "! Item was removed: - ----- Method: MCHttpRepository class>>treated (in category 'well-known repositories') ----- - treated - ^ MCRepositoryGroup default repositories - detect: - [ : each | each isTreated ] - ifNone: - [ MCHttpRepository - location: MCHttpRepository treatedUrlString - user: 'squeak' - password: 'squeak' ]! Item was removed: - ----- Method: MCHttpRepository class>>treatedUrlString (in category 'accessing') ----- - treatedUrlString - ^ 'https://source.squeak.org/treated'! Item was removed: - ----- Method: MCHttpRepository class>>trunk (in category 'well-known repositories') ----- - trunk - ^ MCRepositoryGroup default repositories - detect: - [ : each | each isTrunk ] - ifNone: - [ MCHttpRepository - location: MCHttpRepository trunkUrlString - user: 'squeak' - password: 'squeak' ]! Item was removed: - ----- Method: MCHttpRepository class>>trunkUrlString (in category 'accessing') ----- - trunkUrlString - ^ 'https://source.squeak.org/trunk'! Item was removed: - ----- Method: MCHttpRepository class>>urlRewriteRules (in category 'url rewrite') ----- - urlRewriteRules - - ^URLRewriteRules ifNil: [ - URLRewriteRules := #( - "Regex to be replaced" "static replacement string" "download only" - '^http\://source\.squeak\.org/' 'https://source.squeak.org/' false - '^http\://squeaksource\.com/' 'https://squeaksource.com/' false - '^http\://www.squeaksource\.com/' 'https://www.squeaksource.com/' false - '^http\://smalltalkhub.com/' 'http://static.smalltalkhub.com/' true - ) asOrderedCollection ]! Item was removed: - ----- Method: MCHttpRepository class>>useSharedWebClientInstance (in category 'preferences') ----- - useSharedWebClientInstance - - <preference: 'Use shared WebClient instance' - category: 'Monticello' - description: 'When true, use a shared WebClient instance to speed up downloads from MCHttpRepositories. Requires WebClient to be present.' - type: #Boolean> - ^UseSharedWebClientInstance ifNil: [ - "There is some issue on Windows and Macos, so don't use it there by default. See http://lists.squeakfoundation.org/pipermail/squeak-dev/2019-September/thread.html#203921 for details." - Smalltalk os platformName ~= 'Win32' and: [Smalltalk os platformName ~= 'Mac OS']]! Item was removed: - ----- Method: MCHttpRepository class>>useSharedWebClientInstance: (in category 'preferences') ----- - useSharedWebClientInstance: aBoolean - - UseSharedWebClientInstance := aBoolean! Item was removed: - ----- Method: MCHttpRepository>>allFileNames (in category 'private-files') ----- - 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 removed: - ----- Method: MCHttpRepository>>asCreationTemplate (in category 'accessing') ----- - asCreationTemplate - ^self class creationTemplateLocation: location user: user password: password! Item was removed: - ----- Method: MCHttpRepository>>clearCredentials (in category 'accessing') ----- - clearCredentials - user beWritableObject. - user ifNotNil: [user atAllPut: $x]. - password beWritableObject. - password ifNotNil: [password atAllPut: $x]. - user := password := String empty! Item was removed: - ----- Method: MCHttpRepository>>creationTemplate (in category 'accessing') ----- - creationTemplate - ^ self asCreationTemplate! Item was removed: - ----- Method: MCHttpRepository>>creationTemplate: (in category 'accessing') ----- - creationTemplate: aString - creationTemplate := nil.! Item was removed: - ----- Method: MCHttpRepository>>description (in category 'user interface') ----- - description - ^ location! Item was removed: - ----- Method: MCHttpRepository>>displayProgress:during: (in category 'private') ----- - displayProgress: label during: workBlock - | nextUpdateTime | - nextUpdateTime := 0. - ^label displayProgressFrom: 0.0 to: 1.0 during:[:bar| - bar value: 0.0. - workBlock on: HTTPProgress do:[:ex| - (ex total == nil or:[ex amount == nil]) ifFalse:[ - (nextUpdateTime < Time millisecondClockValue - or:[ex total = ex amount]) ifTrue:[ - bar value: ex amount asFloat / ex total asFloat. - nextUpdateTime := Time millisecondClockValue + 100. - ]. - ]. - ex resume. - ] - ]. - ! Item was removed: - ----- Method: MCHttpRepository>>flushCache (in category 'private') ----- - flushCache - super flushCache. - readerCache := nil.! Item was removed: - ----- Method: MCHttpRepository>>httpGet:arguments: (in category 'private') ----- - httpGet: url arguments: arguments - - | urlString | - urlString := arguments - ifNil: [ url ] - ifNotNil: [ - | queryString | - queryString := WebUtils encodeUrlEncodedForm: arguments. - (url includes: $?) - ifTrue: [ url, '&', queryString ] - ifFalse: [ url, '?', queryString ] ]. - urlString := self class rewriteUrl: urlString forDownload: true. - ^self webClientDo: [ :client | - client - username: self user; - password: self password; - httpGet: urlString do: [ :request | - request - headerAt: 'Authorization' put: 'Basic ', (self user, ':', self password) base64Encoded; - headerAt: 'Connection' put: 'Keep-Alive'; - headerAt: 'Accept' put: '*/*' ] ]! Item was removed: - ----- Method: MCHttpRepository>>httpGet:for: (in category 'private') ----- - httpGet: actionString for: aMCDefinition - ^ HTTPSocket - httpGet: self locationWithTrailingSlash - args: - { 'action'->{actionString}. - 'mc-definition'-> {self serializeForRequest: aMCDefinition}} - user: self user - passwd: self password! Item was removed: - ----- Method: MCHttpRepository>>isInbox (in category 'testing') ----- - isInbox - ^ location = self class inboxUrlString! Item was removed: - ----- Method: MCHttpRepository>>isIndexed (in category 'private') ----- - isIndexed - ^ indexed ifNil: - [indexed := [(HTTPSocket - httpGet: self locationWithTrailingSlash - args: {'query' -> {'isHistorySupported'}} - user: self user - passwd: self password) contents = 'true'] - on: Error - do: - [:err | false]]! Item was removed: - ----- Method: MCHttpRepository>>isTreated (in category 'testing') ----- - isTreated - ^ location = self class treatedUrlString! Item was removed: - ----- Method: MCHttpRepository>>isTrunk (in category 'testing') ----- - isTrunk - ^ location = self class trunkUrlString! Item was removed: - ----- Method: MCHttpRepository>>location: (in category 'accessing') ----- - location: aUrlString - location = aUrlString ifFalse: [ self flushCache ]. - location := aUrlString! Item was removed: - ----- Method: MCHttpRepository>>locationWithTrailingSlash (in category 'accessing') ----- - locationWithTrailingSlash - ^ (location endsWith: '/') - ifTrue: [location] - ifFalse: [location, '/']! Item was removed: - ----- Method: MCHttpRepository>>mcModel (in category '*monticello') ----- - mcModel - "Answer the object which can respond to #historyOf: and #originOf: or nil, if none." - ^ self isIndexed ifTrue: [self]! Item was removed: - ----- Method: MCHttpRepository>>originOf: (in category 'accessing') ----- - originOf: aMCDefinition - | reply | - reply := self - httpGet: 'origin' - for: aMCDefinition. - ^ reply isString - ifTrue: - [ Warning signal: 'Origin request failed. Server ''reply'' in debugger.'. - Array empty ] - ifFalse: [ (ReferenceStream on: reply) next ]! Item was removed: - ----- Method: MCHttpRepository>>parseFileNamesFromStream: (in category 'private') ----- - parseFileNamesFromStream: aStream - | names fullName | - names := OrderedCollection new. - [aStream atEnd] whileFalse: - [[aStream upTo: $<. {$a. $A. nil} includes: aStream next] whileFalse. - aStream upTo: $". - aStream atEnd ifFalse: [ - fullName := aStream upTo: $". - names add: fullName unescapePercents asMCVersionName ]]. - ^ names! Item was removed: - ----- Method: MCHttpRepository>>password (in category 'accessing') ----- - password - self userAndPasswordFromSettingsDo: [:usr :pwd | ^pwd]. - - self user isEmpty ifTrue: [^password ifNil: ['']]. - - password isEmptyOrNil ifTrue: [ - | answer | - "Give the user a chance to change the login" - answer := UIManager default 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! Item was removed: - ----- Method: MCHttpRepository>>password: (in category 'accessing') ----- - password: passwordString - password := passwordString! Item was removed: - ----- Method: MCHttpRepository>>postCopy (in category 'copying') ----- - postCopy - super postCopy. - readerCache := readerCache copy! Item was removed: - ----- Method: MCHttpRepository>>readStreamForFileNamed:do: (in category 'private') ----- - readStreamForFileNamed: aString do: aBlock - - | contents attempts| - attempts := 0. - self displayProgress: 'Downloading ', aString during: [ - [attempts := attempts + 1. - contents := self httpGet: (self urlForFileNamed: aString) arguments: nil] on: NetworkError do: [:ex| - attempts >= 3 ifTrue:[ex pass]. - ex retry ]]. - ^contents ifNotNil: [ aBlock value: contents ]! Item was removed: - ----- Method: MCHttpRepository>>refresh (in category 'accessing') ----- - refresh - super refresh. - indexed := nil! Item was removed: - ----- Method: MCHttpRepository>>revisionsOf: (in category 'accessing') ----- - revisionsOf: aMCDefinition - | reply | - reply := self - httpGet: 'history' - for: aMCDefinition. - ^ reply isString - ifTrue: - [ Warning signal: 'Revisions request failed. Server ''reply'' in debugger.'. - Array empty ] - ifFalse: [ (ReferenceStream on: reply) next ]! Item was removed: - ----- Method: MCHttpRepository>>serializeForRequest: (in category 'private') ----- - serializeForRequest: aMCDefinition - ^ ((ReferenceStream on: (RWBinaryOrTextStream on: ByteArray new)) - nextPut: aMCDefinition ; - yourself) contents asString encodeForHTTP! Item was removed: - ----- Method: MCHttpRepository>>urlForFileNamed: (in category 'accessing') ----- - urlForFileNamed: aString - ^ self locationWithTrailingSlash, aString encodeForHTTP! Item was removed: - ----- Method: MCHttpRepository>>user (in category 'accessing') ----- - user - self userAndPasswordFromSettingsDo: [:usr :pwd | ^usr]. - "not in settings" - ^user ifNil: ['']! Item was removed: - ----- Method: MCHttpRepository>>user: (in category 'accessing') ----- - user: userString - user := userString! Item was removed: - ----- Method: MCHttpRepository>>userAndPasswordFromSettingsDo: (in category 'private') ----- - userAndPasswordFromSettingsDo: aBlock - "The mcSettings file in ExternalSettings preferenceDirectory should contain entries for each account: - - account1: *myhost.mydomain* user:password - account2: *otherhost.mydomain/somerep* dXNlcjpwYXNzd29yZA== - - That is it must start with 'account', followed by anything to distinguish accounts, and a colon. Then comes a match expression for the repository url, and after a space the user:password string. - - To not have the clear text password on your disc, you can base64 encode it: - (Base64MimeConverter mimeEncode: 'user:password' readStream) contents - " - - - Settings ifNotNil: [ - Settings keysAndValuesDo: [:key :value | | userAndPassword entry | - (key asLowercase beginsWith: 'account') ifTrue: [ - entry := value findTokens: ' '. - (entry first match: location) ifTrue: [ - userAndPassword := entry second. - (userAndPassword includes: $:) ifFalse: [ - userAndPassword := (Base64MimeConverter mimeDecodeToChars: userAndPassword readStream) contents]. - userAndPassword := userAndPassword findTokens: $:. - ^aBlock value: userAndPassword first - value: userAndPassword second - ] - ] - ] - ]. - ^nil! Item was removed: - ----- Method: MCHttpRepository>>versionReaderForFileNamed: (in category 'accessing') ----- - versionReaderForFileNamed: aString - readerCache ifNil: [readerCache := Dictionary new]. - ^ readerCache at: aString ifAbsent: - [self resizeCache: readerCache. - super versionReaderForFileNamed: aString do: - [:r | - r ifNotNil: [readerCache at: aString put: r]]] - ! Item was removed: - ----- Method: MCHttpRepository>>versionReaderForFileNamed:do: (in category 'accessing') ----- - versionReaderForFileNamed: aString do: aBlock - ^ (self versionReaderForFileNamed: aString) ifNotNil: aBlock! Item was removed: - ----- Method: MCHttpRepository>>webClientDo: (in category 'private') ----- - webClientDo: aBlock - - | client attemptsLeft response result | - self class useSharedWebClientInstance ifTrue: [ - "Acquire webClient by atomically storing it in the client variable and setting its value to nil." - client := webClient. - webClient := nil ]. - - client - ifNil: [ client := WebClient new ] - ifNotNil: [ - "Attempt to avoid an error by recreating the underlying stream." - client isConnected ifFalse: [ client close ] ]. - - attemptsLeft := 3. - response := nil. - [ response isNil and: [ attemptsLeft > 0 ] ] whileTrue: [ - response := [ aBlock value: client ] - on: NetworkError - do: [ :error | - attemptsLeft = 0 ifTrue: [ error pass ]. - (3 - attemptsLeft) seconds asDelay wait. - attemptsLeft := attemptsLeft - 1. - nil "The response" ] ]. - - result := (response code between: 200 and: 299) - ifFalse: [ - response content. "Make sure content is read." - nil ] - ifTrue: [ - (RWBinaryOrTextStream with: ( - response contentWithProgress: [ :total :amount | - HTTPProgress new - total: total; - amount: amount; - signal ])) reset ]. - - self class useSharedWebClientInstance - ifTrue: [ - "Save the WebClient instance for reuse, but only if there is no client cached." - webClient - ifNil: [ webClient := client ] - ifNotNil: [ client close ] ] - ifFalse: [ client close ]. - - (response code = 404 "Not Found" or: [response code = 410 "Gone"]) ifTrue: [ - "Need to distinguish between lookup errors and connection errors. Lookup errors will be handled by some senders following the EAFP principle. See #versionNamed:." - (NotFound object: response url) signal ]. - result ifNil: [ NetworkError signal: 'Could not access ', location ]. - ^result! Item was removed: - ----- Method: MCHttpRepository>>writeStreamForFileNamed:replace:do: (in category 'private') ----- - writeStreamForFileNamed: aString replace: ignoreBoolean do: aBlock - - | stream urlString | - stream := RWBinaryOrTextStream on: String new. - aBlock value: stream. - urlString := self urlForFileNamed: aString. - urlString := self class rewriteUrl: urlString forDownload: false. - ^self displayProgress: 'Uploading ', aString during: [ - self webClientDo: [ :client | - client - username: self user; - password: self password; - httpPut: urlString - content: stream contents - type: nil - do: [ :request | - request - headerAt: 'Authorization' put: 'Basic ', (self user, ':', self password) base64Encoded; - headerAt: 'Connection' put: 'Keep-Alive'; - headerAt: 'Accept' put: '*/*' ] ] ]! Item was removed: - ProtoObject subclass: #MCInfoProxy - instanceVariableNames: 'info repository workingCopy' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Repositories'! - - !MCInfoProxy commentStamp: 'cmm 8/12/2013 21:51' prior: 0! - A MCInfoProxy takes the place of a MCVersionInfo with a large tree of ancestors that consume memory in the image, but are almost never accessed. If they are, however, I will dynamically retrieve and become the Info from the original MC repository which includes the full ancestry tree.! Item was removed: - ----- Method: MCInfoProxy class>>info:workingCopy:repository: (in category 'instance creation') ----- - info: aMCVersionInfo workingCopy: aMCWorkingCopy repository: aMCRepository - ^ self new - setInfo: aMCVersionInfo - workingCopy: aMCWorkingCopy - repository: aMCRepository! Item was removed: - ----- Method: MCInfoProxy>>becomeAncestry (in category 'private') ----- - becomeAncestry - ^ self becomeForward: (MCProxyMaterialization signalMaterializing: self)! Item was removed: - ----- Method: MCInfoProxy>>doesNotUnderstand: (in category 'private') ----- - doesNotUnderstand: aMessage - ^ aMessage sendTo: self becomeAncestry! Item was removed: - ----- Method: MCInfoProxy>>isMCInfoProxy (in category 'testing') ----- - isMCInfoProxy - ^ true! Item was removed: - ----- Method: MCInfoProxy>>materializeInfo (in category 'private') ----- - materializeInfo - workingCopy ancestry breadthFirstAncestorsDo: - [ : each | (repository versionWithInfo: each) ifNotNil: - [ : ver | ^ ver info allAncestorsDo: - [ : eachAncestor | eachAncestor = info ifTrue: [ ^ eachAncestor ] ] ] ]. - nil error: 'Expected ' , info asString , ' to be an ancestor of one of ' , workingCopy ancestors asString! Item was removed: - ----- Method: MCInfoProxy>>setInfo:workingCopy:repository: (in category 'initialize-release') ----- - setInfo: aMCVersionInfo workingCopy: aMCWorkingCopy repository: aMCRepository - info := aMCVersionInfo. - workingCopy := aMCWorkingCopy. - repository := aMCRepository! Item was removed: - MCVariableDefinition subclass: #MCInstanceVariableDefinition - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Modeling'! Item was removed: - ----- Method: MCInstanceVariableDefinition class>>type (in category 'accessing') ----- - type - ^ #instance! Item was removed: - ----- Method: MCInstanceVariableDefinition>>isInstanceVariable (in category 'testing') ----- - isInstanceVariable - ^ true! Item was removed: - MCMczReader subclass: #MCMcdReader - instanceVariableNames: 'baseInfo patch' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Storing'! Item was removed: - ----- Method: MCMcdReader class>>extension (in category 'accessing') ----- - extension - ^ 'mcd'! Item was removed: - ----- Method: MCMcdReader>>baseInfo (in category 'accessing') ----- - baseInfo - ^ baseInfo ifNil: [self loadBaseInfo]! Item was removed: - ----- Method: MCMcdReader>>basicVersion (in category 'accessing') ----- - basicVersion - ^ MCDiffyVersion - package: self package - info: self info - dependencies: self dependencies - baseInfo: self baseInfo - patch: self patch! Item was removed: - ----- Method: MCMcdReader>>buildPatchFrom:to: (in category 'private-loading') ----- - buildPatchFrom: oldDefinitions to: newDefinitions - ^ MCPatch - fromBase: (MCSnapshot fromDefinitions: oldDefinitions) - target: (MCSnapshot fromDefinitions: newDefinitions)! Item was removed: - ----- Method: MCMcdReader>>loadBaseInfo (in category 'loading') ----- - loadBaseInfo - ^ baseInfo := self extractInfoFrom: (self parseMember: 'base')! Item was removed: - ----- Method: MCMcdReader>>loadPatch (in category 'loading') ----- - 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 removed: - ----- Method: MCMcdReader>>patch (in category 'accessing') ----- - patch - ^ patch ifNil: [self loadPatch]! Item was removed: - MCMczWriter subclass: #MCMcdWriter - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Storing'! Item was removed: - ----- Method: MCMcdWriter class>>readerClass (in category 'accessing') ----- - readerClass - ^ MCMcdReader! Item was removed: - ----- Method: MCMcdWriter>>writeBaseInfo: (in category 'visiting') ----- - writeBaseInfo: aVersionInfo - | string | - string := self serializeVersionInfo: aVersionInfo. - self addString: string at: 'base' encodedTo: 'utf8'. - ! Item was removed: - ----- Method: MCMcdWriter>>writeDefinitions: (in category 'visiting') ----- - writeDefinitions: aVersion - self writeBaseInfo: aVersion baseInfo. - self writePatch: aVersion patch.! Item was removed: - ----- Method: MCMcdWriter>>writeNewDefinitions: (in category 'visiting') ----- - writeNewDefinitions: aCollection - self addString: (self serializeDefinitions: aCollection) at: 'new/source.', self snapshotWriterClass extension encodedTo: 'utf8'.! Item was removed: - ----- Method: MCMcdWriter>>writeOldDefinitions: (in category 'visiting') ----- - writeOldDefinitions: aCollection - self addString: (self serializeDefinitions: aCollection) at: 'old/source.', self snapshotWriterClass extension encodedTo: 'utf8'.! Item was removed: - ----- Method: MCMcdWriter>>writePatch: (in category 'visiting') ----- - writePatch: aPatch - | old new | - old := OrderedCollection new. - new := OrderedCollection new. - aPatch operations do: - [ : ea | ea isRemoval ifTrue: [ old add: ea definition ]. - ea isAddition ifTrue: [ new add: ea definition ]. - ea isModification ifTrue: - [ old add: ea baseDefinition. - new add: ea definition ] ]. - (old isEmpty and: [ new isEmpty ]) ifTrue: [ MCEmptyDiffyVersion signal ]. - self - writeOldDefinitions: old ; - writeNewDefinitions: new ; - - addString: (self serializeInBinary: aPatch) - at: 'patch.bin'! Item was removed: - MCVersionReader subclass: #MCMczReader - instanceVariableNames: 'zip infoCache' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Storing'! Item was removed: - ----- Method: MCMczReader class>>extension (in category 'accessing') ----- - extension - ^ 'mcz'! Item was removed: - ----- Method: MCMczReader class>>supportsDependencies (in category 'testing') ----- - supportsDependencies - ^ true! Item was removed: - ----- Method: MCMczReader class>>supportsVersions (in category 'testing') ----- - supportsVersions - ^ true! Item was removed: - ----- Method: MCMczReader>>associate: (in category 'utilities') ----- - 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 removed: - ----- Method: MCMczReader>>contentsForMember: (in category 'private') ----- - contentsForMember: member - ^[(member contentStreamFromEncoding: 'utf8') text contents] on: InvalidUTF8 - do: [:exc | - "Case of legacy encoding, presumably it is latin-1. - But if contents starts with a null character, it might be a case of WideString encoded in UTF-32BE" - | str | - self flag: #discuss. "mt: Isn't our mac-roman legacy more likely than latin-1?" - str := (member contentStreamFromEncoding: 'latin1') text. - exc return: ((str peek = Character null and: [ str size \\ 4 = 0 ]) - ifTrue: [WideString fromByteArray: str contents asByteArray] - ifFalse: [str contents])]! Item was removed: - ----- Method: MCMczReader>>extractDefinitionsFrom: (in category 'private-loading') ----- - extractDefinitionsFrom: member - | reader | - (MCSnapshotReader readerClassForFileNamed: member fileName) - ifNotNil: [:rc | - reader := rc on: (self contentsForMember: member) readStream. - definitions addAll: reader definitions] - ! Item was removed: - ----- Method: MCMczReader>>extractDependencyFrom: (in category 'private-loading') ----- - extractDependencyFrom: zipMember - ^ MCVersionDependency - package: (MCPackage named: (zipMember fileName copyAfterLast: $/)) - info: (self extractInfoFrom: (self parseMember: zipMember))! Item was removed: - ----- Method: MCMczReader>>extractInfoFrom: (in category 'private-loading') ----- - extractInfoFrom: dict - ^MCWorkingCopy infoFromDictionary: dict cache: self infoCache! Item was removed: - ----- Method: MCMczReader>>infoCache (in category 'accessing') ----- - infoCache - ^ infoCache ifNil: [infoCache := Dictionary new]! Item was removed: - ----- Method: MCMczReader>>loadDefinitions (in category 'loading') ----- - loadDefinitions - definitions := OrderedCollection new. - (self zip memberNamed: 'snapshot.bin') ifNotNil: - [:m | [^ definitions := (DataStream on: m contentStream) next definitions] - on: Error do: [:fallThrough| ]]. - "otherwise" - (self zip membersMatching: 'snapshot/*') - do: [:m | self extractDefinitionsFrom: m]. - ! Item was removed: - ----- Method: MCMczReader>>loadDependencies (in category 'loading') ----- - loadDependencies - dependencies := (self zip membersMatching: 'dependencies/*') collect: [:m | self extractDependencyFrom: m]. - dependencies := dependencies asArray. - ! Item was removed: - ----- Method: MCMczReader>>loadPackage (in category 'loading') ----- - loadPackage - | dict | - dict := self parseMember: 'package'. - package := MCPackage named: (dict at: #name)! Item was removed: - ----- Method: MCMczReader>>loadVersionInfo (in category 'loading') ----- - loadVersionInfo - info := self extractInfoFrom: (self parseMember: 'version')! Item was removed: - ----- Method: MCMczReader>>parseMember: (in category 'utilities') ----- - 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 removed: - ----- Method: MCMczReader>>scanner (in category 'constants') ----- - scanner - ^ MCScanner! Item was removed: - ----- Method: MCMczReader>>zip (in category 'accessing') ----- - zip - zip ifNil: - [zip := ZipArchive new. - zip readFrom: stream]. - ^ zip! Item was removed: - MCWriter subclass: #MCMczWriter - instanceVariableNames: 'zip infoWriter' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Storing'! Item was removed: - ----- Method: MCMczWriter class>>fileOut:on: (in category 'fileIn/out') ----- - fileOut: aVersion on: aStream - | inst | - inst := self on: aStream. - inst writeVersion: aVersion. - inst flush. - - ! Item was removed: - ----- Method: MCMczWriter class>>new (in category 'instance creation') ----- - new - ^ self basicNew initialize! Item was removed: - ----- Method: MCMczWriter class>>readerClass (in category 'accessing') ----- - readerClass - ^ MCMczReader! Item was removed: - ----- Method: MCMczWriter>>addString:at: (in category 'writing') ----- - addString: string at: path - | member | - member := zip addString: string as: path. - member desiredCompressionMethod: ZipArchive compressionDeflated - ! Item was removed: - ----- Method: MCMczWriter>>addString:at:encodedTo: (in category 'writing') ----- - addString: string at: path encodedTo: encodingName - | member | - member := zip addString: (string convertToEncoding: encodingName) as: path. - member desiredCompressionMethod: ZipArchive compressionDeflated - ! Item was removed: - ----- Method: MCMczWriter>>flush (in category 'writing') ----- - flush - zip writeTo: stream. - stream close! Item was removed: - ----- Method: MCMczWriter>>format (in category 'accessing') ----- - format - ^ '1'! Item was removed: - ----- Method: MCMczWriter>>initialize (in category 'initializing') ----- - initialize - zip := ZipArchive new. - ! Item was removed: - ----- Method: MCMczWriter>>serializeDefinitions: (in category 'serializing') ----- - serializeDefinitions: aCollection - ^String streamContents: [:aStream | - | writer | - writer := self snapshotWriterClass on: aStream. - writer writeDefinitions: aCollection]! Item was removed: - ----- Method: MCMczWriter>>serializeInBinary: (in category 'serializing') ----- - serializeInBinary: aSnapshot - | writer s | - s := RWBinaryOrTextStream on: String new. - writer := DataStream on: s. - writer nextPut: aSnapshot. - ^ s contents! Item was removed: - ----- Method: MCMczWriter>>serializePackage: (in category 'serializing') ----- - serializePackage: aPackage - ^ '(name ''', aPackage name, ''')'! Item was removed: - ----- Method: MCMczWriter>>serializeVersionInfo: (in category 'serializing') ----- - serializeVersionInfo: aVersionInfo - infoWriter ifNil: [infoWriter := MCVersionInfoWriter new]. - ^ String streamContents: - [:s | - infoWriter stream: s. - infoWriter writeVersionInfo: aVersionInfo]! Item was removed: - ----- Method: MCMczWriter>>snapshotWriterClass (in category 'accessing') ----- - snapshotWriterClass - ^ MCStWriter! Item was removed: - ----- Method: MCMczWriter>>writeDefinitions: (in category 'visiting') ----- - writeDefinitions: aVersion - self writeSnapshot: aVersion snapshot! Item was removed: - ----- Method: MCMczWriter>>writeFormat (in category 'visiting') ----- - writeFormat - " self addString: self format at: 'format'."! Item was removed: - ----- Method: MCMczWriter>>writePackage: (in category 'visiting') ----- - writePackage: aPackage - self addString: (self serializePackage: aPackage) at: 'package' encodedTo: 'utf8'! Item was removed: - ----- Method: MCMczWriter>>writeSnapshot: (in category 'visiting') ----- - writeSnapshot: aSnapshot - aSnapshot definitions ifEmpty: [ MCEmptyVersion signal ]. - self - - addString: (self serializeDefinitions: aSnapshot definitions) - at: 'snapshot/source.' , self snapshotWriterClass extension - encodedTo: 'utf8' ; - - addString: (self serializeInBinary: aSnapshot) - at: 'snapshot.bin'! Item was removed: - ----- Method: MCMczWriter>>writeVersion: (in category 'visiting') ----- - writeVersion: aVersion - self writeFormat. - self writePackage: aVersion package. - self writeVersionInfo: aVersion info. - self writeDefinitions: aVersion. - aVersion dependencies do: [:ea | self writeVersionDependency: ea]! Item was removed: - ----- Method: MCMczWriter>>writeVersionDependency: (in category 'visiting') ----- - writeVersionDependency: aVersionDependency - | string | - string := (self serializeVersionInfo: aVersionDependency versionInfo). - self addString: string at: 'dependencies/', aVersionDependency package name encodedTo: 'utf8'! Item was removed: - ----- Method: MCMczWriter>>writeVersionInfo: (in category 'visiting') ----- - writeVersionInfo: aVersionInfo - | string | - string := self serializeVersionInfo: aVersionInfo. - self addString: string at: 'version' encodedTo: 'utf8'. - ! Item was removed: - ----- Method: MCMczWriter>>zip (in category 'accessing') ----- - zip - ^ zip! Item was removed: - Object subclass: #MCMenuSpec - instanceVariableNames: 'entry target selector' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-UI'! - - !MCMenuSpec commentStamp: 'tfel 6/12/2010 14:57' prior: 0! - A MCMenuSpec holds information to add menu entries to the monticello browser menus from external classes. - Required is the entry string (#entry), the call target and the selector be called. - An external class may use the MCWorkingCopyBrowser class>>addMenuSpec: method to add it's own menu entry to the monticello browser context menu. - - Note that MCMenuSpecs are compared via their menu entry string and if multiple MCMenuSpecs are added to the MCWorkingCopyBrowser, the last one takes precedence.! Item was removed: - ----- Method: MCMenuSpec>>= (in category 'comparing') ----- - = aMCMenuSpec - - ^ self class == aMCMenuSpec class and: [self entry = aMCMenuSpec entry].! Item was removed: - ----- Method: MCMenuSpec>>entry (in category 'accessing') ----- - entry - - ^entry! Item was removed: - ----- Method: MCMenuSpec>>entry: (in category 'accessing') ----- - entry: anObject - - entry := anObject! Item was removed: - ----- Method: MCMenuSpec>>hash (in category 'comparing') ----- - hash - - ^ self entry hash! Item was removed: - ----- Method: MCMenuSpec>>selector (in category 'accessing') ----- - selector - - ^selector! Item was removed: - ----- Method: MCMenuSpec>>selector: (in category 'accessing') ----- - selector: anObject - - selector := anObject! Item was removed: - ----- Method: MCMenuSpec>>target (in category 'accessing') ----- - target - - ^target! Item was removed: - ----- Method: MCMenuSpec>>target: (in category 'accessing') ----- - target: anObject - - target := anObject! Item was removed: - MCOperationsBrowser subclass: #MCMergeBrowser - instanceVariableNames: 'conflicts merger ok' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-UI'! Item was removed: - ----- Method: MCMergeBrowser class>>resolveConflictsInMerger: (in category 'instance creation') ----- - resolveConflictsInMerger: aMerger - | inst | - inst := self new merger: aMerger. - ^ inst showModally ifNil: [false]! Item was removed: - ----- Method: MCMergeBrowser>>buttonSpecs (in category 'ui') ----- - buttonSpecs - - ^ #( - ((button: (Merge merge 'Proceed with the merge' canMerge))) - ((button: (Cancel cancel 'Cancel the merge'))) - ((button: ('All Newer' chooseAllNewerConflicts 'Choose all newer conflict versions'))) - ((button: ('All Older' chooseAllOlderConflicts 'Choose all older conflict versions'))) - ((button: ('Rest Reject' chooseAllUnchosenLocal 'Choose local versions of all remaining conflicts'))) - ((button: ('Rest Accept' chooseAllUnchosenRemote 'Choose remote versions of all remaining conflicts'))) - ((button: ('Accept same source' chooseAllSameAST 'Choose all local conflicting versions that have essentially the same code'))) - )! Item was removed: - ----- Method: MCMergeBrowser>>canMerge (in category 'testing') ----- - canMerge - ^ merger isMerged! Item was removed: - ----- Method: MCMergeBrowser>>cancel (in category 'actions') ----- - cancel - - self wasInterrupted - ifTrue: [self close] - ifFalse: [self answer: false].! Item was removed: - ----- Method: MCMergeBrowser>>chooseAllNewerConflicts (in category 'actions') ----- - chooseAllNewerConflicts - conflicts do: [ :ea | ea chooseNewer ]. - self changed: #text; changed: #list; changed: #canMerge.! Item was removed: - ----- Method: MCMergeBrowser>>chooseAllOlderConflicts (in category 'actions') ----- - chooseAllOlderConflicts - conflicts do: [ :ea | ea chooseOlder ]. - self changed: #text; changed: #list; changed: #canMerge.! Item was removed: - ----- Method: MCMergeBrowser>>chooseAllSameAST (in category 'actions') ----- - chooseAllSameAST - conflicts do: [ :ea | - ea chooseSameAST ]. - self changed: #text; changed: #list; changed: #canMerge.! Item was removed: - ----- Method: MCMergeBrowser>>chooseAllUnchosenLocal (in category 'actions') ----- - chooseAllUnchosenLocal - conflicts do: [ :ea | ea isResolved ifFalse: [ ea chooseLocal ] ]. - self changed: #text; changed: #list; changed: #canMerge.! Item was removed: - ----- Method: MCMergeBrowser>>chooseAllUnchosenRemote (in category 'actions') ----- - chooseAllUnchosenRemote - conflicts do: [ :ea | ea isResolved ifFalse: [ ea chooseRemote ] ]. - self changed: #text; changed: #list; changed: #canMerge.! Item was removed: - ----- Method: MCMergeBrowser>>chooseLocal (in category 'actions') ----- - chooseLocal - self conflictSelectionDo: - [selection chooseLocal. - self changed: #text; changed: #list; changed: #canMerge]. - self selectNextUnresolvedConflict! Item was removed: - ----- Method: MCMergeBrowser>>chooseRemote (in category 'actions') ----- - chooseRemote - self conflictSelectionDo: - [selection chooseRemote. - self changed: #text; changed: #list; changed: #canMerge]. - self selectNextUnresolvedConflict! Item was removed: - ----- Method: MCMergeBrowser>>clearChoice (in category 'actions') ----- - clearChoice - self conflictSelectionDo: - [selection clearChoice. - self changed: #text; changed: #list; changed: #canMerge]! Item was removed: - ----- Method: MCMergeBrowser>>conflictSelectionDo: (in category 'private-actions') ----- - conflictSelectionDo: aBlock - self selectionIsConflicted - ifTrue: aBlock! Item was removed: - ----- Method: MCMergeBrowser>>defaultLabel (in category 'ui') ----- - defaultLabel - ^ 'Merge Browser'! Item was removed: - ----- Method: MCMergeBrowser>>getConflictMenu: (in category 'menus') ----- - 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 removed: - ----- Method: MCMergeBrowser>>getMenu: (in category 'morphic ui') ----- - getMenu: aMenu - selection ifNil: [^ aMenu]. - ^ self selectionIsConflicted - ifTrue: [self getConflictMenu: aMenu] - ifFalse: [self getOperationMenu: aMenu]! Item was removed: - ----- Method: MCMergeBrowser>>getOperationMenu: (in category 'menus') ----- - getOperationMenu: aMenu - ^ aMenu! Item was removed: - ----- Method: MCMergeBrowser>>innerButtonSpecs (in category 'ui') ----- - innerButtonSpecs - - ^ #( - ((button: (Accept chooseRemote 'Accept the selected incoming change. Overwrites local code.' ))) - ((button: (Reject chooseLocal 'Reject the selected incoming change. Retains local code.' ))) - )! Item was removed: - ----- Method: MCMergeBrowser>>items (in category 'accessing') ----- - items - ^ conflicts, super items! Item was removed: - ----- Method: MCMergeBrowser>>merge (in category 'actions') ----- - merge - merger isMerged - ifFalse: [self inform: 'You must resolve all the conflicts first'] - ifTrue: [self answer: true] ! Item was removed: - ----- Method: MCMergeBrowser>>merger: (in category 'accessing') ----- - merger: aMerger - merger := aMerger. - items := aMerger operations sorted. - conflicts := aMerger conflicts sort: [:a :b | a operation <= b operation].! Item was removed: - ----- Method: MCMergeBrowser>>methodListKey:from: (in category 'menus') ----- - methodListKey: aKeystroke from: aListMorph - aKeystroke caseOf: { - [$k] -> [self chooseRemote]. - [$r] -> [self chooseLocal]} - otherwise: [super methodListKey: aKeystroke from: aListMorph ]! Item was removed: - ----- Method: MCMergeBrowser>>panelSpecs (in category 'ui') ----- - panelSpecs - ^ #( - ((textMorph: annotations) (0 0 1 0) ( 0 0 0 defaultAnnotationPaneHeight )) - ((textMorph: text) (0 0 1 1) ( 0 defaultAnnotationPaneHeight 0 0 )) - )! Item was removed: - ----- Method: MCMergeBrowser>>selectNextUnresolvedConflict (in category 'actions') ----- - 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 removed: - ----- Method: MCMergeBrowser>>selectionIsConflicted (in category 'testing') ----- - selectionIsConflicted - ^ selection isKindOf: MCConflict! Item was removed: - ----- Method: MCMergeBrowser>>widgetSpecs (in category 'ui') ----- - 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 defaultButtonPaneHeightNegated)) - ((buttonRowFor: innerButtonSpecs) (0 0.4 1 0.4) (0 defaultButtonPaneHeightNegated 0 0)) - ((textMorph: text) (0 0.4 1 1) (0 0 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 defaultButtonPaneHeightNegated)) - ((buttonRowFor: innerButtonSpecs) - (0 0.4 1 0.4) (0 defaultButtonPaneHeightNegated 0 0)) - ((panel) - (0 0.4 1 1) (0 0 0 0)) - )! Item was removed: - Object subclass: #MCMergeRecord - instanceVariableNames: 'version packageSnapshot ancestorInfo ancestor ancestorSnapshot imagePatch mergePatch' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Versioning'! Item was removed: - ----- Method: MCMergeRecord class>>version: (in category 'instance creation') ----- - version: aVersion - ^ self basicNew initializeWithVersion: aVersion! Item was removed: - ----- Method: MCMergeRecord>>ancestorInfo (in category 'accessing') ----- - ancestorInfo - ^ ancestorInfo ifNil: [ancestorInfo := version info commonAncestorWith: version workingCopy ancestry]! Item was removed: - ----- Method: MCMergeRecord>>ancestorSnapshot (in category 'accessing') ----- - ancestorSnapshot - ^ ancestorSnapshot ifNil: [ancestorSnapshot := version workingCopy findSnapshotWithVersionInfo: self ancestorInfo]! Item was removed: - ----- Method: MCMergeRecord>>imageIsClean (in category 'testing') ----- - imageIsClean - | ancestors | - ancestors := version workingCopy ancestors. - ^ ancestors size = 1 - and: [ancestors first = self ancestorInfo - and: [self imagePatch isEmpty]]! Item was removed: - ----- Method: MCMergeRecord>>imagePatch (in category 'accessing') ----- - imagePatch - ^ imagePatch ifNil: [imagePatch := self packageSnapshot patchRelativeToBase: self ancestorSnapshot]! Item was removed: - ----- Method: MCMergeRecord>>initializeWithVersion: (in category 'initialize-release') ----- - initializeWithVersion: aVersion - version := aVersion! Item was removed: - ----- Method: MCMergeRecord>>isAncestorMerge (in category 'testing') ----- - isAncestorMerge - ^ version workingCopy ancestry hasAncestor: version info! Item was removed: - ----- Method: MCMergeRecord>>mergePatch (in category 'accessing') ----- - mergePatch - ^ mergePatch ifNil: [mergePatch := version snapshot patchRelativeToBase: self ancestorSnapshot]! Item was removed: - ----- Method: MCMergeRecord>>packageSnapshot (in category 'accessing') ----- - packageSnapshot - ^ packageSnapshot ifNil: [packageSnapshot := version package snapshot]! Item was removed: - ----- Method: MCMergeRecord>>updateWorkingCopy (in category 'operations') ----- - updateWorkingCopy - self isAncestorMerge ifFalse: - [self imageIsClean - ifTrue: [version workingCopy loaded: version] - ifFalse: [version workingCopy merged: version]]! Item was removed: - ----- Method: MCMergeRecord>>version (in category 'accessing') ----- - version - ^ version! Item was removed: - Notification subclass: #MCMergeResolutionRequest - instanceVariableNames: 'merger' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Versioning'! Item was removed: - ----- Method: MCMergeResolutionRequest>>defaultAction (in category 'handling') ----- - defaultAction - ^ (MCMergeBrowser new - merger: merger; - label: messageText) showModally! Item was removed: - ----- Method: MCMergeResolutionRequest>>merger (in category 'accessing') ----- - merger - ^ merger! Item was removed: - ----- Method: MCMergeResolutionRequest>>merger: (in category 'accessing') ----- - merger: aMerger - merger := aMerger! Item was removed: - Object subclass: #MCMerger - instanceVariableNames: 'conflicts' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Merging'! Item was removed: - ----- Method: MCMerger>>addConflictWithOperation: (in category 'accessing') ----- - addConflictWithOperation: anOperation - self conflicts add: (MCConflict operation: anOperation)! Item was removed: - ----- Method: MCMerger>>applyTo: (in category 'applying') ----- - applyTo: anObject - self isMerged ifFalse: [self error: 'You must resolve all the conflicts first']. - conflicts do: [:ea | ea applyTo: anObject]! Item was removed: - ----- Method: MCMerger>>conflicts (in category 'accessing') ----- - conflicts - ^ conflicts ifNil: [conflicts := OrderedCollection new]! Item was removed: - ----- Method: MCMerger>>isMerged (in category 'testing') ----- - isMerged - ^ self conflicts allSatisfy: [:ea | ea isResolved]! Item was removed: - ----- Method: MCMerger>>load (in category 'loading') ----- - load - | loader | - loader := MCPackageLoader new. - loader provisions addAll: self provisions. - self applyTo: loader. - loader load! Item was removed: - ----- Method: MCMerger>>loadWithNameLike: (in category 'loading') ----- - loadWithNameLike: baseName - | loader | - loader := MCPackageLoader new. - loader provisions addAll: self provisions. - self applyTo: loader. - loader loadWithNameLike: baseName! Item was removed: - ----- Method: MCMerger>>mergedSnapshot (in category 'accessing') ----- - mergedSnapshot - ^ MCPatcher apply: self to: self baseSnapshot! Item was removed: - ----- Method: MCMerger>>operations (in category 'accessing') ----- - operations - ^ #()! Item was removed: - ----- Method: MCMerger>>provisions (in category 'accessing') ----- - provisions - ^ #()! Item was removed: - MCDefinition subclass: #MCMethodDefinition - instanceVariableNames: 'classIsMeta source category selector className timeStamp' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Modeling'! - MCMethodDefinition class - instanceVariableNames: 'definitions'! - MCMethodDefinition class - instanceVariableNames: 'definitions'! Item was removed: - ----- Method: MCMethodDefinition class>>cachedDefinitions (in category 'accessing') ----- - cachedDefinitions - - ^definitions ifNil: [ definitions := WeakIdentityKeyDictionary new ]! Item was removed: - ----- Method: MCMethodDefinition class>>className:classIsMeta:selector:category:timeStamp:source: (in category 'create') ----- - className: classString - classIsMeta: metaBoolean - selector: selectorString - category: catString - timeStamp: timeString - source: sourceString - ^ self instanceLike: - (self new initializeWithClassName: classString - classIsMeta: metaBoolean - selector: selectorString - category: catString - timeStamp: timeString - source: sourceString)! Item was removed: - ----- Method: MCMethodDefinition class>>className:selector:category:timeStamp:source: (in category 'create') ----- - className: classString - selector: selectorString - category: catString - timeStamp: timeString - source: sourceString - ^ self className: classString - classIsMeta: false - selector: selectorString - category: catString - timeStamp: timeString - source: sourceString! Item was removed: - ----- Method: MCMethodDefinition class>>cleanUp (in category 'class initialization') ----- - cleanUp - "Flush caches" - - self shutDown.! Item was removed: - ----- Method: MCMethodDefinition class>>forMethodReference: (in category 'create') ----- - forMethodReference: aMethodReference - | definition | - definition := self cachedDefinitions at: aMethodReference compiledMethod ifAbsent: []. - (definition isNil - or: [definition selector ~= aMethodReference methodSymbol - or: [definition className ~= aMethodReference classSymbol - or: [definition classIsMeta ~= aMethodReference classIsMeta - or: [definition category ~= aMethodReference category]]]]) - ifTrue: [definition := self - className: aMethodReference classSymbol - classIsMeta: aMethodReference classIsMeta - selector: aMethodReference methodSymbol - category: aMethodReference category - timeStamp: aMethodReference timeStamp - source: aMethodReference source. - self cachedDefinitions at: aMethodReference compiledMethod put: definition]. - ^ definition - ! Item was removed: - ----- Method: MCMethodDefinition class>>initialize (in category 'class initialization') ----- - initialize - Smalltalk addToShutDownList: self! Item was removed: - ----- Method: MCMethodDefinition class>>shutDown (in category 'class initialization') ----- - shutDown - - definitions := nil.! Item was removed: - ----- Method: MCMethodDefinition>>= (in category 'comparing') ----- - = aDefinition - ^(super = aDefinition) - and: [aDefinition source = self source - and: [aDefinition category = self category - and: [aDefinition timeStamp = self timeStamp]]]! Item was removed: - ----- Method: MCMethodDefinition>>accept: (in category 'visiting') ----- - accept: aVisitor - ^ aVisitor visitMethodDefinition: self! Item was removed: - ----- Method: MCMethodDefinition>>actualClass (in category 'accessing') ----- - actualClass - ^ self actualClassIn: Environment current! Item was removed: - ----- Method: MCMethodDefinition>>actualClassIn: (in category 'accessing') ----- - actualClassIn: anEnvironment - ^ (anEnvironment at: className ifAbsent: [anEnvironment valueOf: className]) - ifNotNil: [:class | - class isBehavior ifTrue: [classIsMeta ifTrue: [class classSide] ifFalse: [class]]]! Item was removed: - ----- Method: MCMethodDefinition>>addMethodAdditionTo: (in category 'installing') ----- - addMethodAdditionTo: aCollection - aCollection - add: self asMethodAddition createCompiledMethod ; - yourself! Item was removed: - ----- Method: MCMethodDefinition>>asMethodAddition (in category 'converting') ----- - asMethodAddition - ^MethodAddition new - compile: source - classified: category - withStamp: timeStamp - notifying: nil - logSource: SystemChangeNotifier uniqueInstance isBroadcasting - inClass: self actualClass.! Item was removed: - ----- Method: MCMethodDefinition>>asMethodReference (in category 'converting') ----- - asMethodReference - ^ MethodReference - class: self actualClass - selector: self selector! Item was removed: - ----- Method: MCMethodDefinition>>category (in category 'accessing') ----- - category - ^ category! Item was removed: - ----- Method: MCMethodDefinition>>classIsMeta (in category 'accessing') ----- - classIsMeta - ^ classIsMeta! Item was removed: - ----- Method: MCMethodDefinition>>className (in category 'accessing') ----- - className - ^className! Item was removed: - ----- Method: MCMethodDefinition>>description (in category 'printing') ----- - description - - ^{ className. selector. classIsMeta }! Item was removed: - ----- Method: MCMethodDefinition>>fullClassName (in category 'printing') ----- - fullClassName - "Using #class selector for classes for backwards compatibility" - - ^ self classIsMeta - ifFalse: [self className] - ifTrue: [ - (self actualClass notNil and: [ self actualClass isTrait ]) - ifFalse: [self className, ' class'] - ifTrue: [self className, ' classSide']]! Item was removed: - ----- Method: MCMethodDefinition>>fullTimeStamp (in category 'accessing') ----- - fullTimeStamp - ^ [TimeStamp fromMethodTimeStamp: timeStamp] ifError: []! Item was removed: - ----- Method: MCMethodDefinition>>handlePackageRename:to: (in category 'renaming') ----- - handlePackageRename: oldPackageName to: newPackageName - "If I'm an extension or override method, rename the category to be prefixed with newPackageName." - ((self isExtensionMethod or: [ self isOverrideMethod ]) and: [ (self category allButFirst beginsWith: newPackageName asLowercase) not ]) ifTrue: - [ self actualClass organization - renameCategory: self category - toBe: - '*' , - (self - newCategoryNameFor: self category allButFirst - givenRenameFrom: oldPackageName - to: newPackageName) asLowercase ]! Item was removed: - ----- Method: MCMethodDefinition>>hash (in category 'comparing') ----- - hash - | hash | - hash := classIsMeta asString hashWithInitialHash: 0. - hash := source hashWithInitialHash: hash. - hash := category hashWithInitialHash: hash. - hash := className hashWithInitialHash: hash. - ^ hash! Item was removed: - ----- Method: MCMethodDefinition>>initializeWithClassName:classIsMeta:selector:category:timeStamp:source: (in category 'serializing') ----- - initializeWithClassName: classString - classIsMeta: metaBoolean - selector: selectorString - category: catString - timeStamp: timeString - source: sourceString - className := classString asSymbol. - selector := selectorString asSymbol. - category := catString ifNil: [Categorizer default] ifNotNil: [catString asSymbol]. - timeStamp := timeString. - classIsMeta := metaBoolean. - source := sourceString withSqueakLineEndings! Item was removed: - ----- Method: MCMethodDefinition>>isCodeDefinition (in category 'testing') ----- - isCodeDefinition - ^ true! Item was removed: - ----- Method: MCMethodDefinition>>isExtensionMethod (in category 'installing') ----- - isExtensionMethod - ^ category beginsWith: '*'! Item was removed: - ----- Method: MCMethodDefinition>>isExternalStructureFieldDefinition (in category 'testing') ----- - isExternalStructureFieldDefinition - ^ (selector = #fields or: [selector = #originalTypeName]) - and: [classIsMeta - and: [ - (Smalltalk at: #ExternalStructure ifPresent: [:externalStructure | - self actualClass theNonMetaClass inheritsFrom: externalStructure]) == true]] - - ! Item was removed: - ----- Method: MCMethodDefinition>>isInitializer (in category 'testing') ----- - isInitializer - ^ selector = #initialize and: [classIsMeta] - ! Item was removed: - ----- Method: MCMethodDefinition>>isMethodDefinition (in category 'testing') ----- - isMethodDefinition - ^true! Item was removed: - ----- Method: MCMethodDefinition>>isOverrideMethod (in category 'installing') ----- - isOverrideMethod - "this oughta check the package" - ^ self isExtensionMethod and: [category endsWith: '-override']! Item was removed: - ----- Method: MCMethodDefinition>>load (in category 'accessing') ----- - load - | class | - class := self actualClass. - class - compile: source - classified: category - withStamp: timeStamp - notifying: nil - logSource: (SystemChangeNotifier uniqueInstance isBroadcasting and: [class acceptsLoggingOfCompilation])! Item was removed: - ----- Method: MCMethodDefinition>>postload (in category 'installing') ----- - postload - self isInitializer - ifTrue: [self actualClass theNonMetaClass initialize]. - self isExternalStructureFieldDefinition - ifTrue: [self actualClass theNonMetaClass doneCompiling].! Item was removed: - ----- Method: MCMethodDefinition>>printAnnotations:on: (in category 'annotations') ----- - printAnnotations: requests on: aStream - "Add a string for an annotation pane, trying to fulfill the annotation requests. - These might include anything that - Preferences defaultAnnotationRequests - might return. Which includes anything in - Preferences annotationInfo - To edit these, use:" - "Preferences editAnnotations" - - | annotationSeparator annotations | - annotationSeparator := ' · '. "Same as in CodeHolder" - annotations := requests - collect: [:request | request - caseOf: { - [#timeStamp] -> [self timeStamp]. - [#author] -> [ - | initials | - initials := self timeStamp ifNotNil: [:timeStamp | - timeStamp findTokens ifNotEmpty: [:tokens | tokens first]]. - SystemNavigation authorsInverted - at: initials - ifPresent: [:fullNames | fullNames anyOne] - ifAbsent: ['unknown author' translated]]. - [#messageCategory] -> [self category]. - [#requirements] -> [self requirements joinSeparatedBy: Character space] } - otherwise: []] - thenSelect: [:annotation | annotation isEmptyOrNil not]. - - annotations - do: [:annotation | aStream nextPutAll: annotation] - separatedBy: [aStream nextPutAll: annotationSeparator].! Item was removed: - ----- Method: MCMethodDefinition>>protocol (in category 'accessing') ----- - protocol - "Answer in which protocol (conceptual groups of methods) the receiver is grouped into." - ^category! Item was removed: - ----- Method: MCMethodDefinition>>removeSelector:fromClass: (in category 'installing') ----- - removeSelector: aSelector fromClass: aClass - "Safely remove the given selector from the target class. - Be careful not to remove the selector when it has wondered - to another package." - | newCategory | - newCategory := aClass organization categoryOfElement: aSelector. - newCategory ifNotNil:[ - "If moved to and fro extension, ignore removal" - (category beginsWith: '*') = (newCategory beginsWith: '*') ifFalse:[^self]. - "Check if moved between different extension categories" - ((category beginsWith: '*') and:[category ~= newCategory]) ifTrue:[^self]]. - aClass removeSelector: aSelector. - ! Item was removed: - ----- Method: MCMethodDefinition>>requirements (in category 'comparing') ----- - requirements - ^{ className }! Item was removed: - ----- Method: MCMethodDefinition>>scanForPreviousVersions (in category 'installing') ----- - scanForPreviousVersions - "Answer change records for other versions of this method, i.e. other overrides and the original version" - | versions | - versions := OrderedCollection new. - PackageInfo default changeRecordsForMethod: self asMethodReference do: [:record | - record category = category ifFalse: [versions add: record]]. - ^versions - ! Item was removed: - ----- Method: MCMethodDefinition>>selector (in category 'accessing') ----- - selector - ^selector! Item was removed: - ----- Method: MCMethodDefinition>>sortKey (in category 'comparing') ----- - sortKey - ^ self className, '.', (self classIsMeta ifTrue: ['meta'] ifFalse: ['nonmeta']), '.', self selector! Item was removed: - ----- Method: MCMethodDefinition>>source (in category 'accessing') ----- - source - ^ source! Item was removed: - ----- Method: MCMethodDefinition>>summary (in category 'printing') ----- - summary - ^ self fullClassName , '>>' , selector! Item was removed: - ----- Method: MCMethodDefinition>>summaryAndRevision (in category 'printing') ----- - summaryAndRevision - ^String streamContents: - [:s | s nextPutAll: self timeStamp; - space; nextPutAll: self summary; - nextPutAll: ' {'; nextPutAll: self category; - nextPut: $}]! Item was removed: - ----- Method: MCMethodDefinition>>summarySuffixOver: (in category 'printing') ----- - summarySuffixOver: previousDefinition - | sourceChanged categoryChanged timeStampChanged | - sourceChanged := self source ~= previousDefinition source. - timeStampChanged := self timeStamp ~= previousDefinition timeStamp. - categoryChanged := self category ~= previousDefinition category. - sourceChanged | timeStampChanged | categoryChanged - ifFalse: [ ^super summarySuffixOver: previousDefinition ]. - sourceChanged ifTrue: [ - ^categoryChanged - ifTrue: [ ' (changed and recategorized)' ] - ifFalse: [ ' (changed)' ] ]. - timeStampChanged & categoryChanged - ifTrue: [^ ' (recategorized and different time stamp)' ]. - ^categoryChanged - ifTrue: [ ' (only recategorized)' ] - ifFalse: [ ' (only different time stamp)' ] - ! Item was removed: - ----- Method: MCMethodDefinition>>timeStamp (in category 'accessing') ----- - timeStamp - ^ timeStamp ifNil: ['']! Item was removed: - ----- Method: MCMethodDefinition>>unload (in category 'installing') ----- - unload - | previousVersions | - self isOverrideMethod ifTrue: [ - previousVersions := self scanForPreviousVersions]. - previousVersions isEmptyOrNil - ifTrue: [self actualClass ifNotNil: [:class | - self removeSelector: selector fromClass: class]] - ifFalse: [ - "remove our override from history, even if buried below other overrides" - previousVersions reverseDo: [:version | version fileIn]] ! Item was removed: - ----- Method: MCMethodDefinition>>workingCopy (in category 'accessing') ----- - workingCopy - "Answer the working copy of which this object is defined." - ^ self asMethodReference workingCopy! Item was removed: - MCPatchOperation subclass: #MCModification - instanceVariableNames: 'obsoletion modification' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Patching'! Item was removed: - ----- Method: MCModification class>>of:to: (in category 'instance creation') ----- - of: base to: target - ^ self new initializeWithBase: base target: target! Item was removed: - ----- Method: MCModification>>= (in category 'comparing') ----- - = other - ^other isMCPatchOperation - and: [other isModification - and: [obsoletion = other obsoletion - and: [modification = other modification]]]! Item was removed: - ----- Method: MCModification>>applyTo: (in category 'applying') ----- - applyTo: anObject - anObject modifyDefinition: obsoletion to: modification! Item was removed: - ----- Method: MCModification>>baseDefinition (in category 'accessing') ----- - baseDefinition - ^ obsoletion! Item was removed: - ----- Method: MCModification>>definition (in category 'accessing') ----- - definition - ^ modification! Item was removed: - ----- Method: MCModification>>fromSource (in category 'accessing') ----- - fromSource - ^ obsoletion source! Item was removed: - ----- Method: MCModification>>hash (in category 'comparing') ----- - hash - ^ obsoletion hash bitXor: modification hash! Item was removed: - ----- Method: MCModification>>initializeWithBase:target: (in category 'initializing') ----- - initializeWithBase: base target: target - obsoletion := base. - modification := target.! Item was removed: - ----- Method: MCModification>>inverse (in category 'accessing') ----- - inverse - ^ MCModification of: modification to: obsoletion! Item was removed: - ----- Method: MCModification>>isClassPatch (in category 'testing') ----- - isClassPatch - ^obsoletion isClassDefinition! Item was removed: - ----- Method: MCModification>>isModification (in category 'testing') ----- - isModification - ^ true! Item was removed: - ----- Method: MCModification>>isUnchangedMethod (in category 'testing') ----- - 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 removed: - ----- Method: MCModification>>modification (in category 'accessing') ----- - modification - ^ modification! Item was removed: - ----- Method: MCModification>>obsoletion (in category 'accessing') ----- - obsoletion - ^ obsoletion! Item was removed: - ----- Method: MCModification>>printAnnotations:on: (in category 'accessing') ----- - printAnnotations: request on: aStream - aStream nextPutAll: 'old: '. - obsoletion printAnnotations: request on: aStream. - aStream cr. - aStream nextPutAll: 'new: '. - modification printAnnotations: request on: aStream.! Item was removed: - ----- Method: MCModification>>summarySuffix (in category 'accessing') ----- - summarySuffix - ^ modification summarySuffixOver: obsoletion - ! Item was removed: - ----- Method: MCModification>>targetClass (in category 'accessing') ----- - targetClass - ^ obsoletion actualClass! Item was removed: - ----- Method: MCModification>>targetDefinition (in category 'accessing') ----- - targetDefinition - ^ modification! Item was removed: - ----- Method: MCModification>>toSource (in category 'accessing') ----- - toSource - ^ modification source! Item was removed: - Exception subclass: #MCNoChangesException - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Versioning'! Item was removed: - ----- Method: MCNoChangesException>>defaultAction (in category 'handling') ----- - defaultAction - self inform: 'No changes'! Item was removed: - MCCodeTool subclass: #MCOperationsBrowser - instanceVariableNames: 'selection reverts' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-UI'! Item was removed: - ----- Method: MCOperationsBrowser class>>items: (in category 'instance creation') ----- - items: aCollection - ^ self new - setItems: aCollection ; - yourself! Item was removed: - ----- Method: MCOperationsBrowser class>>themeProperties (in category 'preferences') ----- - themeProperties - - ^ super themeProperties, { - { #revertedOperationAttributes. 'Colors' . 'Text attributes to use for reverted operations in MC tools.' }. - { #ignoredOperationAttributes. 'Colors' . 'Text attributes to use for ignored operations in MC tools.' }. - - "{ #rejectedOperationAttributes. 'Colors' . 'Text attributes to use for rejected operations in MC tools.' }. - { #acceptedOperationAttributes. 'Colors' . 'Text attributes to use for accepted operations in MC tools.' }. - { #conflictingOperationAttributes. 'Colors' . 'Text attributes to use for conflicting operations in MC tools.' }." - }! Item was removed: - ----- Method: MCOperationsBrowser>>adoptMessageInCurrentChangeset (in category 'menus') ----- - adoptMessageInCurrentChangeset - - selection ifNotNil: [^ super adoptMessageInCurrentChangeset]. - - items select: [:each | each definition isMethodDefinition] thenDo: [:item | - self forItem: item setClassAndSelectorIn: [:class :selector | - ((item isAddition or: [item isModification]) and: [class includesSelector: selector]) - ifTrue: [ChangeSet current adoptSelector: selector forClass: class]. - item isRemoval - ifTrue: [ChangeSet current removeSelector: selector class: class priorMethod: nil lastMethodInfo: nil]]]. - self changed: #annotations.! Item was removed: - ----- Method: MCOperationsBrowser>>advanceSelection (in category 'selecting') ----- - advanceSelection - - self selection < items size - ifTrue: [self selection: self selection + 1]! Item was removed: - ----- Method: MCOperationsBrowser>>annotations (in category 'accessing') ----- - annotations - ^selection ifNil: [ super annotations ] - ifNotNil: [ selection annotations ]! Item was removed: - ----- Method: MCOperationsBrowser>>applyUserInterfaceTheme (in category 'updating') ----- - applyUserInterfaceTheme - - super applyUserInterfaceTheme. - - self changed: #list.! Item was removed: - ----- Method: MCOperationsBrowser>>browseSelectionOrigin (in category 'actions') ----- - browseSelectionOrigin - | mcDefinition | - selection ifNil: [ UIManager inform: 'Make a selection.' ]. - mcDefinition := selection definition. - Cursor wait showWhile: - [ mcDefinition mcModel ifNotNil: - [ : mcModel | (mcModel originOf: mcDefinition) - ifNil: [ UIManager inform: mcDefinition asString , ' was not found in any historical MC repository.' ] - ifNotNil: - [ : version | version open ] ] ]! Item was removed: - ----- Method: MCOperationsBrowser>>buttonSpecs (in category 'ui') ----- - buttonSpecs - - ^ #( - ((button: (Invert invert 'Show the reverse set of changes'))) - ((button: (Export export 'Export the changes as a change set'))) - )! Item was removed: - ----- Method: MCOperationsBrowser>>changeSetNameForInstall (in category 'accessing') ----- - changeSetNameForInstall - "Answer the name of the change set into which my selection will be installed. - Derive this from my label. - If I have no label, use the current change set." - - | tokens | - label ifNil: [ ^ChangeSet current name ]. - tokens := label findTokens: ' '. - tokens removeAllFoundIn: { 'changes'. 'between'. 'and' }. - (tokens size = 3 and: [ tokens second = '<working' ]) ifTrue: [ ^tokens first, '-to-working' ]. - tokens size = 2 ifFalse: [ ^'InstalledPatches' ]. - ^'{1}-to-{2}' format: tokens ! Item was removed: - ----- Method: MCOperationsBrowser>>defaultLabel (in category 'ui') ----- - defaultLabel - ^ label ifNil: [ 'Revisions Browser' ]! Item was removed: - ----- Method: MCOperationsBrowser>>filterOutUnchangedMethods (in category 'actions') ----- - filterOutUnchangedMethods - "Remove from the list methods that only have changed timestamps" - | unchangedMethods | - unchangedMethods := self unchangedMethods. - (self confirm: ('Ignore {1} methods that only differ in timestamp?' translated - format: {unchangedMethods size})) - ifTrue: - [items := items reject: [:op| op isUnchangedMethod]. - self changed: #list] - ! Item was removed: - ----- Method: MCOperationsBrowser>>forItem:setClassAndSelectorIn: (in category 'private') ----- - forItem: item setClassAndSelectorIn: classSelectorBlock - - item definition isMethodDefinition ifFalse: [self halt]. - ^ classSelectorBlock - value: item definition actualClass - value: item definition selector! Item was removed: - ----- Method: MCOperationsBrowser>>installSelection (in category 'actions') ----- - installSelection - | loader | - selection ifNotNil: - [loader := MCPackageLoader new. - selection applyTo: loader. - loader loadWithName: self changeSetNameForInstall. - self reverts remove: selection ifAbsent: []. - self changed: #list ]! Item was removed: - ----- Method: MCOperationsBrowser>>invert (in category 'selecting') ----- - invert - items replace: [:ea | ea inverse]. - self changed: #list; changed: #text; changed: #selection! Item was removed: - ----- Method: MCOperationsBrowser>>isViewingRevisions (in category 'accessing') ----- - isViewingRevisions - ^self items size > 1 and: - [self items allSatisfy: - [:each | each definition isRevisionOf: self items first definition]]! Item was removed: - ----- Method: MCOperationsBrowser>>list (in category 'accessing') ----- - list - | showRevision | - showRevision := self isViewingRevisions. - ^ self items collect: [:each | | summary | - summary := showRevision ifTrue: [each summaryAndRevision] ifFalse: [each summary]. - (self reverts includes: each) - ifFalse: [summary] - ifTrue: [Text - string: '( ', summary, ' )' - attributes: (self userInterfaceTheme revertedOperationAttributes ifNil: [{TextEmphasis struckOut}])]]! Item was removed: - ----- Method: MCOperationsBrowser>>methodListKey:from: (in category 'menus') ----- - methodListKey: aKeystroke from: aListMorph - aKeystroke caseOf: { - [$x] -> [self revertSelection] } - otherwise: [super methodListKey: aKeystroke from: aListMorph ]! Item was removed: - ----- Method: MCOperationsBrowser>>methodListMenu: (in category 'menus') ----- - methodListMenu: aMenu - selection - ifNil: [items ifNotEmpty: [ - aMenu addList: #( - ('add all to current change set' adoptMessageInCurrentChangeset))]] - ifNotNil: [aMenu addList: #( - ('install' installSelection) - ('revert (x)' revertSelection) - ('browse origin' browseSelectionOrigin) - -)]. - self unchangedMethods ifNotEmpty: - [aMenu addList: #( - ('revert unchanged methods...' revertUnchangedMethods) - ('filter out unchanged methods...' filterOutUnchangedMethods) - -)]. - super methodListMenu: aMenu. - ^ aMenu! Item was removed: - ----- Method: MCOperationsBrowser>>panelSpecs (in category 'ui') ----- - panelSpecs - ^ #( - ((textMorph: annotations) (0 0 1 0) ( 0 0 0 defaultAnnotationPaneHeight )) - ((textMorph: text) (0 0 1 1) ( 0 defaultAnnotationPaneHeight 0 0 )) - )! Item was removed: - ----- Method: MCOperationsBrowser>>revertSelection (in category 'actions') ----- - revertSelection - | loader | - selection ifNotNil: - [loader := MCPackageLoader new. - selection inverse applyTo: loader. - self environmentInDisplayingImage beCurrentDuring: [loader loadWithName: self changeSetNameForInstall]. - self reverts add: selection. - self - advanceSelection; - changed: #list ]! Item was removed: - ----- Method: MCOperationsBrowser>>revertUnchangedMethods (in category 'actions') ----- - revertUnchangedMethods - "revert methods that only have changed timestamps" - | loader unchangedMethods | - unchangedMethods := self unchangedMethods. - (self confirm: ('Revert {1} methods that only differ in timestamp?' translated - format: {unchangedMethods size})) - ifTrue: - [loader := MCPackageLoader new. - unchangedMethods do: [:op | op inverse applyTo: loader]. - loader loadWithName: self changeSetNameForInstall]. - ! Item was removed: - ----- Method: MCOperationsBrowser>>reverts (in category 'accessing') ----- - reverts - ^ reverts ifNil: [reverts := Set new]! Item was removed: - ----- Method: MCOperationsBrowser>>selectedClass (in category 'subclassResponsibility') ----- - selectedClass - | definition | - selection ifNil: [ ^nil ]. - (definition := selection definition) ifNil: [ ^nil ]. - definition isMethodDefinition ifFalse: [ ^nil ]. - definition className in: [:className | | environment | - environment := self environmentInDisplayingImage. - ^ environment at: className ifAbsent: [environment valueOf: className]]! Item was removed: - ----- Method: MCOperationsBrowser>>selectedClassOrMetaClass (in category 'subclassResponsibility') ----- - selectedClassOrMetaClass - | definition | - selection ifNil: [ ^nil ]. - (definition := selection definition) ifNil: [ ^nil ]. - (definition isMethodDefinition or: [definition isClassDefinition]) ifFalse: [ ^nil ]. - ^ definition actualClassIn: self environmentInDisplayingImage! Item was removed: - ----- Method: MCOperationsBrowser>>selectedMessageCategoryName (in category 'subclassResponsibility') ----- - selectedMessageCategoryName - | definition | - selection ifNil: [ ^nil ]. - (definition := selection definition) ifNil: [ ^nil ]. - definition isMethodDefinition ifFalse: [ ^nil ]. - ^definition category! Item was removed: - ----- Method: MCOperationsBrowser>>selectedMessageName (in category 'subclassResponsibility') ----- - selectedMessageName - | definition | - selection ifNil: [ ^nil ]. - (definition := selection definition) ifNil: [ ^nil ]. - definition isMethodDefinition ifFalse: [ ^nil ]. - ^definition selector! Item was removed: - ----- Method: MCOperationsBrowser>>selection (in category 'selecting') ----- - selection - ^ selection - ifNil: [0] - ifNotNil: [self items indexOf: selection]! Item was removed: - ----- Method: MCOperationsBrowser>>selection: (in category 'selecting') ----- - selection: aNumber - selection := self items - at: aNumber - ifAbsent: [ ]. - self - changed: #selection ; - changed: #text ; - changed: #annotations! Item was removed: - ----- Method: MCOperationsBrowser>>text (in category 'text') ----- - text - ^ selection ifNil: [''] ifNotNil: [selection source]! Item was removed: - ----- Method: MCOperationsBrowser>>text: (in category 'text') ----- - text: aTextOrString - self changed: #text! Item was removed: - ----- Method: MCOperationsBrowser>>unchangedMethods (in category 'accessing') ----- - unchangedMethods - ^ items select: [:op | op isUnchangedMethod]! Item was removed: - ----- Method: MCOperationsBrowser>>widgetSpecs (in category 'ui') ----- - widgetSpecs - Preferences annotationPanes ifFalse: [ ^#( - ((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (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)) - ((panel) (0 0.4 1 1) (0 0 0 0)) - )! Item was removed: - Object subclass: #MCOperationsList - instanceVariableNames: 'operations' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Patching'! Item was removed: - ----- Method: MCOperationsList class>>operations: (in category 'instance creation') ----- - operations: aCollection - ^ self basicNew initializeWithOperations: aCollection! Item was removed: - ----- Method: MCOperationsList>>browse (in category 'ui') ----- - browse - (self browserClass items: operations) show! Item was removed: - ----- Method: MCOperationsList>>browserClass (in category 'ui') ----- - browserClass - ^ MCOperationsBrowser! Item was removed: - ----- Method: MCOperationsList>>initializeWithOperations: (in category 'intializing') ----- - initializeWithOperations: aCollection - operations := aCollection! Item was removed: - ----- Method: MCOperationsList>>isEmpty (in category 'querying') ----- - isEmpty - ^ operations isEmpty! Item was removed: - ----- Method: MCOperationsList>>operations (in category 'accessing') ----- - operations - ^ operations! Item was removed: - MCDefinition subclass: #MCOrganizationDefinition - instanceVariableNames: 'categories' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Modeling'! Item was removed: - ----- Method: MCOrganizationDefinition class>>categories: (in category 'instance creation') ----- - categories: anArray - ^ self instanceLike: (self new categories: anArray)! Item was removed: - ----- Method: MCOrganizationDefinition>>= (in category 'testing') ----- - = aDefinition - ^ (super = aDefinition) - and: [categories = aDefinition categories]! Item was removed: - ----- Method: MCOrganizationDefinition>>accept: (in category 'actions') ----- - accept: aVisitor - ^ aVisitor visitOrganizationDefinition: self! Item was removed: - ----- Method: MCOrganizationDefinition>>categories (in category 'accessing') ----- - categories - ^ categories! Item was removed: - ----- Method: MCOrganizationDefinition>>categories: (in category 'accessing') ----- - categories: anArray - categories := anArray! Item was removed: - ----- Method: MCOrganizationDefinition>>commonPrefix (in category 'accessing') ----- - commonPrefix - | stream | - categories isEmpty ifTrue: [^ '']. - - stream := String new writeStream. - categories first withIndexDo: - [:c :i| - categories do: - [:ea | - (ea at: i ifAbsent: []) = c ifFalse: [^ stream contents]]. - stream nextPut: c]. - ^ stream contents! Item was removed: - ----- Method: MCOrganizationDefinition>>description (in category 'accessing') ----- - description - ^{ #organization } - ! Item was removed: - ----- Method: MCOrganizationDefinition>>handlePackageRename:to: (in category 'actions') ----- - handlePackageRename: oldPackageName to: newPackageName - categories do: - [ : each | (each beginsWith: newPackageName) ifFalse: - [ | newCategoryName | - newCategoryName := self - newCategoryNameFor: each - givenRenameFrom: oldPackageName - to: newPackageName. - (SystemOrganizer default categories includes: newCategoryName) ifTrue: [ SystemOrganizer default removeCategory: newCategoryName ]. - SystemOrganizer default - renameCategory: each - toBe: newCategoryName ] ]! Item was removed: - ----- Method: MCOrganizationDefinition>>isOrganizationDefinition (in category 'testing') ----- - isOrganizationDefinition - ^ true! Item was removed: - ----- Method: MCOrganizationDefinition>>postloadOver: (in category 'actions') ----- - postloadOver: oldDefinition - SystemOrganization categories: - (self - reorderCategories: SystemOrganization categories - original: (oldDefinition ifNil: [#()] ifNotNil: [oldDefinition categories]))! Item was removed: - ----- Method: MCOrganizationDefinition>>reorderCategories:original: (in category 'actions') ----- - reorderCategories: allCategories original: oldCategories - | first locallyAddedCategories | - first := allCategories detect: [:ea | categories includes: ea] - ifNone: [^ allCategories, categories]. - locallyAddedCategories := (oldCategories copyWithoutAll: categories) select: [:cat | - (SystemOrganization listAtCategoryNamed: cat) notEmpty]. - ^ ((allCategories copyUpTo: first) copyWithoutAll: oldCategories, categories), - categories, - locallyAddedCategories, - ((allCategories copyAfter: first) copyWithoutAll: oldCategories, categories) - ! Item was removed: - ----- Method: MCOrganizationDefinition>>sortKey (in category 'accessing') ----- - sortKey - ^ '<organization>'! Item was removed: - ----- Method: MCOrganizationDefinition>>source (in category 'accessing') ----- - source - ^ String streamContents: - [:s | - categories do: [:ea | s nextPutAll: ea] separatedBy: [s cr]]! Item was removed: - ----- Method: MCOrganizationDefinition>>summary (in category 'accessing') ----- - summary - ^ categories asArray printString! Item was removed: - ----- Method: MCOrganizationDefinition>>unload (in category 'actions') ----- - unload - | empty | - empty := categories select: [:ea | - (SystemOrganization listAtCategoryNamed: ea) isEmpty]. - SystemOrganization categories: - (SystemOrganization categories copyWithoutAll: empty)! Item was removed: - Object subclass: #MCPackage - instanceVariableNames: 'name' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Base'! - - !MCPackage commentStamp: 'hjh 1/22/2013 22:22' prior: 0! - MCPackage uses PackageInfo to find out which methods and classes belong to a package. - - - ! Item was removed: - ----- Method: MCPackage class>>named: (in category 'instance creation') ----- - named: aString - ^ self new name: aString! Item was removed: - ----- Method: MCPackage>>= (in category 'testing') ----- - = other - ^ other species = self species and: [other name sameAs: name]! Item was removed: - ----- Method: MCPackage>>hasWorkingCopy (in category 'testing') ----- - hasWorkingCopy - ^ MCWorkingCopy registry includesKey: self! Item was removed: - ----- Method: MCPackage>>hash (in category 'testing') ----- - hash - ^ name asLowercase hash! Item was removed: - ----- Method: MCPackage>>inEnvironment: (in category 'environments') ----- - inEnvironment: anEnvironment - "Answer a decorator for me that activates anEnvironment for certain operations." - ^ MCPackageInEnvironment decorating: self in: anEnvironment! Item was removed: - ----- Method: MCPackage>>name (in category 'accessing') ----- - name - ^ name! Item was removed: - ----- Method: MCPackage>>name: (in category 'accessing') ----- - name: aString - name := aString! Item was removed: - ----- Method: MCPackage>>packageInfo (in category 'accessing') ----- - packageInfo - "Activate my working copy's environment so the PackageInfo is added to the - correct EnvironmentInfo's packages." - | getPackageInfo | - getPackageInfo := [PackageInfo named: name]. - ^ self hasWorkingCopy - ifTrue: [self workingCopy withEnvironmentActiveDo: getPackageInfo] - ifFalse: getPackageInfo! Item was removed: - ----- Method: MCPackage>>printOn: (in category 'printing') ----- - printOn: aStream - super printOn: aStream. - aStream - nextPut: $(; - nextPutAll: name; - nextPut: $)! Item was removed: - ----- Method: MCPackage>>snapshot (in category 'input/output') ----- - snapshot - | packageInfo definitions categories | - packageInfo := self packageInfo. - definitions := OrderedCollection new. - categories := packageInfo systemCategories. - categories isEmpty ifFalse: [ definitions add: (MCOrganizationDefinition categories: categories) ]. - CurrentReadOnlySourceFiles cacheDuring: [ - packageInfo methods do: [:ea | definitions add: ea asMethodDefinition] displayingProgress: 'Snapshotting methods...'. - (packageInfo respondsTo: #overriddenMethods) ifTrue: - [packageInfo overriddenMethods - do: [:ea | definitions add: - (packageInfo changeRecordForOverriddenMethod: ea) asMethodDefinition] - displayingProgress: 'Searching for overrides...']. - packageInfo classes do: [:ea | definitions addAll: ea classDefinitions] displayingProgress: 'Snapshotting classes...' ]. - (packageInfo respondsTo: #hasPreamble) ifTrue: [ - packageInfo hasPreamble ifTrue: [definitions add: (MCPreambleDefinition from: packageInfo)]. - packageInfo hasPostscript ifTrue: [definitions add: (MCPostscriptDefinition from: packageInfo)]. - packageInfo hasPreambleOfRemoval ifTrue: [definitions add: (MCRemovalPreambleDefinition from: packageInfo)]. - packageInfo hasPostscriptOfRemoval ifTrue: [definitions add: (MCRemovalPostscriptDefinition from: packageInfo)]]. - ^ MCSnapshot fromDefinitions: definitions - ! Item was removed: - ----- Method: MCPackage>>storeOn: (in category 'input/output') ----- - storeOn: aStream - aStream - nextPutAll: 'MCPackage'; - space; nextPutAll: 'named: '; store: name.! Item was removed: - ----- Method: MCPackage>>unload (in category 'input/output') ----- - unload - ^ self workingCopy unload! Item was removed: - ----- Method: MCPackage>>workingCopy (in category 'accessing') ----- - workingCopy - ^ MCWorkingCopy forPackage: self.! Item was removed: - Object subclass: #MCPackageCache - instanceVariableNames: 'sorter fileNames' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Repositories'! Item was removed: - ----- Method: MCPackageCache class>>new (in category 'instance creation') ----- - new - ^ self basicNew initialize! Item was removed: - ----- Method: MCPackageCache>>initialize (in category 'initialize-release') ----- - initialize - sorter := MCVersionSorter new. - fileNames := Dictionary new.! Item was removed: - ----- Method: MCPackageCache>>recordVersionInfo:forFileNamed: (in category 'recording') ----- - recordVersionInfo: aVersionInfo forFileNamed: aString - Transcript cr; show: aString. - fileNames at: aVersionInfo put: aString. - sorter addVersionInfo: aVersionInfo! Item was removed: - ----- Method: MCPackageCache>>versionInfos (in category 'accessing') ----- - versionInfos - ^ sorter sortedVersionInfos ! Item was removed: - ProtoObject subclass: #MCPackageInEnvironment - instanceVariableNames: 'package environment' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Environments'! - - !MCPackageInEnvironment commentStamp: 'jr 2/27/2017 23:05' prior: 0! - I am a decorator for an MCPackage, activating an Environment for relevant operations. - - Instance Variables - environment: <Environment> should be the current one for some of my operations - package: <MCPackage> my substance! Item was removed: - ----- Method: MCPackageInEnvironment class>>decorating:in: (in category 'instance creation') ----- - decorating: aPackage in: anEnvironment - | instance | - instance := self new. - instance initializeWithPackage: aPackage in: anEnvironment. - ^ instance! Item was removed: - ----- Method: MCPackageInEnvironment>>basicInspect (in category 'object behavior') ----- - basicInspect - "Create and schedule an Inspector in which the user can examine the - receiver's variables. This method should not be overriden." - ^ToolSet basicInspect: self! Item was removed: - ----- Method: MCPackageInEnvironment>>doesNotUnderstand: (in category 'delegating') ----- - doesNotUnderstand: aMessage - ^ aMessage sendTo: package! Item was removed: - ----- Method: MCPackageInEnvironment>>environment (in category 'accessing') ----- - environment - - ^ environment! Item was removed: - ----- Method: MCPackageInEnvironment>>environment: (in category 'accessing') ----- - environment: anObject - - environment := anObject! Item was removed: - ----- Method: MCPackageInEnvironment>>inEnvironment: (in category 'initialize-release') ----- - inEnvironment: anEnvironment - environment == anEnvironment ifTrue: [^ self]. - ^ MCPackageInEnvironment decorating: package in: anEnvironment! Item was removed: - ----- Method: MCPackageInEnvironment>>initializeWithPackage:in: (in category 'initialize-release') ----- - initializeWithPackage: aPackage in: anEnvironment - package := aPackage. - environment := anEnvironment.! Item was removed: - ----- Method: MCPackageInEnvironment>>respondsTo: (in category 'delegating') ----- - respondsTo: aSymbol - ^ (MCPackageInEnvironment canUnderstand: aSymbol) - or: [package respondsTo: aSymbol]! Item was removed: - ----- Method: MCPackageInEnvironment>>snapshot (in category 'input/output') ----- - snapshot - ^ environment beCurrentDuring: [package snapshot]! Item was removed: - Object subclass: #MCPackageLoader - instanceVariableNames: 'requirements unloadableDefinitions obsoletions additions removals errorDefinitions provisions methodAdditions preamble' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Loading'! - - !MCPackageLoader commentStamp: 'rej 2/26/2007 07:35' prior: 0! - A MCPackageLoader is responsible for loading packages. It gets used by VersionLoader, so it is eventually responsible for loading everything. - - Instance Variables - additions: <Definitions> Definitions that need to be added - errorDefinitions: <Object> - obsoletions: <Object> - provisions: <Object> - removals: <Object> - requirements: <Object> - unloadableDefinitions: <Object> - methodAdditions <MethodAdditions> MethodDefinitions corresponding to the Definitions in "additions" that have been added so far. - - additions - - xxxxx - - errorDefinitions - - xxxxx - - obsoletions - - xxxxx - - provisions - - xxxxx - - removals - - xxxxx - - requirements - - xxxxx - - unloadableDefinitions - - xxxxx - ! Item was removed: - ----- Method: MCPackageLoader class>>installSnapshot: (in category 'loading') ----- - installSnapshot: aSnapshot - self new - installSnapshot: aSnapshot; - load! Item was removed: - ----- Method: MCPackageLoader class>>new (in category 'instance creation') ----- - new - ^ self basicNew initialize! Item was removed: - ----- Method: MCPackageLoader class>>unloadPackage: (in category 'unloading') ----- - unloadPackage: aPackage - self new - unloadPackage: aPackage; - loadWithNameLike: aPackage name, '-unload'! Item was removed: - ----- Method: MCPackageLoader class>>updatePackage:withSnapshot: (in category 'loading') ----- - updatePackage: aPackage withSnapshot: aSnapshot - self new - updatePackage: aPackage withSnapshot: aSnapshot; - load! Item was removed: - ----- Method: MCPackageLoader>>addDefinition: (in category 'patch ops') ----- - addDefinition: aDefinition - additions add: aDefinition! Item was removed: - ----- Method: MCPackageLoader>>analyze (in category 'private') ----- - analyze - | sorter | - sorter := self sorterForItems: additions. - additions := sorter orderedItems. - requirements := sorter externalRequirements. - unloadableDefinitions := sorter itemsWithMissingRequirements sorted. - - self forgetSuperfluousMethodRemovals. - sorter := self sorterForItems: removals. - removals := sorter orderedItems reversed.! Item was removed: - ----- Method: MCPackageLoader>>appendToPreamble: (in category 'public') ----- - appendToPreamble: aString - preamble - ifNil: [preamble := aString] - ifNotNil: [preamble := preamble, aString]. - ! Item was removed: - ----- Method: MCPackageLoader>>basicLoad (in category 'private') ----- - basicLoad - "Load the contents of some package. This is the core loading method - in Monticello. Be wary about modifying it unless you understand the details - and dependencies of the various entities being modified." - | pkgName | - errorDefinitions := OrderedCollection new. - "Obviously this isn't the package name but we don't have anything else - to use here. ChangeSet current name will generally work since a CS is - usually installed prior to installation." - pkgName := ChangeSet current name. - preamble ifNotNil: [ChangeSet current preambleString: (self preambleAsCommentNamed: pkgName)]. - - RecentMessages default suspendWhile: [ - [CurrentReadOnlySourceFiles cacheDuring: [[ - "Pass 1: Load everything but the methods, which are collected in methodAdditions." - additions do: [:ea | - ea isMethodDefinition - ifTrue:[methodAdditions add: ea asMethodAddition] - ifFalse:[[ea load]on: Error do: [errorDefinitions add: ea]]. - ] displayingProgress: 'Reshaping ', pkgName. - - "Try again any delayed definitions" - self shouldWarnAboutErrors ifTrue: [self warnAboutErrors]. - errorDefinitions do: [:ea | ea load] - displayingProgress: 'Reloading ', pkgName. - - "Pass 2: We compile new / changed methods" - methodAdditions do:[:ea| ea createCompiledMethod] - displayingProgress: 'Compiling ', pkgName. - - 'Installing ', pkgName displayProgressFrom: 0 to: 2 during:[:bar| - "There is no progress *during* installation since a progress bar update - will redraw the world and potentially call methods that we're just trying to install." - bar value: 1. - - "Pass 3: Install the new / changed methods - (this is a separate pass to allow compiler changes to be loaded)" - methodAdditions do:[:ea| ea installMethod]. - - "Pass 4: Remove the obsolete methods" - removals do:[:ea| ea unload]. - ]. - - "Finally, notify observers for the method additions" - methodAdditions do: [:each | each notifyObservers] - "the message is fake but actually telling people how much time we spend - in the notifications is embarrassing so lie instead" - displayingProgress: 'Installing ', pkgName. - - additions do: [:ea | ea postloadOver: (self obsoletionFor: ea)] - displayingProgress: 'Initializing ', pkgName. - - ] on: InMidstOfFileinNotification do: [:n | n resume: true] - ]] ensure: [self flushChangesFile] - ]! Item was removed: - ----- Method: MCPackageLoader>>dependencyWarning (in category 'private') ----- - dependencyWarning - ^ String streamContents: - [:s | - s nextPutAll: 'This package depends on the following classes:'; cr. - requirements do: [:ea | s space; space; nextPutAll: ea; cr]. - s nextPutAll: 'You must resolve these dependencies before you will be able to load these definitions: '; cr. - unloadableDefinitions do: [:ea | s space; space; nextPutAll: ea summary; cr]] ! Item was removed: - ----- Method: MCPackageLoader>>errorDefinitionWarning (in category 'private') ----- - errorDefinitionWarning - ^ String streamContents: - [:s | - s nextPutAll: 'The following definitions had errors while loading. Press Proceed to try to load them again (they may work on a second pass):'; cr. - errorDefinitions do: [:ea | s space; space; nextPutAll: ea summary; cr]] ! Item was removed: - ----- Method: MCPackageLoader>>flushChangesFile (in category 'private') ----- - flushChangesFile - "The changes file is second in the SourceFiles array" - - (SourceFiles at: 2) flush! Item was removed: - ----- Method: MCPackageLoader>>forgetSuperfluousMethodRemovals (in category 'private') ----- - forgetSuperfluousMethodRemovals - | removedClasses | - removedClasses := (removals select: #isClassDefinition) collect: #actualClass. - removedClasses addAll: (removedClasses collect: #class). - removals := removals reject: [:e | e isMethodDefinition and: [removedClasses includes: e actualClass]]! Item was removed: - ----- Method: MCPackageLoader>>initialize (in category 'private') ----- - initialize - additions := OrderedCollection new. - removals := OrderedCollection new. - obsoletions := Dictionary new. - methodAdditions := OrderedCollection new. - ! Item was removed: - ----- Method: MCPackageLoader>>installSnapshot: (in category 'public') ----- - installSnapshot: aSnapshot - | patch | - patch := aSnapshot patchRelativeToBase: MCSnapshot empty. - patch applyTo: self. - ! Item was removed: - ----- Method: MCPackageLoader>>load (in category 'public') ----- - load - self analyze. - unloadableDefinitions isEmpty ifFalse: [self warnAboutDependencies]. - self useNewChangeSetDuring: [self basicLoad]! Item was removed: - ----- Method: MCPackageLoader>>loadClassDefinition: (in category 'private') ----- - loadClassDefinition: aDefinition - [aDefinition isClassDefinition ifTrue:[aDefinition load]] on: Error do: [errorDefinitions add: aDefinition].! Item was removed: - ----- Method: MCPackageLoader>>loadWithName: (in category 'public') ----- - loadWithName: baseName - self analyze. - unloadableDefinitions isEmpty ifFalse: [self warnAboutDependencies]. - self useChangeSetNamed: baseName during: [self basicLoad]! Item was removed: - ----- Method: MCPackageLoader>>loadWithNameLike: (in category 'public') ----- - loadWithNameLike: baseName - self analyze. - unloadableDefinitions isEmpty ifFalse: [self warnAboutDependencies]. - self useNewChangeSetNamedLike: baseName during: [self basicLoad]! Item was removed: - ----- Method: MCPackageLoader>>modifyDefinition:to: (in category 'patch ops') ----- - modifyDefinition: old to: new - self addDefinition: new. - obsoletions at: new put: old.! Item was removed: - ----- Method: MCPackageLoader>>obsoletionFor: (in category 'private') ----- - obsoletionFor: aDefinition - ^ obsoletions at: aDefinition ifAbsent: [nil]! Item was removed: - ----- Method: MCPackageLoader>>orderDefinitionsForLoading: (in category 'private') ----- - orderDefinitionsForLoading: aCollection - ^ (self sorterForItems: aCollection) orderedItems! Item was removed: - ----- Method: MCPackageLoader>>orderedAdditions (in category 'private') ----- - orderedAdditions - ^ additions! Item was removed: - ----- Method: MCPackageLoader>>preambleAsCommentNamed: (in category 'private') ----- - preambleAsCommentNamed: pkgName - ^ - '"Changeset: {1} - Date: {2} - Author: (generated by MC) - - {3} - "' format: {pkgName. Date today. preamble copyReplaceAll: '"' with: ''''''}! Item was removed: - ----- Method: MCPackageLoader>>provisions (in category 'private') ----- - provisions - ^ provisions ifNil: [provisions := Set withAll: Environment current provisions] ! Item was removed: - ----- Method: MCPackageLoader>>removeDefinition: (in category 'patch ops') ----- - removeDefinition: aDefinition - removals add: aDefinition! Item was removed: - ----- Method: MCPackageLoader>>shouldWarnAboutErrors (in category 'private') ----- - shouldWarnAboutErrors - ^ errorDefinitions isEmpty not and: [false "should make this a preference"]! Item was removed: - ----- Method: MCPackageLoader>>sorterForItems: (in category 'private') ----- - sorterForItems: aCollection - | sorter | - sorter := MCDependencySorter items: aCollection. - sorter addExternalProvisions: self provisions. - ^ sorter! Item was removed: - ----- Method: MCPackageLoader>>tryToLoad: (in category 'private') ----- - tryToLoad: aDefinition - [aDefinition addMethodAdditionTo: methodAdditions] on: Error do: [errorDefinitions add: aDefinition].! Item was removed: - ----- Method: MCPackageLoader>>unloadPackage: (in category 'public') ----- - unloadPackage: aPackage - self updatePackage: aPackage withSnapshot: MCSnapshot empty! Item was removed: - ----- Method: MCPackageLoader>>updatePackage:withSnapshot: (in category 'public') ----- - updatePackage: aPackage withSnapshot: aSnapshot - | patch packageSnap | - packageSnap := aPackage snapshot. - patch := aSnapshot patchRelativeToBase: packageSnap. - patch applyTo: self. - packageSnap definitions do: [:ea | self provisions addAll: ea provisions] - ! Item was removed: - ----- Method: MCPackageLoader>>useChangeSetNamed:during: (in category 'private') ----- - useChangeSetNamed: baseName during: aBlock - "Use the named change set, or create one with the given name." - | changeHolder oldChanges newChanges | - changeHolder := (ChangeSet respondsTo: #newChanges:) - ifTrue: [ChangeSet] - ifFalse: [Smalltalk]. - oldChanges := (ChangeSet respondsTo: #current) - ifTrue: [ChangeSet current] - ifFalse: [Smalltalk changes]. - - newChanges := (ChangeSet named: baseName) ifNil: [ ChangeSet new name: baseName ]. - changeHolder newChanges: newChanges. - aBlock ensure: [changeHolder newChanges: oldChanges]. - ! Item was removed: - ----- Method: MCPackageLoader>>useNewChangeSetDuring: (in category 'private') ----- - useNewChangeSetDuring: aBlock - ^self useNewChangeSetNamedLike: 'MC' during: aBlock! Item was removed: - ----- Method: MCPackageLoader>>useNewChangeSetNamedLike:during: (in category 'private') ----- - useNewChangeSetNamedLike: baseName during: aBlock - ^self useChangeSetNamed: (ChangeSet uniqueNameLike: baseName) during: aBlock! Item was removed: - ----- Method: MCPackageLoader>>warnAboutDependencies (in category 'private') ----- - warnAboutDependencies - self notify: self dependencyWarning! Item was removed: - ----- Method: MCPackageLoader>>warnAboutErrors (in category 'private') ----- - warnAboutErrors - self notify: self errorDefinitionWarning. - ! Item was removed: - Object subclass: #MCPackageManager - instanceVariableNames: 'package modified' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Versioning'! - MCPackageManager class - instanceVariableNames: 'registry'! - MCPackageManager class - instanceVariableNames: 'registry'! Item was removed: - ----- Method: MCPackageManager class>>allManagers (in category 'private') ----- - allManagers - ^ self registry values! Item was removed: - ----- Method: MCPackageManager class>>classModified: (in category 'system changes') ----- - classModified: anEvent - self managersForClass: anEvent item do:[:mgr| mgr modified: true].! Item was removed: - ----- Method: MCPackageManager class>>classMoved: (in category 'system changes') ----- - classMoved: anEvent - self classModified: anEvent. - self managersForCategory: anEvent oldCategory do:[:mgr| mgr modified: true].! Item was removed: - ----- Method: MCPackageManager class>>classRemoved: (in category 'system changes') ----- - classRemoved: anEvent - self classModified: anEvent! Item was removed: - ----- Method: MCPackageManager class>>forPackage: (in category 'instance creation') ----- - 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 removed: - ----- Method: MCPackageManager class>>forPackageNamed: (in category 'instance creation') ----- - forPackageNamed: aString - ^ self registry detect: - [ : each | each packageName = aString ]! Item was removed: - ----- Method: MCPackageManager class>>initialize (in category 'class initialization') ----- - initialize - "Remove this later" - Smalltalk at: #SystemChangeNotifier ifPresent:[:cls| - (cls uniqueInstance) noMoreNotificationsFor: self. - ].! Item was removed: - ----- Method: MCPackageManager class>>managersForCategory:do: (in category 'system changes') ----- - managersForCategory: aSystemCategory do: aBlock - "Got to be careful here - we might get method categories where capitalization is problematic." - | cat foundOne index | - foundOne := false. - cat := aSystemCategory ifNil:[^nil]. "yes this happens; for example in eToy projects" - "first ask PackageInfos, their package name might not match the category" - self registry do: [:mgr | - (mgr packageInfo includesSystemCategory: aSystemCategory) ifTrue: [ - aBlock value: mgr. - foundOne := true. - ] - ]. - foundOne ifTrue: [^self]. - ["Loop over categories until we found a matching one" - self registry at: (MCPackage named: cat) ifPresent:[:mgr| - aBlock value: mgr. - foundOne := true. - ]. - index := cat lastIndexOf: $-. - index > 0]whileTrue:[ - "Step up to next level package" - cat := cat copyFrom: 1 to: index-1. - ]. - foundOne ifFalse:[ - "Create a new (but only top-level)" - aBlock value: (MCWorkingCopy forPackage: (MCPackage named: (aSystemCategory copyUpTo: $-) capitalized)). - ].! Item was removed: - ----- Method: MCPackageManager class>>managersForClass:category:do: (in category 'system changes') ----- - managersForClass: aClass category: methodCategory do: aBlock - (methodCategory isEmptyOrNil or:[methodCategory first ~= $*]) ifTrue:[ - "Not an extension method" - ^self managersForClass: aClass do: aBlock. - ]. - self managersForCategory: methodCategory allButFirst do: aBlock.! Item was removed: - ----- Method: MCPackageManager class>>managersForClass:do: (in category 'system changes') ----- - managersForClass: aClass do: aBlock - - self registry do: [:mgr | - (mgr packageInfo includesClass: aClass) - ifTrue: [aBlock value: mgr]]! Item was removed: - ----- Method: MCPackageManager class>>managersForClass:selector:do: (in category 'system changes') ----- - managersForClass: aClass selector: aSelector do: aBlock - ^self managersForClass: aClass category: (aClass organization categoryOfElement: aSelector) do: aBlock! Item was removed: - ----- Method: MCPackageManager class>>methodModified: (in category 'system changes') ----- - methodModified: anEvent - ^self managersForClass: anEvent itemClass selector: anEvent itemSelector do:[:mgr| mgr modified: true].! Item was removed: - ----- Method: MCPackageManager class>>methodMoved: (in category 'system changes') ----- - methodMoved: anEvent - self managersForClass: anEvent itemClass category: anEvent oldCategory do:[:mgr| mgr modified: true]. - self methodModified: anEvent.! Item was removed: - ----- Method: MCPackageManager class>>methodRemoved: (in category 'system changes') ----- - methodRemoved: anEvent - self managersForClass: anEvent itemClass category: anEvent itemProtocol do:[:mgr| mgr modified: true]. - ! Item was removed: - ----- Method: MCPackageManager class>>registerForNotifications (in category 'system changes') ----- - registerForNotifications - Smalltalk - at: #SystemChangeNotifier - ifPresent: - [:cls| - cls uniqueInstance noMoreNotificationsFor: self. - self reregisterForNotificationsWith: cls uniqueInstance]! Item was removed: - ----- Method: MCPackageManager class>>registry (in category 'private') ----- - registry - ^ registry ifNil: [registry := Dictionary new]! Item was removed: - ----- Method: MCPackageManager class>>reregisterForNotificationsWith: (in category 'system changes') ----- - reregisterForNotificationsWith: aSystemChangeNotifier - aSystemChangeNotifier - notify: self ofSystemChangesOfItem: #class change: #Added using: #classModified:; - notify: self ofSystemChangesOfItem: #class change: #Modified using: #classModified:; - notify: self ofSystemChangesOfItem: #class change: #Renamed using: #classModified:; - notify: self ofSystemChangesOfItem: #class change: #Commented using: #classModified:; - notify: self ofSystemChangesOfItem: #class change: #Recategorized using: #classMoved:; - notify: self ofSystemChangesOfItem: #class change: #Removed using: #classRemoved:; - notify: self ofSystemChangesOfItem: #method change: #Added using: #methodModified:; - notify: self ofSystemChangesOfItem: #method change: #Modified using: #methodModified:; - notify: self ofSystemChangesOfItem: #method change: #Recategorized using: #methodMoved:; - notify: self ofSystemChangesOfItem: #method change: #Removed using: #methodRemoved:! Item was removed: - ----- Method: MCPackageManager>>classModified: (in category 'system changes') ----- - classModified: anEvent - "obsolete - remove this later"! Item was removed: - ----- Method: MCPackageManager>>classMoved: (in category 'system changes') ----- - classMoved: anEvent - "obsolete - remove this later"! Item was removed: - ----- Method: MCPackageManager>>classRemoved: (in category 'system changes') ----- - classRemoved: anEvent - "obsolete - remove this later"! Item was removed: - ----- Method: MCPackageManager>>initialize (in category 'initialize-release') ----- - initialize - modified := false. - self registerForNotifications.! Item was removed: - ----- Method: MCPackageManager>>initializeWithPackage: (in category 'initialize-release') ----- - initializeWithPackage: aPackage - package := aPackage inEnvironment: Environment current. - self initialize.! Item was removed: - ----- Method: MCPackageManager>>methodModified: (in category 'system changes') ----- - methodModified: anEvent - "obsolete - remove this later"! Item was removed: - ----- Method: MCPackageManager>>methodMoved: (in category 'system changes') ----- - methodMoved: anEvent - "obsolete - remove this later"! Item was removed: - ----- Method: MCPackageManager>>methodRemoved: (in category 'system changes') ----- - methodRemoved: anEvent - "obsolete - remove this later"! Item was removed: - ----- Method: MCPackageManager>>modified (in category 'accessing') ----- - modified - ^ modified! Item was removed: - ----- Method: MCPackageManager>>modified: (in category 'accessing') ----- - modified: aBoolean - modified = aBoolean ifTrue: [^ self]. - modified := aBoolean. - self changed: #modified. - - modified ifFalse: - [(((Smalltalk classNamed: 'SmalltalkImage') ifNotNil: [:si | si current]) ifNil: [Smalltalk]) - logChange: '"', self packageName, '"'].! Item was removed: - ----- Method: MCPackageManager>>package (in category 'accessing') ----- - package - ^ package! Item was removed: - ----- Method: MCPackageManager>>packageInfo (in category 'accessing') ----- - packageInfo - ^ package packageInfo! Item was removed: - ----- Method: MCPackageManager>>packageName (in category 'accessing') ----- - packageName - ^ package name! Item was removed: - ----- Method: MCPackageManager>>packageNameWithStar (in category 'accessing') ----- - packageNameWithStar - ^ modified - ifTrue: ['* ', self packageName] - ifFalse: [self packageName]! Item was removed: - ----- Method: MCPackageManager>>registerForNotifications (in category 'system changes') ----- - registerForNotifications - "obsolete - remove this later"! Item was removed: - ----- Method: MCPackageManager>>registerForNotificationsFrom: (in category 'system changes') ----- - registerForNotificationsFrom: aNotifier - "obsolete - remove this later"! Item was removed: - ----- Method: MCPackageManager>>systemChange: (in category 'system changes') ----- - systemChange: anEvent - "obsolete - remove this later"! Item was removed: - ----- Method: MCPackageManager>>unregister (in category 'operations') ----- - unregister - self class registry - removeKey: package - ifAbsent: [ "Should not complain when trying to clean up." ]. - self class changed: #allManagers! Item was removed: - ----- Method: MCPackageManager>>unregisterSubpackages (in category 'operations') ----- - unregisterSubpackages - (self class registry keys - select: [:p | self packageName , '-*' match: p name]) - do: [:k | self class registry removeKey: k]! Item was removed: - ----- Method: MCPackageManager>>update: (in category 'system changes') ----- - update: aSymbol - InMidstOfFileinNotification signal ifFalse: [ - [((aSymbol = #recentMethodSubmissions) - and: [self packageInfo - includesMethodReference: RecentMessages default mostRecent]) - ifTrue: [self modified: true]] - on: Error do: []]! Item was removed: - Error subclass: #MCPackageNotFound - instanceVariableNames: 'repository packageName' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Repositories'! Item was removed: - ----- Method: MCPackageNotFound class>>signalForRepository:packageName: (in category 'signaling') ----- - signalForRepository: aRepository packageName: aString - - ^ self new - repository: aRepository packageName: aString; - signal! Item was removed: - ----- Method: MCPackageNotFound>>messageText (in category 'printing') ----- - messageText - - ^ messageText ifNil: ['{1} not found in {2}' translated format: {self packageName. self repository}]! Item was removed: - ----- Method: MCPackageNotFound>>packageName (in category 'accessing') ----- - packageName - - ^ packageName! Item was removed: - ----- Method: MCPackageNotFound>>repository (in category 'accessing') ----- - repository - - ^ repository! Item was removed: - ----- Method: MCPackageNotFound>>repository:packageName: (in category 'accessing') ----- - repository: aRepository packageName: aString - - repository := aRepository. - packageName := aString.! Item was removed: - MCOperationsList subclass: #MCPatch - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Patching'! Item was removed: - ----- Method: MCPatch class>>fromBase:target: (in category 'instance creation') ----- - fromBase: baseSnapshot target: targetSnapshot - ^ self new initializeWithBase: baseSnapshot target: targetSnapshot! Item was removed: - ----- Method: MCPatch>>applyTo: (in category 'applying') ----- - applyTo: anObject - operations do: [:ea | ea applyTo: anObject]. - ! Item was removed: - ----- Method: MCPatch>>browse (in category 'ui') ----- - browse - (self browserClass forPatch: self) show! Item was removed: - ----- Method: MCPatch>>browserClass (in category 'ui') ----- - browserClass - ^ MCPatchBrowser! Item was removed: - ----- Method: MCPatch>>ignoring: (in category 'accessing') ----- - ignoring: ignoredOperations - ^ MCPatch operations: (operations difference: ignoredOperations)! Item was removed: - ----- Method: MCPatch>>initializeWithBase:target: (in category 'initialize-release') ----- - initializeWithBase: baseSnapshot target: targetSnapshot - | base target | - operations := OrderedCollection new. - base := MCDefinitionIndex definitions: baseSnapshot definitions. - target := MCDefinitionIndex definitions: targetSnapshot definitions. - - target definitionsDo: - [:t | - base - definitionLike: t - ifPresent: [:b | (b isSameRevisionAs: t) ifFalse: [operations add: (MCModification of: b to: t)]] - ifAbsent: [operations add: (MCAddition of: t)]]. - - base definitionsDo: - [:b | - target - definitionLike: b - ifPresent: [:t|] - ifAbsent: [operations add: (MCRemoval of: b)]] ! Item was removed: - MCOperationsBrowser subclass: #MCPatchBrowser - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-UI'! Item was removed: - ----- Method: MCPatchBrowser class>>forPatch: (in category 'instance creation') ----- - forPatch: aPatch - ^ self new patch: aPatch! Item was removed: - ----- Method: MCPatchBrowser>>aboutToStyle: (in category 'styling') ----- - aboutToStyle: aStyler - - selection ifNotNil: [ - selection isConflict ifTrue: [ ^false ]. - (selection isAddition or: [ selection isRemoval ]) ifTrue: [ - selection definition isOrganizationDefinition ifTrue: [ ^false ]. - aStyler classOrMetaClass: self selectedClassOrMetaClass. - ^true ] ]. - ^false! Item was removed: - ----- Method: MCPatchBrowser>>defaultLabel (in category 'ui') ----- - defaultLabel - ^ 'Patch Browser'! Item was removed: - ----- Method: MCPatchBrowser>>patch: (in category 'initialize-release') ----- - patch: aPatch - items := aPatch operations sorted! Item was removed: - ----- Method: MCPatchBrowser>>representsSameBrowseeAs: (in category 'ui') ----- - representsSameBrowseeAs: anotherModel - ^ self class = anotherModel class - and: [ items = anotherModel items ]! Item was removed: - Object subclass: #MCPatchMessage - instanceVariableNames: 'stream' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Versioning'! Item was removed: - ----- Method: MCPatchMessage>>addDefinition: (in category 'patch operations') ----- - addDefinition: aDefinition - stream nextPutAll: 'A'; tab; nextPutAll: aDefinition summary; cr! Item was removed: - ----- Method: MCPatchMessage>>message (in category 'accessing') ----- - message - ^stream contents - ! Item was removed: - ----- Method: MCPatchMessage>>modifyDefinition:to: (in category 'patch operations') ----- - modifyDefinition: oldDefinition to: newDefinition - stream nextPutAll: 'M'; tab; nextPutAll: newDefinition summary; cr! Item was removed: - ----- Method: MCPatchMessage>>patch: (in category 'accessing') ----- - patch: aPatch - stream ifNil: [stream := WriteStream on: (String new: 100)]. - aPatch operations sorted - do: [:op | op applyTo: self]! Item was removed: - ----- Method: MCPatchMessage>>removeDefinition: (in category 'patch operations') ----- - removeDefinition: aDefinition - stream nextPutAll: 'D'; tab; nextPutAll: aDefinition summary; cr! Item was removed: - Object subclass: #MCPatchOperation - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Patching'! Item was removed: - ----- Method: MCPatchOperation>><= (in category 'comparing') ----- - <= other - ^ self definition <= other definition! Item was removed: - ----- Method: MCPatchOperation>>annotations (in category 'accessing') ----- - annotations - ^self annotations: Preferences defaultAnnotationRequests! Item was removed: - ----- Method: MCPatchOperation>>annotations: (in category 'accessing') ----- - annotations: requests - "Answer a string for an annotation pane, trying to fulfill the annotation requests. - These might include anything that - Preferences defaultAnnotationRequests - might return. Which includes anything in - Preferences annotationInfo - To edit these, use:" - "Preferences editAnnotations" - - ^String streamContents: [ :s | self printAnnotations: requests on: s ].! Item was removed: - ----- Method: MCPatchOperation>>definition (in category 'accessing') ----- - definition - ^ self subclassResponsibility ! Item was removed: - ----- Method: MCPatchOperation>>inverse (in category 'accessing') ----- - inverse - self subclassResponsibility! Item was removed: - ----- Method: MCPatchOperation>>isAddition (in category 'testing') ----- - isAddition - ^ false! Item was removed: - ----- Method: MCPatchOperation>>isClassPatch (in category 'testing') ----- - isClassPatch - ^false! Item was removed: - ----- Method: MCPatchOperation>>isMCPatchOperation (in category 'testing') ----- - isMCPatchOperation - ^true! Item was removed: - ----- Method: MCPatchOperation>>isModification (in category 'testing') ----- - isModification - ^ false! Item was removed: - ----- Method: MCPatchOperation>>isRemoval (in category 'testing') ----- - isRemoval - ^ false! Item was removed: - ----- Method: MCPatchOperation>>isUnchangedMethod (in category 'testing') ----- - isUnchangedMethod - "true if this is a modification of a method where only the timestamp changed" - ^false! Item was removed: - ----- Method: MCPatchOperation>>prefixForOperation: (in category 'accessing') ----- - prefixForOperation: aSymbol - aSymbol == #insert ifTrue: [^ '+']. - aSymbol == #remove ifTrue: [^ '-']. - ^ ' '! Item was removed: - ----- Method: MCPatchOperation>>printAnnotations:on: (in category 'accessing') ----- - printAnnotations: requests on: aStream - "Add a string for an annotation pane, trying to fulfill the annotation requests. - These might include anything that - Preferences defaultAnnotationRequests - might return. Which includes anything in - Preferences annotationInfo - To edit these, use:" - "Preferences editAnnotations" - - self definition printAnnotations: requests on: aStream.! Item was removed: - ----- Method: MCPatchOperation>>source (in category 'accessing') ----- - source - ^ self sourceText! Item was removed: - ----- Method: MCPatchOperation>>sourceString (in category 'accessing') ----- - sourceString - ^self sourceText asString! Item was removed: - ----- Method: MCPatchOperation>>sourceText (in category 'accessing') ----- - sourceText - - ^(self isClassPatch - ifFalse: [ TextDiffBuilder ] - ifTrue: [ ClassDiffBuilder ]) - buildDisplayPatchFrom: self fromSource - to: self toSource - inClass: self targetClass - prettyDiffs: ( - Preferences diffsWithPrettyPrint and: [ - self targetClass notNil and: [ - self isClassPatch not ] ])! Item was removed: - ----- Method: MCPatchOperation>>summary (in category 'accessing') ----- - summary - ^ self definition summary, self summarySuffix! Item was removed: - ----- Method: MCPatchOperation>>summaryAndRevision (in category 'accessing') ----- - summaryAndRevision - ^ self definition summaryAndRevision, self summarySuffix! Item was removed: - ----- Method: MCPatchOperation>>summarySuffix (in category 'accessing') ----- - summarySuffix - ^ ''! Item was removed: - ----- Method: MCPatchOperation>>targetClass (in category 'accessing') ----- - targetClass - self subclassResponsibility.! Item was removed: - Object subclass: #MCPatcher - instanceVariableNames: 'definitions' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Patching'! Item was removed: - ----- Method: MCPatcher class>>apply:to: (in category 'applying') ----- - apply: aPatch to: aSnapshot - | loader | - loader := self snapshot: aSnapshot. - aPatch applyTo: loader. - ^ loader patchedSnapshot! Item was removed: - ----- Method: MCPatcher class>>snapshot: (in category 'instance creation') ----- - snapshot: aSnapshot - ^ self new initializeWithSnapshot: aSnapshot! Item was removed: - ----- Method: MCPatcher>>addDefinition: (in category 'accessing') ----- - addDefinition: aDefinition - definitions add: aDefinition! Item was removed: - ----- Method: MCPatcher>>initializeWithSnapshot: (in category 'initialize-release') ----- - initializeWithSnapshot: aSnapshot - definitions := MCDefinitionIndex definitions: aSnapshot definitions! Item was removed: - ----- Method: MCPatcher>>modifyDefinition:to: (in category 'applying') ----- - modifyDefinition: baseDefinition to: targetDefinition - self addDefinition: targetDefinition! Item was removed: - ----- Method: MCPatcher>>patchedSnapshot (in category 'applying') ----- - patchedSnapshot - ^ MCSnapshot fromDefinitions: definitions definitions! Item was removed: - ----- Method: MCPatcher>>removeDefinition: (in category 'accessing') ----- - removeDefinition: aDefinition - definitions remove: aDefinition! Item was removed: - MCVariableDefinition subclass: #MCPoolImportDefinition - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Modeling'! Item was removed: - ----- Method: MCPoolImportDefinition class>>type (in category 'accessing') ----- - type - ^ #pool! Item was removed: - ----- Method: MCPoolImportDefinition>>isOrderDependend (in category 'testing') ----- - isOrderDependend - ^false! Item was removed: - ----- Method: MCPoolImportDefinition>>isPoolImport (in category 'testing') ----- - isPoolImport - ^ true! Item was removed: - MCScriptDefinition subclass: #MCPostscriptDefinition - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Modeling'! Item was removed: - ----- Method: MCPostscriptDefinition class>>scriptSelector (in category 'private - instance creation') ----- - scriptSelector - ^ #postscript! Item was removed: - ----- Method: MCPostscriptDefinition>>postload (in category 'installing') ----- - postload - self evaluate! Item was removed: - ----- Method: MCPostscriptDefinition>>sortKey (in category 'accessing') ----- - sortKey - ^ 'zzz' "force to the end so it gets loaded late"! Item was removed: - ----- Method: MCPostscriptDefinition>>wantsToBeOutermost (in category 'testing') ----- - wantsToBeOutermost - - ^ true! Item was removed: - MCScriptDefinition subclass: #MCPreambleDefinition - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Modeling'! Item was removed: - ----- Method: MCPreambleDefinition class>>scriptSelector (in category 'private - instance creation') ----- - scriptSelector - ^ #preamble! Item was removed: - ----- Method: MCPreambleDefinition>>load (in category 'installing') ----- - load - super load. - self evaluate! Item was removed: - Notification subclass: #MCProxyMaterialization - instanceVariableNames: 'proxy' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Repositories'! Item was removed: - ----- Method: MCProxyMaterialization class>>signalMaterializing: (in category 'as yet unclassified') ----- - signalMaterializing: aMCInfoProxy - ^ self new - setProxy: aMCInfoProxy; - signal! Item was removed: - ----- Method: MCProxyMaterialization>>defaultAction (in category 'handling') ----- - defaultAction - ^proxy materializeInfo! Item was removed: - ----- Method: MCProxyMaterialization>>setProxy: (in category 'initialize-release') ----- - setProxy: aMCInfoProxy - proxy := aMCInfoProxy! Item was removed: - Object subclass: #MCReader - instanceVariableNames: 'stream' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Storing'! Item was removed: - ----- Method: MCReader class>>canReadFileNamed: (in category 'testing') ----- - canReadFileNamed: fileName - ^ (fileName endsWith: '.', self extension)! Item was removed: - ----- Method: MCReader class>>concreteSubclassesDo: (in category 'testing') ----- - concreteSubclassesDo: aBlock - - self allSubclassesDo: [ :each | - each isAbstract ifFalse: [ aBlock value: each ] ]! Item was removed: - ----- Method: MCReader class>>isAbstract (in category 'testing') ----- - isAbstract - ^ (self respondsTo: #extension) not! Item was removed: - ----- Method: MCReader class>>new (in category 'instance creation') ----- - new - ^ self basicNew initialize! Item was removed: - ----- Method: MCReader class>>on: (in category 'instance creation') ----- - on: aStream - ^ self new stream: aStream! Item was removed: - ----- Method: MCReader class>>on:name: (in category 'instance creation') ----- - on: aStream name: aFileName - | class | - class := self readerClassForFileNamed: aFileName. - ^ class - ifNil: [self error: 'Unsupported format: ', aFileName] - ifNotNil: [class on: aStream]! Item was removed: - ----- Method: MCReader class>>readerClassForFileNamed: (in category 'testing') ----- - readerClassForFileNamed: fileName - - self concreteSubclassesDo: [ :each | - (each canReadFileNamed: fileName) ifTrue: [ ^each ] ]. - ^nil! Item was removed: - ----- Method: MCReader>>stream: (in category 'accessing') ----- - stream: aStream - stream := aStream! Item was removed: - MCPatchOperation subclass: #MCRemoval - instanceVariableNames: 'definition' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Patching'! Item was removed: - ----- Method: MCRemoval class>>of: (in category 'instance creation') ----- - of: aDefinition - ^ self new intializeWithDefinition: aDefinition! Item was removed: - ----- Method: MCRemoval>>= (in category 'comparing') ----- - = other - ^other isMCPatchOperation - and: [other isRemoval - and: [definition = other definition]]! Item was removed: - ----- Method: MCRemoval>>applyTo: (in category 'accessing') ----- - applyTo: anObject - anObject removeDefinition: definition! Item was removed: - ----- Method: MCRemoval>>baseDefinition (in category 'accessing') ----- - baseDefinition - ^ definition! Item was removed: - ----- Method: MCRemoval>>definition (in category 'accessing') ----- - definition - ^ definition! Item was removed: - ----- Method: MCRemoval>>fromSource (in category 'accessing') ----- - fromSource - ^ definition source! Item was removed: - ----- Method: MCRemoval>>hash (in category 'comparing') ----- - hash - ^ definition hash! Item was removed: - ----- Method: MCRemoval>>intializeWithDefinition: (in category 'initializing') ----- - intializeWithDefinition: aDefinition - definition := aDefinition! Item was removed: - ----- Method: MCRemoval>>inverse (in category 'accessing') ----- - inverse - ^ MCAddition of: definition! Item was removed: - ----- Method: MCRemoval>>isClassPatch (in category 'testing') ----- - isClassPatch - ^definition isClassDefinition! Item was removed: - ----- Method: MCRemoval>>isRemoval (in category 'testing') ----- - isRemoval - ^ true! Item was removed: - ----- Method: MCRemoval>>sourceString (in category 'accessing') ----- - sourceString - ^self fromSource asText - addAttribute: TextEmphasis struckOut; - addAttribute: TextColor blue; - yourself! Item was removed: - ----- Method: MCRemoval>>summarySuffix (in category 'accessing') ----- - summarySuffix - ^ ' (removed)'! Item was removed: - ----- Method: MCRemoval>>targetClass (in category 'accessing') ----- - targetClass - ^ definition actualClass! Item was removed: - ----- Method: MCRemoval>>targetDefinition (in category 'accessing') ----- - targetDefinition - ^ nil! Item was removed: - ----- Method: MCRemoval>>toSource (in category 'accessing') ----- - toSource - ^ ''! Item was removed: - MCScriptDefinition subclass: #MCRemovalPostscriptDefinition - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Modeling'! Item was removed: - ----- Method: MCRemovalPostscriptDefinition class>>scriptSelector (in category 'private - instance creation') ----- - scriptSelector - ^ #postscriptOfRemoval ! Item was removed: - ----- Method: MCRemovalPostscriptDefinition>>unload (in category 'installing') ----- - unload - super unload. - self evaluate! Item was removed: - MCScriptDefinition subclass: #MCRemovalPreambleDefinition - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Modeling'! Item was removed: - ----- Method: MCRemovalPreambleDefinition class>>scriptSelector (in category 'private - instance creation') ----- - scriptSelector - ^ #preambleOfRemoval! Item was removed: - ----- Method: MCRemovalPreambleDefinition>>sortKey (in category 'accessing') ----- - sortKey - ^ 'zzz' "force to the end so it gets unloaded early"! Item was removed: - ----- Method: MCRemovalPreambleDefinition>>unload (in category 'installing') ----- - unload - super unload. - self evaluate! Item was removed: - ----- Method: MCRemovalPreambleDefinition>>wantsToBeOutermost (in category 'testing') ----- - wantsToBeOutermost - - ^ true! Item was removed: - Object subclass: #MCReorganizationPreloader - instanceVariableNames: 'preloads previousRemovals currentRemovals' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Loading'! - - !MCReorganizationPreloader commentStamp: 'bf 8/20/2013 13:51' prior: 0! - MCReorganizationPreloader ensures that definitions moved between two packages are not removed temporarily, independent of their load order. - - Moves appear as deletion in one package and addition in another package. If the deletion precedes the addition, the entity will be removed from the system for a short period of time, and then recreated later. This is potentially fatal. - - MCReorganizationPreloader detects these problematic definitions and combines them into MCModifications. They then get 'preloaded' (applied to the system) so when the actual packages are loaded later, they become no-ops (because the definition in the image is already in the right package). - - Instance Variables - preloads: generated modifications - currentRemovals: definitions removed by the version currently being added - previousRemovals: definitions removed by previously added versions - ! Item was removed: - ----- Method: MCReorganizationPreloader class>>preloadMovesBetween: (in category 'loading') ----- - preloadMovesBetween: versions - | loader | - loader := self new. - versions do: [ :version | - loader addVersion: version]. - ^ loader preload! Item was removed: - ----- Method: MCReorganizationPreloader>>addDefinition: (in category 'patch ops') ----- - addDefinition: new - previousRemovals definitionLike: new - ifPresent: [ :old | preloads add: (MCModification of: old to: new) ] - ifAbsent: [ "ignore" ]. - ! Item was removed: - ----- Method: MCReorganizationPreloader>>addVersion: (in category 'accessing') ----- - addVersion: aVersion - | patch | - previousRemovals addAll: currentRemovals definitions. - currentRemovals := MCDefinitionIndex new. - patch := aVersion canOptimizeLoading - ifTrue: [aVersion patch] - ifFalse: [aVersion snapshot patchRelativeToBase: aVersion package snapshot]. - patch applyTo: self. - - - ! Item was removed: - ----- Method: MCReorganizationPreloader>>initialize (in category 'initialize-release') ----- - initialize - preloads := Set new. - previousRemovals := MCDefinitionIndex new. - currentRemovals := MCDefinitionIndex new. - ! Item was removed: - ----- Method: MCReorganizationPreloader>>modifyDefinition:to: (in category 'patch ops') ----- - modifyDefinition: old to: new - "ignore"! Item was removed: - ----- Method: MCReorganizationPreloader>>preload (in category 'loading') ----- - preload - preloads ifNotEmpty: [ | loader | - loader := MCPackageLoader new. - (MCPatch operations: preloads) applyTo: loader. - loader loadWithNameLike: 'mcPreload']. - ! Item was removed: - ----- Method: MCReorganizationPreloader>>removeDefinition: (in category 'patch ops') ----- - removeDefinition: old - currentRemovals add: old. - ! Item was removed: - Object subclass: #MCRepository - instanceVariableNames: 'creationTemplate storeDiffs' - classVariableNames: 'Settings' - poolDictionaries: '' - category: 'Monticello-Repositories'! Item was removed: - ----- Method: MCRepository class>>allConcreteSubclasses (in category 'configuring') ----- - allConcreteSubclasses - ^ self withAllSubclasses reject: [:ea | ea isAbstract]! Item was removed: - ----- Method: MCRepository class>>browseClassRevisionsOf: (in category 'ui-support') ----- - browseClassRevisionsOf: classReference - - classReference ifNil: [ Project uiManager inform: 'No class selected' ]. - - classReference mcModel - ifNil: [ Project uiManager inform: 'Only Magma-backed HTTP repositories (or MCMagmaRepositorys) support browsing Monticello revisions.' ] - ifNotNil: [ (MCOperationsList operations: (Cursor wait showWhile: [ classReference mcPatchOperations ])) browse ] ! Item was removed: - ----- Method: MCRepository class>>browseMethodRevisionsOf: (in category 'ui-support') ----- - browseMethodRevisionsOf: methodReference - - methodReference ifNil: [ ^ Project uiManager inform: 'No method selected' ]. - - methodReference mcModel - ifNil: [ Project uiManager inform: 'Only Magma-backed HTTP repositories (or MCMagmaRepositorys) support browsing Monticello revisions.' ] - ifNotNil: [ (MCOperationsList operations: (Cursor wait showWhile: [ methodReference mcPatchOperations ])) browse ].! Item was removed: - ----- Method: MCRepository class>>creationTemplate (in category 'configuring') ----- - creationTemplate - self subclassResponsibility.! Item was removed: - ----- Method: MCRepository class>>description (in category 'configuring') ----- - description - ^ nil! Item was removed: - ----- Method: MCRepository class>>fetchExternalSettingsIn: (in category 'external settings') ----- - fetchExternalSettingsIn: aDirectory - "Scan for settings file" - "MCRepository fetchExternalSettingsIn: ExternalSettings preferenceDirectory" - - | stream | - (aDirectory fileExists: self settingsFileName) - ifFalse: [^self]. - stream := aDirectory readOnlyFileNamed: self settingsFileName. - stream - ifNotNil: [ - [Settings := ExternalSettings parseServerEntryArgsFrom: stream] - ensure: [stream close]]. - ! Item was removed: - ----- Method: MCRepository class>>fillInTheBlankConfigure (in category 'configuring') ----- - fillInTheBlankConfigure - ^ self fillInTheBlankConfigure: self creationTemplate - ! Item was removed: - ----- Method: MCRepository class>>fillInTheBlankConfigure: (in category 'configuring') ----- - fillInTheBlankConfigure: aTemplateString - | chunk repo | - - aTemplateString ifNil: [ ^ false ]. - chunk := UIManager default - multiLineRequest: self fillInTheBlankRequest - centerAt: Sensor cursorPoint - initialAnswer: aTemplateString - answerHeight: 120. - - chunk - ifNotNil: [ - repo := self readFrom: chunk readStream. - repo creationTemplate: chunk. - ]. - - ^ repo! Item was removed: - ----- Method: MCRepository class>>fillInTheBlankRequest (in category 'configuring') ----- - fillInTheBlankRequest - self subclassResponsibility.! Item was removed: - ----- Method: MCRepository class>>inbox (in category 'well-known repositories') ----- - inbox - ^ MCHttpRepository inbox! Item was removed: - ----- Method: MCRepository class>>initialize (in category 'class initialization') ----- - initialize - "self initialize" - - ExternalSettings registerClient: self. - ! Item was removed: - ----- Method: MCRepository class>>isAbstract (in category 'configuring') ----- - isAbstract - ^ self description isNil! Item was removed: - ----- Method: MCRepository class>>location: (in category 'instance creation') ----- - location: urlOrPath - "Answer an MCRepository for the given url or path. Accepted locations are: - - http, and ftp urls (i.e., http://source.squeak.org/trunk) - - directory paths (i.e., C:\Squeak\packages) - - directory matches (i.e., C:\Squeak\packages\*) - " - - ^self location: urlOrPath username: '' password: ''! Item was removed: - ----- Method: MCRepository class>>location:username:password: (in category 'instance creation') ----- - location: urlOrPath username: user password: pass - "Answer an MCRepository for the given url or path. Accepted locations are: - - http, and ftp urls (i.e., http://source.squeak.org/trunk) - - directory paths (i.e., C:\Squeak\packages) - - directory matches (i.e., C:\Squeak\packages\*) - If provided, the supplied user name and password will be used." - - | url | - (urlOrPath findString: '://') > 0 ifTrue:[ - url := urlOrPath asUrl. - ^ url scheme caseOf: { - ['ftp'] -> [MCFtpRepository - host: url authority - directory: url pathString allButFirst - user: user - password: user]. - ['http'] -> [MCHttpRepository - location: urlOrPath - user: user - password: pass]. - } otherwise:[self error: 'Unsupported scheme: ', url scheme]. - ]. - - (urlOrPath endsWith: '*') ifTrue:[ - ^MCSubDirectoryRepository new - directory: (FileDirectory on: urlOrPath allButLast)]. - - ^MCDirectoryRepository - directory: (FileDirectory on: urlOrPath)! Item was removed: - ----- Method: MCRepository class>>morphicConfigure (in category 'configuring') ----- - morphicConfigure - ^ self new! Item was removed: - ----- Method: MCRepository class>>packageCache (in category 'well-known repositories') ----- - packageCache - ^ MCCacheRepository default! Item was removed: - ----- Method: MCRepository class>>releaseExternalSettings (in category 'external settings') ----- - releaseExternalSettings - Settings := nil. - ! Item was removed: - ----- Method: MCRepository class>>settingsFileName (in category 'external settings') ----- - settingsFileName - ^ 'mcSettings'! Item was removed: - ----- Method: MCRepository class>>treated (in category 'well-known repositories') ----- - treated - ^ MCHttpRepository treated! Item was removed: - ----- Method: MCRepository class>>trunk (in category 'well-known repositories') ----- - trunk - ^ MCHttpRepository trunk! Item was removed: - ----- Method: MCRepository>>= (in category 'testing') ----- - = other - ^ other species = self species and: [other description = self description]! Item was removed: - ----- Method: MCRepository>>allPackageAndBranchNames (in category 'packages') ----- - allPackageAndBranchNames - "Currently this function is only supported by FileBased repositories." - ^ self allPackageNames! Item was removed: - ----- Method: MCRepository>>allPackageNames (in category 'packages') ----- - allPackageNames - self subclassResponsibility! Item was removed: - ----- Method: MCRepository>>allVersionsDo: (in category 'versions') ----- - allVersionsDo: aBlock - self allPackageNames asArray sort - do: - [ : eachPackageName | | sortedVersions | - sortedVersions := (self versionNamesForPackageNamed: eachPackageName) sort: - [ : a : b | a versionNumber < b versionNumber ]. - sortedVersions - do: - [ : eachVersionName | (self versionNamed: eachVersionName) ifNotNil: - [ : ver | aBlock value: ver ] ] - displayingProgress: - [ : eachVersionName | 'Importing ' , eachVersionName ] ] - displayingProgress: - [ : eachPackageName | 'Importing versions of ' , eachPackageName ]! Item was removed: - ----- Method: MCRepository>>alwaysStoreDiffs (in category 'accessing') ----- - alwaysStoreDiffs - ^ storeDiffs ifNil: [false]! Item was removed: - ----- Method: MCRepository>>asCreationTemplate (in category 'accessing') ----- - asCreationTemplate - ^ self creationTemplate! Item was removed: - ----- Method: MCRepository>>basicStoreVersion: (in category 'private') ----- - basicStoreVersion: aVersion - self subclassResponsibility! Item was removed: - ----- Method: MCRepository>>cacheAllFileNamesDuring: (in category 'private') ----- - cacheAllFileNamesDuring: aBlock - "FileBasedRepository's can only access all version-names, therefore this is provided to allow client-code to direct caching of getting all filenames. Other types of repositories offer more sophisticated kinds of access, so they don't need to cache, so simply run the block." - ^ aBlock value! Item was removed: - ----- Method: MCRepository>>cacheAllFilenames (in category 'private') ----- - cacheAllFilenames - "No-op by default. Subclasses override for performance."! Item was removed: - ----- Method: MCRepository>>closestAncestorVersionFor:ifNone: (in category 'accessing') ----- - closestAncestorVersionFor: anAncestry ifNone: errorBlock - anAncestry breadthFirstAncestorsDo: - [:ancestorInfo | - (self versionWithInfo: ancestorInfo) ifNotNil: [:v | ^ v]]. - ^ errorBlock value! Item was removed: - ----- Method: MCRepository>>copyAllFrom: (in category 'versions') ----- - copyAllFrom: aMCRepository - "Copy all MCVersions from aMCRepository to the receiver." - self cacheAllFileNamesDuring: - [ aMCRepository cacheAllFileNamesDuring: - [ | pkgCount | - pkgCount := 0. - 'Copy all package versions from ' , aMCRepository description - displayProgressFrom: 0 - to: aMCRepository allPackageNames size - during: - [ : pkgBar | aMCRepository allPackageNames asArray sort do: - [ : eachPackageName | | versions verCount | - verCount := 0. - versions := (aMCRepository versionNamesForPackageNamed: eachPackageName) difference: (self versionNamesForPackageNamed: eachPackageName). - 'Progress for ' , eachPackageName - displayProgressFrom: 0 - to: versions size - during: - [ : verBar | versions do: - [ : eachVersionName | (aMCRepository versionNamed: eachVersionName) ifNotNil: - [ : ver | self storeVersion: ver ]. - verBar value: (verCount := verCount + 1) ]. - pkgBar value: (pkgCount := pkgCount + 1) ] ] ] ] ]! Item was removed: - ----- Method: MCRepository>>copyImageVersions (in category 'versions') ----- - copyImageVersions - "For each package contained in the receiver, copy the version of that package which is currently loaded in this image. If no version of a package is loaded in the image, nothing is copied for that package." - self cacheAllFileNamesDuring: - [ self allPackageNames do: - [ : eachPkgName | MCWorkingCopy allManagers - detect: [ : each | each packageName = eachPkgName ] - ifFound: - [ : loaded | loaded ancestors do: - [ : infoToCopy | (self includesVersionNamed: infoToCopy versionName) ifFalse: - [ (MCRepositoryGroup default versionWithInfo: infoToCopy) - ifNil: [ Warning signal: infoToCopy name , ' not found in RepositoryGroup default.' ] - ifNotNil: - [ : ver | self storeVersion: ver ] ] ] ] - ifNone: [ "Image specifies no version to copy." ] ] ]! Item was removed: - ----- Method: MCRepository>>creationTemplate (in category 'accessing') ----- - creationTemplate - ^ creationTemplate! Item was removed: - ----- Method: MCRepository>>creationTemplate: (in category 'accessing') ----- - creationTemplate: aString - creationTemplate := aString! Item was removed: - ----- Method: MCRepository>>description (in category 'user interface') ----- - description - ^ self class name! Item was removed: - ----- Method: MCRepository>>doAlwaysStoreDiffs (in category 'accessing') ----- - doAlwaysStoreDiffs - storeDiffs := true! Item was removed: - ----- Method: MCRepository>>doNotAlwaysStoreDiffs (in category 'accessing') ----- - doNotAlwaysStoreDiffs - storeDiffs := false! Item was removed: - ----- Method: MCRepository>>flushCache (in category 'private') ----- - flushCache - "Subclasses override as desired."! Item was removed: - ----- Method: MCRepository>>hash (in category 'testing') ----- - hash - ^ self description hash! Item was removed: - ----- Method: MCRepository>>highestNumberedVersionForPackageNamed: (in category 'versions') ----- - highestNumberedVersionForPackageNamed: aString - ^ self versionNamed: (self highestNumberedVersionNameForPackageNamed: aString)! Item was removed: - ----- Method: MCRepository>>highestNumberedVersionNameForPackageNamed: (in category 'versions') ----- - highestNumberedVersionNameForPackageNamed: aString - ^ (self versionNamesForPackageNamed: aString) - ifEmpty: [MCPackageNotFound signalForRepository: self packageName: aString] - ifNotEmptyDo: - [ : versionNames | versionNames detectMax: - [ : each | each versionNumber ] ]! Item was removed: - ----- Method: MCRepository>>includesVersionNamed: (in category 'versions') ----- - includesVersionNamed: aString - "Subclasses may want to override for better performance." - ^ (self versionNamed: aString) notNil! Item was removed: - ----- Method: MCRepository>>isInbox (in category 'testing') ----- - isInbox - ^ false! Item was removed: - ----- Method: MCRepository>>isTreated (in category 'testing') ----- - isTreated - ^ false! Item was removed: - ----- Method: MCRepository>>isTrunk (in category 'testing') ----- - isTrunk - ^ false! Item was removed: - ----- Method: MCRepository>>isValid (in category 'testing') ----- - isValid - ^true! Item was removed: - ----- Method: MCRepository>>mcModel (in category '*monticello') ----- - mcModel - "Only Magma-based repositories employ a McModel instance." - ^ nil! Item was removed: - ----- Method: MCRepository>>missingAncestryDo: (in category 'versions') ----- - missingAncestryDo: oneArgBlock - "Value oneArgBlock with each of the MCVersionInfo ancestry that is missing from this repository." - self cacheAllFileNamesDuring: - [ self allPackageNames do: - [ : each | self - missingAncestryForPackageNamed: each - do: oneArgBlock ] ]! Item was removed: - ----- Method: MCRepository>>missingAncestryForPackageNamed:do: (in category 'versions') ----- - missingAncestryForPackageNamed: packageName do: oneArgBlock - | start | - self cacheAllFileNamesDuring: - [ start := self versionNamed: (self highestNumberedVersionNameForPackageNamed: packageName). - self cacheAllFileNamesDuring: - [ start info allAncestorsDo: - [ : each | (self includesVersionNamed: each versionName) ifFalse: [ oneArgBlock value: each ] ] ] ]! Item was removed: - ----- Method: MCRepository>>morphicOpen (in category 'user interface') ----- - morphicOpen - self morphicOpen: nil! Item was removed: - ----- Method: MCRepository>>morphicOpen: (in category 'user interface') ----- - morphicOpen: aWorkingCopy - (MCRepositoryInspector repository: self workingCopy: aWorkingCopy) show! Item was removed: - ----- Method: MCRepository>>normalized (in category 'accessing') ----- - normalized - ^ (MCRepositoryGroup default repositories includes: self) - ifTrue: [ self ] - ifFalse: [ self copy ]! Item was removed: - ----- Method: MCRepository>>normalizedRepositories (in category 'private') ----- - normalizedRepositories - ^{ self normalized }! Item was removed: - ----- Method: MCRepository>>notificationForVersion: (in category 'notifying') ----- - notificationForVersion: aVersion - ^ MCVersionNotification version: aVersion repository: self! Item was removed: - ----- Method: MCRepository>>notifyList (in category 'notifying') ----- - notifyList - ^ #()! Item was removed: - ----- Method: MCRepository>>obtainMissingAncestryFrom: (in category 'versions') ----- - obtainMissingAncestryFrom: sourceRepository - self cacheAllFileNamesDuring: - [ self missingAncestryDo: - [ : each | (sourceRepository includesVersionNamed: each versionName) - ifTrue: [ self storeVersion: (sourceRepository versionNamed: each versionName) ] - ifFalse: [ Notification signal: each versionName , ' not present in ' , sourceRepository asString ] ] ]! Item was removed: - ----- Method: MCRepository>>openAndEditTemplateCopy (in category 'user interface') ----- - openAndEditTemplateCopy - ^ self class fillInTheBlankConfigure: (self asCreationTemplate ifNil: [^nil])! Item was removed: - ----- Method: MCRepository>>possiblyNewerVersionsOfAnyOf: (in category 'versions') ----- - possiblyNewerVersionsOfAnyOf: versionNames - "Answer a collection of MCVersionNames which might be newer versions of the versions identified by versionNames." - ^self cacheAllFileNamesDuring: [ - versionNames - inject: OrderedCollection new - into: - [ : coll : eachVersionName | | eachPackageName | - eachPackageName := eachVersionName packageAndBranchName. - (self versionNamesForPackageNamed: eachPackageName) do: - [ : eachInSelf | (eachPackageName = eachInSelf packageAndBranchName and: [ - eachInSelf versionNumber > eachVersionName versionNumber or: - [ eachInSelf versionNumber = eachVersionName versionNumber and: [ eachInSelf author ~= eachVersionName author ] ] ]) ifTrue: [ coll add: eachInSelf ] ]. - coll ] ]! Item was removed: - ----- Method: MCRepository>>prepareVersionForStorage: (in category 'accessing') ----- - prepareVersionForStorage: aVersion - ^ self alwaysStoreDiffs - ifTrue: [aVersion asDiffAgainst: - (self withCache closestAncestorVersionFor: aVersion info ifNone: [^ aVersion])] - ifFalse: [aVersion]! Item was removed: - ----- Method: MCRepository>>printOn: (in category 'printing') ----- - printOn: aStream - super printOn: aStream. - aStream - nextPut: $(; - nextPutAll: self description; - nextPut: $).! Item was removed: - ----- Method: MCRepository>>refresh (in category 'accessing') ----- - refresh - "Subclasses override if necessary."! Item was removed: - ----- Method: MCRepository>>repositories (in category 'accessing') ----- - repositories - ^{ self }! Item was removed: - ----- Method: MCRepository>>sendNotificationsForVersion: (in category 'notifying') ----- - sendNotificationsForVersion: aVersion - | notification notifyList | - notifyList := self notifyList. - notifyList isEmpty ifFalse: - [notification := self notificationForVersion: aVersion. - notifyList do: [:ea | notification notify: ea]]! Item was removed: - ----- Method: MCRepository>>storeVersion: (in category 'storing') ----- - storeVersion: aMCVersionOrConfiguration - self basicStoreVersion: (self prepareVersionForStorage: aMCVersionOrConfiguration). - self sendNotificationsForVersion: aMCVersionOrConfiguration! Item was removed: - ----- Method: MCRepository>>versionNamed: (in category 'versions') ----- - versionNamed: aMCVersionName - "Answer the MCVersion with name, aMCVersionName, or nil if it doesn't exist in this repository." - self subclassResponsibility! Item was removed: - ----- Method: MCRepository>>versionNamesForPackageNamed: (in category 'versions') ----- - versionNamesForPackageNamed: aString - "Answer a collection of MCVersionNames whose Package is named aString." - self subclassResponsibility! Item was removed: - ----- Method: MCRepository>>versionWithInfo: (in category 'versions') ----- - versionWithInfo: aVersionInfo - ^ self versionWithInfo: aVersionInfo ifAbsent: [nil]! Item was removed: - ----- Method: MCRepository>>versionWithInfo:ifAbsent: (in category 'versions') ----- - versionWithInfo: aVersionInfo ifAbsent: aBlock - self subclassResponsibility ! Item was removed: - ----- Method: MCRepository>>wasRemoved (in category 'user interface') ----- - wasRemoved - "Subclasses may override to, for example, disconnect a db session."! Item was removed: - ----- Method: MCRepository>>withCache (in category 'accessing') ----- - withCache - "Answer the receiver with package-cache in front of it." - ^ MCRepositoryGroup with: self! Item was removed: - Object subclass: #MCRepositoryGroup - instanceVariableNames: 'repositories' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Versioning'! - MCRepositoryGroup class - instanceVariableNames: 'default'! - - !MCRepositoryGroup commentStamp: '<historical>' prior: 0! - A singleton class, holds the list of repositories. Can look for a requested VersionInfo among its repositories.! - MCRepositoryGroup class - instanceVariableNames: 'default'! Item was removed: - ----- Method: MCRepositoryGroup class>>default (in category 'accessing') ----- - default - ^ default ifNil: [default := self new]! Item was removed: - ----- Method: MCRepositoryGroup class>>flushAllCaches (in category 'actions') ----- - flushAllCaches - self default flushCache! Item was removed: - ----- Method: MCRepositoryGroup class>>reset (in category 'actions') ----- - reset - default := nil! Item was removed: - ----- Method: MCRepositoryGroup class>>with: (in category 'instance creation') ----- - with: aMCRepository - ^ self new - addRepository: aMCRepository ; - yourself! Item was removed: - ----- Method: MCRepositoryGroup>>addRepository: (in category 'update') ----- - addRepository: aRepository - ((repositories includes: aRepository) or: [aRepository = MCCacheRepository default]) - ifFalse: [repositories add: aRepository. - self class default addRepository: aRepository]. - self changed: #repositories! Item was removed: - ----- Method: MCRepositoryGroup>>allPackageNames (in category 'repository-api') ----- - allPackageNames - ^ repositories - inject: Set new - into: - [ : set : each | set - addAll: each allPackageNames ; - yourself ]! Item was removed: - ----- Method: MCRepositoryGroup>>basicStoreVersion: (in category 'repository-api') ----- - basicStoreVersion: aVersion - "RepositoryGroup is used for reading, not writing." - self shouldNotImplement! Item was removed: - ----- Method: MCRepositoryGroup>>cacheAllFileNamesDuring: (in category 'private') ----- - cacheAllFileNamesDuring: aBlock - ^ (repositories - inject: aBlock - into: [ :innerBlock :repository | - [ repository cacheAllFileNamesDuring: innerBlock ] - ]) value! Item was removed: - ----- Method: MCRepositoryGroup>>cacheAllFilenames (in category 'private') ----- - cacheAllFilenames - repositories do: [ : each | each cacheAllFilenames ]! Item was removed: - ----- Method: MCRepositoryGroup>>closestAncestorVersionFor:ifNone: (in category 'accessing') ----- - closestAncestorVersionFor: anAncestry ifNone: errorBlock - anAncestry breadthFirstAncestorsDo: - [:ancestorInfo | - (self versionWithInfo: ancestorInfo) ifNotNil: [:v | ^ v]]. - ^ errorBlock value! Item was removed: - ----- Method: MCRepositoryGroup>>demoteRepository: (in category 'update') ----- - demoteRepository: aMCRepository - "If aMCRepository is part of this Group, demote it to the bottom of the list so that other repositories will be checked first." - | removed | - removed := repositories - remove: aMCRepository - ifAbsent: [ ]. - removed ifNotNil: - [ repositories addLast: aMCRepository. - self changed: #repositories ]! Item was removed: - ----- Method: MCRepositoryGroup>>description (in category 'repository-api') ----- - description - ^ String streamContents: - [ : stream | stream nextPutAll: '{ '. - repositories - do: [ : each | stream nextPut: $'; nextPutAll: each description; nextPut: $' ] - separatedBy: [ stream nextPutAll: '. ' ]. - stream nextPutAll: ' }' ]! Item was removed: - ----- Method: MCRepositoryGroup>>flushAllFilenames (in category 'private') ----- - flushAllFilenames - self repositories do: [ : each | each flushAllFilenames ]! Item was removed: - ----- Method: MCRepositoryGroup>>flushCache (in category 'repository-api') ----- - flushCache - self repositoriesDo: [ : each | each flushCache ]! Item was removed: - ----- Method: MCRepositoryGroup>>includes: (in category 'testing') ----- - includes: aRepository - ^ self repositories includes: aRepository! Item was removed: - ----- Method: MCRepositoryGroup>>includesVersionNamed: (in category 'repository-api') ----- - includesVersionNamed: aString - ^ repositories anySatisfy: [ : each | [each includesVersionNamed: aString] on: Error do: [false]]! Item was removed: - ----- Method: MCRepositoryGroup>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - repositories := OrderedCollection new! Item was removed: - ----- Method: MCRepositoryGroup>>isTrunk (in category 'testing') ----- - isTrunk - ^ false! Item was removed: - ----- Method: MCRepositoryGroup>>isValid (in category 'testing') ----- - isValid - - ^ repositories allSatisfy: #isValid! Item was removed: - ----- Method: MCRepositoryGroup>>morphicOpen: (in category 'ui') ----- - morphicOpen: aWorkingCopy - ^ self repositories do: [:repo | repo morphicOpen: aWorkingCopy].! Item was removed: - ----- Method: MCRepositoryGroup>>normalizedRepositories (in category 'accessing') ----- - normalizedRepositories - "Find an existing instance of any active repository so that we use whatever name and password the user usually uses. If not found, answer a copy" - ^ repositories collect: [ : each | each normalized ]! Item was removed: - ----- Method: MCRepositoryGroup>>removeRepository: (in category 'update') ----- - removeRepository: aRepository - | removed | - removed := repositories remove: aRepository ifAbsent: []. - removed ifNotNil: [ removed wasRemoved ]. - self changed: #repositories! Item was removed: - ----- Method: MCRepositoryGroup>>repositories (in category 'accessing') ----- - repositories - ^{ MCCacheRepository default }, repositories select: [ :ea | ea isValid ]! Item was removed: - ----- Method: MCRepositoryGroup>>repositoriesDo: (in category 'accessing') ----- - repositoriesDo: aBlock - self repositories do: [:ea | [aBlock value: ea] on: Error do: []]! Item was removed: - ----- Method: MCRepositoryGroup>>versionNamed: (in category 'repository-api') ----- - versionNamed: aMCVersionName - repositories do: - [ : each | (each versionNamed: aMCVersionName) ifNotNil: [ : ver | ^ ver ] ]. - ^ nil! Item was removed: - ----- Method: MCRepositoryGroup>>versionNamesForPackageNamed: (in category 'repository-api') ----- - versionNamesForPackageNamed: aString - ^ repositories - inject: Set new - into: - [ : set : each | set - addAll: - ([ each versionNamesForPackageNamed: aString ] - on: NetworkError - do: [ : err | Array empty ]) ; - yourself ]! Item was removed: - ----- Method: MCRepositoryGroup>>versionWithInfo: (in category 'accessing') ----- - versionWithInfo: aVersionInfo - ^self versionWithInfo: aVersionInfo ifNone: [ nil ] - ! Item was removed: - ----- Method: MCRepositoryGroup>>versionWithInfo:ifAbsent: (in category 'repository-api') ----- - versionWithInfo: aVersionInfo ifAbsent: aBlock - self repositories do: - [ : each | ([each - versionWithInfo: aVersionInfo - ifAbsent: [ nil ]] on: NetworkError do: [ : err | nil ]) ifNotNil: - [ : ver | ^ ver ] ]. - ^ aBlock value! Item was removed: - ----- Method: MCRepositoryGroup>>versionWithInfo:ifNone: (in category 'accessing') ----- - versionWithInfo: aVersionInfo ifNone: aBlock - self repositoriesDo: [:ea | (ea versionWithInfo: aVersionInfo) ifNotNil: [:v | ^ v]]. - ^aBlock value! Item was removed: - ----- Method: MCRepositoryGroup>>withCache (in category 'accessing') ----- - withCache - ^ self! Item was removed: - MCVersionInspector subclass: #MCRepositoryInspector - instanceVariableNames: 'repository packageNames versionNames selectedPackage selectedVersion order versionInfo loaded newer inherited inheritedId' - classVariableNames: 'BrowseBranchedVersionsSeparately Order' - poolDictionaries: '' - category: 'Monticello-UI'! Item was removed: - ----- Method: MCRepositoryInspector class>>browseBranchedVersionsSeparately (in category 'class initialization') ----- - browseBranchedVersionsSeparately - - <preference: 'Browse branched package versions separately' - category: 'Monticello' - description: 'If true, versions of packages on branches will be shown in a separate section from trunk package versions' - type: #Boolean> - ^BrowseBranchedVersionsSeparately ifNil: [true]! Item was removed: - ----- Method: MCRepositoryInspector class>>browseBranchedVersionsSeparately: (in category 'class initialization') ----- - browseBranchedVersionsSeparately: aBoolean - BrowseBranchedVersionsSeparately := aBoolean! Item was removed: - ----- Method: MCRepositoryInspector class>>initialize (in category 'class initialization') ----- - initialize - "self initialize" - - self migrateInstances! Item was removed: - ----- Method: MCRepositoryInspector class>>migrateInstances (in category 'class initialization') ----- - migrateInstances - self allSubInstancesDo: [:inst | - #(packageList versionList) do: [:each | - [(inst findListMorph: each) highlightSelector: nil] - on: Error do: [:ignore | ]]].! Item was removed: - ----- Method: MCRepositoryInspector class>>order (in category 'class initialization') ----- - order - Order isNil - ifTrue: [ Order := 5 ]. - ^Order! Item was removed: - ----- Method: MCRepositoryInspector class>>order: (in category 'class initialization') ----- - order: anInteger - Order := anInteger! Item was removed: - ----- Method: MCRepositoryInspector class>>repository:workingCopy: (in category 'instance creation') ----- - repository: aFileBasedRepository workingCopy: aWorkingCopy - ^self new - setRepository: aFileBasedRepository workingCopy: aWorkingCopy; - yourself! Item was removed: - ----- Method: MCRepositoryInspector>>defaultExtent (in category 'morphic ui') ----- - defaultExtent - ^600 at 300! Item was removed: - ----- Method: MCRepositoryInspector>>defaultLabel (in category 'morphic ui') ----- - defaultLabel - ^'Repository: ' , repository description! Item was removed: - ----- Method: MCRepositoryInspector>>hasVersion (in category 'morphic ui') ----- - hasVersion - ^ selectedVersion notNil! Item was removed: - ----- Method: MCRepositoryInspector>>identifyLoadedAndInherited: (in category 'morphic ui') ----- - identifyLoadedAndInherited: aMCWorkingCopy - | seen | - seen := Set new. - aMCWorkingCopy ancestors do: - [ : ancestor | loaded add: ancestor versionName. - seen add: ancestor. - ancestor ancestorsDoWhileTrue: - [ : heir | (seen includes: heir) - ifTrue: [ false ] - ifFalse: - [ inherited add: heir versionName. - inheritedId add: heir id. - seen add: heir. - true ] ] ]! Item was removed: - ----- Method: MCRepositoryInspector>>identifyNewerVersionsOf: (in category 'initialize-release') ----- - identifyNewerVersionsOf: aMCWorkingCopy - (repository possiblyNewerVersionsOfAnyOf: aMCWorkingCopy ancestry names) do: - [ : eachNewerVersionName | - newer add: (self class browseBranchedVersionsSeparately - ifTrue: [ eachNewerVersionName packageAndBranchName ] - ifFalse: [ eachNewerVersionName packageName ]) ]! Item was removed: - ----- Method: MCRepositoryInspector>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - self initializeEmphasis! Item was removed: - ----- Method: MCRepositoryInspector>>initializeEmphasis (in category 'initialize-release') ----- - initializeEmphasis - inherited := Set new. - inheritedId := Set new. - loaded := Set new! Item was removed: - ----- Method: MCRepositoryInspector>>initializeVersionNames (in category 'initialize-release') ----- - initializeVersionNames - repository cacheAllFileNamesDuring: - [ versionNames := selectedPackage - ifNil: [Array empty] - ifNotNil: [repository versionNamesForPackageNamed: selectedPackage]. - self refreshEmphasis ]! Item was removed: - ----- Method: MCRepositoryInspector>>load (in category 'actions') ----- - load - self hasVersion ifTrue: - [self version isCacheable - ifTrue: [version workingCopy repositoryGroup addRepository: repository]. - super load. - self refresh].! Item was removed: - ----- Method: MCRepositoryInspector>>merge (in category 'actions') ----- - merge - super merge. - self refresh. - ! Item was removed: - ----- Method: MCRepositoryInspector>>order: (in category 'morphic ui') ----- - order: anInteger - self class order: (order := anInteger). - self changed: #versionList.! Item was removed: - ----- Method: MCRepositoryInspector>>orderSpecs (in category 'morphic ui') ----- - orderSpecs - ^{ - 'unchanged' -> nil. - 'order by package' -> [ :x :y | x packageName < y packageName ]. - 'order by author' -> [ :x :y | x author caseInsensitiveLessOrEqual: y author ]. - 'order by version-string' -> [ :x :y | x versionNumber asString < y versionNumber asString ]. - 'order by version-number' -> [ :x :y | x versionNumber > y versionNumber ]. - 'order by filename' -> [ :x :y | x < y ]. - }! Item was removed: - ----- Method: MCRepositoryInspector>>orderString: (in category 'morphic ui') ----- - orderString: anIndex - ^String streamContents: [ :stream | - order = anIndex - ifTrue: [ stream nextPutAll: '<yes>' ] - ifFalse: [ stream nextPutAll: '<no>' ]. - stream nextPutAll: (self orderSpecs at: anIndex) key ]! Item was removed: - ----- Method: MCRepositoryInspector>>packageHighlight: (in category 'morphic ui') ----- - packageHighlight: loadedPackageAndMaybeBranchName - | packageName bold underline emphasis | - bold := TextEmphasis bold emphasisCode. - underline := TextEmphasis underlined emphasisCode. - packageName := loadedPackageAndMaybeBranchName copyUpTo: $.. - emphasis := (loaded detect: [:each| each packageName = packageName] ifNone: nil) ifNotNil: - [:mcVersionName| - self class browseBranchedVersionsSeparately - ifTrue: - [mcVersionName packageAndBranchName = loadedPackageAndMaybeBranchName - ifTrue: - [(newer includes: loadedPackageAndMaybeBranchName) - ifTrue: [bold + underline] - ifFalse: [underline]] - ifFalse: - [(newer includes: packageName) - ifTrue: [bold] - ifFalse: [nil]]] - ifFalse: - [(newer includes: loadedPackageAndMaybeBranchName) - ifTrue: [bold + underline] - ifFalse: [underline]]]. - ^emphasis - ifNil: [loadedPackageAndMaybeBranchName] - ifNotNil: - [Text - string: loadedPackageAndMaybeBranchName - attribute: (TextEmphasis new emphasisCode: emphasis)]! Item was removed: - ----- Method: MCRepositoryInspector>>packageList (in category 'morphic ui') ----- - packageList - | result loadedPackages | - packageNames ifNotNil: [ ^ packageNames ]. - repository cacheAllFileNamesDuring: - [ "Enjoy emphasis side-effects of populating my versionNames." - self versionNames. - result := self class browseBranchedVersionsSeparately - ifTrue: [ repository allPackageAndBranchNames ] - ifFalse: [ repository allPackageNames ] ]. - "sort loaded packages first, then alphabetically" - loadedPackages := loaded asSet collect: [ : each | each packageAndBranchName ]. - result := result asArray sort: - [ : a : b | | loadedA loadedB | - loadedA := loadedPackages includes: a. - loadedB := loadedPackages includes: b. - loadedA = loadedB - ifTrue: [ a < b ] - ifFalse: [ loadedA ] ]. - ^ packageNames := result collect: - [ : each | self packageHighlight: each ]! Item was removed: - ----- Method: MCRepositoryInspector>>packageListMenu: (in category 'morphic ui') ----- - packageListMenu: aMenu - ^aMenu! Item was removed: - ----- Method: MCRepositoryInspector>>packageSelection (in category 'morphic ui') ----- - packageSelection - ^self packageList indexOf: selectedPackage! Item was removed: - ----- Method: MCRepositoryInspector>>packageSelection: (in category 'morphic ui') ----- - packageSelection: aNumber - selectedPackage := (aNumber between: 1 and: self packageList size) - ifTrue: [ (self packageList at: aNumber) asString ]. - self versionSelection: 0. - versionNames := nil. - self changed: #packageSelection; changed: #versionList! Item was removed: - ----- Method: MCRepositoryInspector>>postAcceptBrowseFor: (in category 'initialize-release') ----- - postAcceptBrowseFor: aModel - "Make the same selections as in aModel." - self - packageSelection: aModel packageSelection ; - versionSelection: aModel versionSelection! Item was removed: - ----- Method: MCRepositoryInspector>>refresh (in category 'actions') ----- - refresh - packageNames := versionNames := newer := nil. - repository refresh. - self - changed: #packageList ; - changed: #versionList.! Item was removed: - ----- Method: MCRepositoryInspector>>refreshEmphasis (in category 'morphic ui') ----- - refreshEmphasis - | identifyNewer | - identifyNewer := newer isNil. - identifyNewer ifTrue: [ newer := Set new ]. - self initializeEmphasis. - MCWorkingCopy allManagers do: - [ : each | self identifyLoadedAndInherited: each. - identifyNewer ifTrue: [ self identifyNewerVersionsOf: each ] ]! Item was removed: - ----- Method: MCRepositoryInspector>>repository (in category 'access') ----- - repository - ^ repository! Item was removed: - ----- Method: MCRepositoryInspector>>representsSameBrowseeAs: (in category 'morphic ui') ----- - representsSameBrowseeAs: anotherModel - ^ self class = anotherModel class - and: [ self repository = anotherModel repository ]! Item was removed: - ----- Method: MCRepositoryInspector>>save (in category 'actions') ----- - save - self pickRepository ifNotNil: - [:repo | - (self repository = MCRepository inbox - and: [repo = MCRepository trunk or: [repo = MCRepository treated]]) ifTrue: - [self notify: 'Versions from the inbox should only be moved, not copied. Instead, use the web interface via source.squeak.org to manage inbox contributions.\\Do you want to proceed anyway?' translated withCRs]. - repo storeVersion: self version]! Item was removed: - ----- Method: MCRepositoryInspector>>selectedVersionIsFalseAncestor (in category 'testing') ----- - selectedVersionIsFalseAncestor - "Answer true if selectedVersion is a false ancestor of working copy. - An ancestor of working copy that has same name, but not same id is a false ancestor!!" - ^(selectedVersion notNil - and: [(inherited includes: selectedVersion versionName) - and: [(inheritedId includes: self versionInfo id) not]])! Item was removed: - ----- Method: MCRepositoryInspector>>setRepository:workingCopy: (in category 'initialize-release') ----- - setRepository: aFileBasedRepository workingCopy: aWorkingCopy - order := self class order. - repository := aFileBasedRepository. - self refresh. - aWorkingCopy - ifNil: [ self packageSelection: 1 ] - ifNotNil: - [ selectedPackage := aWorkingCopy ancestry ancestors ifNotEmpty: - [ : ancestors | ancestors anyOne name asMCVersionName packageAndBranchName ] ]. - MCWorkingCopy addDependent: self! Item was removed: - ----- Method: MCRepositoryInspector>>summary (in category 'morphic ui') ----- - summary - self selectedVersionIsFalseAncestor - ifTrue: [^ (Text string: 'Beware, this is a false ancestor whose name conflicts with a true one\' withCRs attributes: {TextColor red. TextEmphasis bold}) - , super summary]. - ^ super summary! Item was removed: - ----- Method: MCRepositoryInspector>>version (in category 'morphic ui') ----- - version - ^ version ifNil: - [Cursor wait showWhile: - [version := repository versionNamed: selectedVersion]. - version]! Item was removed: - ----- Method: MCRepositoryInspector>>versionHighlight: (in category 'morphic ui') ----- - versionHighlight: aMCVersionName - inherited ifNil: [inherited := #()]. - inheritedId ifNil: [inheritedId := #()]. - (selectedVersion notNil - and: [selectedVersion = aMCVersionName - and: [self selectedVersionIsFalseAncestor]]) - ifTrue: ["False ancestor might be dangerous, signal them in red" - ^ Text string: aMCVersionName attributes: {TextColor red. TextEmphasis bold}]. - ^ Text - string: aMCVersionName - attribute: (TextEmphasis new - emphasisCode: ((loaded includes: aMCVersionName) - ifTrue: ["underlined" 4] - ifFalse: [(inherited includes: aMCVersionName) - ifTrue: [0] - ifFalse: ["bold" 1]]))! Item was removed: - ----- Method: MCRepositoryInspector>>versionList (in category 'morphic ui') ----- - versionList - | result | - result := selectedPackage - ifNil: [ self versionNamesForNoPackageSelection ] - ifNotNil: [ self versionNamesForSelectedPackage ]. - (self orderSpecs at: order) value ifNotNil: - [ : sortBlock | - result sort: sortBlock ]. - ^result collect: - [ : each | self versionHighlight: each ]! Item was removed: - ----- Method: MCRepositoryInspector>>versionListMenu: (in category 'morphic ui') ----- - versionListMenu: aMenu - 1 to: self orderSpecs size do: [ :index | - aMenu addUpdating: #orderString: target: self selector: #order: argumentList: { index } ]. - aMenu addLine. - aMenu add: 'Changes against ...' action: [| ri | - ri := aMenu defaultTarget. - (UIManager default - chooseFrom: ri versionList - values: ri versionList - title: 'Select version to show patch against ...') ifNotNil: [:name | - | versionName target base | - versionName := MCVersionName on: name. - target := ri repository versionNamed: ri versionInfo name. - base := aMenu defaultTarget repository versionNamed: versionName. - (MCPatchBrowser - forPatch: (target snapshot patchRelativeToBase: base snapshot)) - showLabelled: 'Changes from ', versionName, ' to ', ri versionInfo name]]. - ^aMenu! Item was removed: - ----- Method: MCRepositoryInspector>>versionNames (in category 'access') ----- - versionNames - ^ versionNames ifNil: - [ self initializeVersionNames. - versionNames ]! Item was removed: - ----- Method: MCRepositoryInspector>>versionNamesForNoPackageSelection (in category 'access') ----- - versionNamesForNoPackageSelection - ^ Array empty! Item was removed: - ----- Method: MCRepositoryInspector>>versionNamesForSelectedPackage (in category 'morphic ui') ----- - versionNamesForSelectedPackage - ^ self versionNames! Item was removed: - ----- Method: MCRepositoryInspector>>versionSelection (in category 'morphic ui') ----- - versionSelection - ^self versionList indexOf: selectedVersion! Item was removed: - ----- Method: MCRepositoryInspector>>versionSelection: (in category 'morphic ui') ----- - versionSelection: aNumber - selectedVersion := version := nil. - aNumber isZero ifFalse: [ selectedVersion := (self versionList at: aNumber) asString ]. - self selectedVersionIsFalseAncestor ifTrue: [self changed: #versionList]. - self - changed: #versionSelection ; - changed: #summary ; - changed: #hasVersion! Item was removed: - ----- Method: MCRepositoryInspector>>widgetSpecs (in category 'morphic ui') ----- - widgetSpecs - ^#( ((buttonRow) (0 0 1 0) (0 0 0 defaultButtonPaneHeight)) - ((listMorph: package) (0 0 0.5 0.6) (0 defaultButtonPaneHeight 0 0)) - ((listMorph: version) (0.5 0 1 0.6) (0 defaultButtonPaneHeight 0 0)) - ((textMorph: summary) (0 0.6 1 1) (0 0 0 0)) )! Item was removed: - Notification subclass: #MCRepositoryRequest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-UI'! Item was removed: - MCFileBasedRepository subclass: #MCSMCacheRepository - instanceVariableNames: 'smCache' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Repositories'! - - !MCSMCacheRepository commentStamp: 'nk 1/23/2004 09:57' prior: 0! - I am a Monticello repository that reflects the caching of SqueakMap v2. - - I refer write attempts to the default MCCacheRepository.! Item was removed: - ----- Method: MCSMCacheRepository class>>description (in category 'instance creation') ----- - description - ^ 'SqueakMap Cache'! Item was removed: - ----- Method: MCSMCacheRepository class>>morphicConfigure (in category 'instance creation') ----- - morphicConfigure - ^self new! Item was removed: - ----- Method: MCSMCacheRepository>>allFullFileNames (in category 'accessing') ----- - allFullFileNames - | cachedPackages | - cachedPackages := smCache map installedPackages select: [ :ea | ea isCached ]. - ^Array streamContents: [ :s | - cachedPackages do: [ :ea | | d | - d := ea cacheDirectory. - (d fileNamesMatching: '*.mcz') do: [ :fn | s nextPut: (d fullNameFor: fn) ]]]! Item was removed: - ----- Method: MCSMCacheRepository>>description (in category 'user interface') ----- - description - ^ smCache directory pathName! Item was removed: - ----- Method: MCSMCacheRepository>>directory (in category 'accessing') ----- - directory - ^ smCache directory! Item was removed: - ----- Method: MCSMCacheRepository>>directory: (in category 'accessing') ----- - directory: aDirectory - ! Item was removed: - ----- Method: MCSMCacheRepository>>fullNameFor: (in category 'accessing') ----- - fullNameFor: aFileName - ^self allFullFileNames detect: [ :ffn | (self directory localNameFor: ffn) = aFileName ] ifNone: []! Item was removed: - ----- Method: MCSMCacheRepository>>hash (in category 'comparing') ----- - hash - ^ smCache hash! Item was removed: - ----- Method: MCSMCacheRepository>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - Smalltalk at: #SMSqueakMap ifPresent:[:aClass| - smCache := aClass default cache. - ].! Item was removed: - ----- Method: MCSMCacheRepository>>isValid (in category 'testing') ----- - isValid - ^smCache notNil and: [ self directory exists ]! Item was removed: - ----- Method: MCSMCacheRepository>>readStreamForFileNamed:do: (in category 'file streaming') ----- - readStreamForFileNamed: aString do: aBlock - | file fileName | - fileName := self fullNameFor: aString. - fileName ifNil: [ - "assume that this will come from the cache." - ^MCCacheRepository default readStreamForFileNamed: aString do: aBlock ]. - file := FileStream readOnlyFileNamed: fileName. - ^[ aBlock value: file ] ensure: [ file close ]. - ! Item was removed: - ----- Method: MCSMCacheRepository>>smCache (in category 'accessing') ----- - smCache - ^smCache! Item was removed: - ----- Method: MCSMCacheRepository>>smCache: (in category 'accessing') ----- - smCache: aSMFileCache - | | - smCache := aSMFileCache. - self directory: aSMFileCache directory. - ! Item was removed: - ----- Method: MCSMCacheRepository>>writeStreamForFileNamed:replace:do: (in category 'file streaming') ----- - writeStreamForFileNamed: aString replace: aBoolean do: aBlock - "Can't write into the SM cache, so..." - ^MCCacheRepository default writeStreamForFileNamed: aString replace: aBoolean do: aBlock! Item was removed: - MCWriteOnlyRepository subclass: #MCSMReleaseRepository - instanceVariableNames: 'packageName user password' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Repositories'! Item was removed: - ----- Method: MCSMReleaseRepository class>>creationTemplate (in category 'configuring') ----- - creationTemplate - ^ - 'MCSMReleaseRepository - package: ''mypackage'' - user: ''squeak'' - password: ''squeak''' - ! Item was removed: - ----- Method: MCSMReleaseRepository class>>description (in category 'configuring') ----- - description - ^ 'SqueakMap Release'! Item was removed: - ----- Method: MCSMReleaseRepository class>>fillInTheBlankRequest (in category 'configuring') ----- - fillInTheBlankRequest - ^ 'SqueakMap Release Repository:' - ! Item was removed: - ----- Method: MCSMReleaseRepository class>>morphicConfigure (in category 'configuring') ----- - morphicConfigure - ^ self fillInTheBlankConfigure! Item was removed: - ----- Method: MCSMReleaseRepository class>>package:user:password: (in category 'instance creation') ----- - package: packageString user: userString password: passString - ^ self basicNew initializeWithPackage: packageString user: userString password: passString! Item was removed: - ----- Method: MCSMReleaseRepository>>basicStoreVersion: (in category 'private') ----- - basicStoreVersion: aVersion - | url | - url := self uploadVersion: aVersion. - self releaseVersion: aVersion url: url! Item was removed: - ----- Method: MCSMReleaseRepository>>checkResult: (in category 'private') ----- - 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 removed: - ----- Method: MCSMReleaseRepository>>description (in category 'user interface') ----- - description - ^ 'sm://', packageName! Item was removed: - ----- Method: MCSMReleaseRepository>>initializeWithPackage:user:password: (in category 'private') ----- - initializeWithPackage: packageString user: userString password: passString - packageName := packageString. - user := userString. - password := passString. - ! Item was removed: - ----- Method: MCSMReleaseRepository>>releaseVersion:url: (in category 'private') ----- - 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 removed: - ----- Method: MCSMReleaseRepository>>squeakMapUrl (in category 'constants') ----- - squeakMapUrl - ^ 'http://localhost:9070/sm' - ! Item was removed: - ----- Method: MCSMReleaseRepository>>stringForVersion: (in category 'private') ----- - stringForVersion: aVersion - | stream | - stream := RWBinaryOrTextStream on: String new. - aVersion fileOutOn: stream. - ^ stream contents! Item was removed: - ----- Method: MCSMReleaseRepository>>uploadVersion: (in category 'private') ----- - 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 removed: - MCPatchBrowser subclass: #MCSaveVersionDialog - instanceVariableNames: 'name message ignore patchBlock' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-UI'! Item was removed: - ----- Method: MCSaveVersionDialog>>accept (in category 'actions') ----- - accept - | logMessage logMessageWidget | - self updateItems. - logMessage := (logMessageWidget := self anyTextPaneWithSelector: #logMessage) text asString. - (logMessage isEmpty or: [logMessage beginsWith: 'empty log message']) - ifTrue: - [(Project uiManager confirm: 'The log message is empty. Are you sure you want to commit anyway?' translated) ifFalse: [^ self]] - ifFalse: [logMessageWidget accept]. - self answer: { - (self anyTextPaneWithSelector: #versionName) text asString. - logMessage. - ignore }! Item was removed: - ----- Method: MCSaveVersionDialog>>adoptMessageInCurrentChangeset (in category 'menus') ----- - adoptMessageInCurrentChangeset - - selection ifNotNil: [^ super adoptMessageInCurrentChangeset]. - - (items copyWithoutAll: ignore) select: [:each | each definition isMethodDefinition] thenDo: [:item | - self forItem: item setClassAndSelectorIn: [:class :selector | - ((item isAddition or: [item isModification]) and: [class includesSelector: selector]) - ifTrue: [ChangeSet current adoptSelector: selector forClass: class]. - item isRemoval - ifTrue: [ChangeSet current removeSelector: selector class: class priorMethod: nil lastMethodInfo: nil]]]. - self changed: #annotations.! Item was removed: - ----- Method: MCSaveVersionDialog>>buttonSpecs (in category 'ui') ----- - buttonSpecs - - ^ #( - ((button: (Accept accept 'accept version name and log message'))) - ((button: (Cancel cancel 'cancel saving version'))) - ) ! Item was removed: - ----- Method: MCSaveVersionDialog>>cancel (in category 'actions') ----- - cancel - - self wasInterrupted - ifTrue: [self close] - ifFalse: [self answer: nil].! Item was removed: - ----- Method: MCSaveVersionDialog>>defaultExtent (in category 'ui') ----- - defaultExtent - ^ 700 at 600! Item was removed: - ----- Method: MCSaveVersionDialog>>defaultLabel (in category 'ui') ----- - defaultLabel - ^ 'Edit Version Name and Message: ', self name! Item was removed: - ----- Method: MCSaveVersionDialog>>ignore (in category 'actions') ----- - ignore - ^ ignore ifNil: [ignore := Set new]! Item was removed: - ----- Method: MCSaveVersionDialog>>ignoreSelection (in category 'actions') ----- - ignoreSelection - selection - ifNil: [ignore size = items size - ifFalse: [ignore addAll: items] - ifTrue: [ignore removeAll]] - ifNotNil: [ - ignore remove: selection ifAbsent: [ - ignore add: selection]. - self advanceSelection]. - self changed: #list - ! Item was removed: - ----- Method: MCSaveVersionDialog>>installSelection (in category 'actions') ----- - installSelection - super installSelection. - selection ifNotNil: [ - ignore remove: selection ifAbsent: []. - self changed: #list]. - - ! Item was removed: - ----- Method: MCSaveVersionDialog>>list (in category 'accessing') ----- - list - ^ self items collect: [:each | - (self reverts includes: each) - ifFalse: [(self ignore includes: each) - ifFalse: [each summary] - ifTrue: [Text - string: '( ', each summary, ' )' - attributes: (self userInterfaceTheme ignoredOperationAttributes ifNil: [{TextColor color: Color gray}])]] - ifTrue: [Text - string: '( ', each summary, ' )' - attributes: (self userInterfaceTheme revertedOperationAttributes ifNil: [ {TextEmphasis struckOut} ]) ]]! Item was removed: - ----- Method: MCSaveVersionDialog>>logMessage (in category 'accessing') ----- - logMessage - ^ message ifNil: ['empty log message']! Item was removed: - ----- Method: MCSaveVersionDialog>>logMessage: (in category 'accessing') ----- - logMessage: aString - message := aString. - self changed: #logMessage! Item was removed: - ----- Method: MCSaveVersionDialog>>message (in category 'accessing') ----- - message - - ^ message! Item was removed: - ----- Method: MCSaveVersionDialog>>message: (in category 'accessing') ----- - message: anObject - - message := anObject! Item was removed: - ----- Method: MCSaveVersionDialog>>methodListKey:from: (in category 'menus') ----- - methodListKey: aKeystroke from: aListMorph - aKeystroke caseOf: { - [$I] -> [self ignoreSelection]. - [$e] -> [self refresh]. - } otherwise: [super methodListKey: aKeystroke from: aListMorph ]! Item was removed: - ----- Method: MCSaveVersionDialog>>methodListMenu: (in category 'menus') ----- - methodListMenu: aMenu - super methodListMenu: aMenu. - aMenu addList:#(- - ('ignore (I)' ignoreSelection 'Toggle inclusion of this change when saving.') - ('refresh (e)' refresh 'Refresh the list of changes to this package.')). - ^aMenu! Item was removed: - ----- Method: MCSaveVersionDialog>>name (in category 'accessing') ----- - name - ^ name! Item was removed: - ----- Method: MCSaveVersionDialog>>name: (in category 'accessing') ----- - name: anObject - - name := anObject! Item was removed: - ----- Method: MCSaveVersionDialog>>okToClose (in category 'actions') ----- - okToClose - ^ (self anyTextPaneWithSelector: #logMessage) - ifNil: [true] - ifNotNil: - [:widget | widget canDiscardEdits or: [self confirm: 'Version notes are not saved. - Is it OK to discard those notes?' translated]]! Item was removed: - ----- Method: MCSaveVersionDialog>>patchBlock (in category 'accessing') ----- - patchBlock - - ^ patchBlock! Item was removed: - ----- Method: MCSaveVersionDialog>>patchBlock: (in category 'accessing') ----- - patchBlock: anObject - - patchBlock := anObject. - self updateItems! Item was removed: - ----- Method: MCSaveVersionDialog>>refresh (in category 'actions') ----- - refresh - | latestSelection | - latestSelection := self selection. - self updateItems. - self - selection: latestSelection; - changed: #list; - changed: #text.! Item was removed: - ----- Method: MCSaveVersionDialog>>representsSameBrowseeAs: (in category 'ui') ----- - representsSameBrowseeAs: anotherModel - ^ self class = anotherModel class - and: [ self versionName = anotherModel versionName ]! Item was removed: - ----- Method: MCSaveVersionDialog>>updateItems (in category 'ui') ----- - updateItems - " update our items using the patchBlock " - self patch: patchBlock value! Item was removed: - ----- Method: MCSaveVersionDialog>>versionName (in category 'accessing') ----- - versionName - ^ name! Item was removed: - ----- Method: MCSaveVersionDialog>>versionName: (in category 'accessing') ----- - versionName: aString - name := aString. - self changed: #versionName! Item was removed: - ----- Method: MCSaveVersionDialog>>widgetSpecs (in category 'ui') ----- - widgetSpecs - ^ #( - ((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 0.5 0.6) (0 0 0 defaultAnnotationPaneHeightNegated) ) - ((inputMorph: versionName) (0.5 0 1 0) (0 0 0 defaultInputFieldHeight)) - ((textMorph: logMessage) (0.5 0 1 0.6) (0 defaultInputFieldHeight 0 defaultAnnotationPaneHeightNegated)) - ((buttonRow) (0.5 0.6 1 0.6) (0 defaultAnnotationPaneHeightNegated 0 0)) - ((textMorph: annotations) (0 0.6 0.5 0.6) (0 defaultAnnotationPaneHeightNegated 0 0)) - ((textMorph: text) (0 0.6 1 1) (0 0 0 0)) - )! Item was removed: - Object subclass: #MCScanner - instanceVariableNames: 'stream' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Chunk Format'! Item was removed: - ----- Method: MCScanner class>>scan: (in category 'instance creation') ----- - scan: aStream - ^ (self new stream: aStream) next! Item was removed: - ----- Method: MCScanner class>>scanTokens: (in category 'instance creation') ----- - scanTokens: aString - "compatibility" - ^{ self scan: aString readStream }! Item was removed: - ----- Method: MCScanner>>next (in category 'scanning') ----- - 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 removed: - ----- Method: MCScanner>>nextArray (in category 'scanning') ----- - 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 removed: - ----- Method: MCScanner>>nextString (in category 'scanning') ----- - nextString - ^ stream nextDelimited: $'! Item was removed: - ----- Method: MCScanner>>nextSymbol (in category 'scanning') ----- - nextSymbol - ^ (String streamContents: - [:s | - [stream peek isAlphaNumeric] whileTrue: [s nextPut: stream next]]) asSymbol - ! Item was removed: - ----- Method: MCScanner>>stream: (in category 'accessing') ----- - stream: aStream - stream := aStream! Item was removed: - MCDefinition subclass: #MCScriptDefinition - instanceVariableNames: 'script packageName' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Modeling'! Item was removed: - ----- Method: MCScriptDefinition class>>from: (in category 'instance creation') ----- - from: aPackageInfo - ^ self script: (aPackageInfo perform: self scriptSelector) contents asString packageName: aPackageInfo name! Item was removed: - ----- Method: MCScriptDefinition class>>script:packageName: (in category 'instance creation') ----- - script: aString packageName: packageString - ^ self instanceLike: (self new initializeWithScript: aString packageName: packageString)! Item was removed: - ----- Method: MCScriptDefinition class>>scriptSelector (in category 'private - instance creation') ----- - scriptSelector - self subclassResponsibility! Item was removed: - ----- Method: MCScriptDefinition class>>scriptSelector:script:packageName: (in category 'instance creation') ----- - scriptSelector: selectorString script: aString packageName: packageString - ^ (self subclassForScriptSelector: selectorString) - script: aString packageName: packageString! Item was removed: - ----- Method: MCScriptDefinition class>>subclassForScriptSelector: (in category 'private - instance creation') ----- - subclassForScriptSelector: selectorString - ^self allSubclasses detect: [:ea | ea scriptSelector = selectorString]! Item was removed: - ----- Method: MCScriptDefinition>>= (in category 'comparing') ----- - = aDefinition - ^ (super = aDefinition) - and: [script = aDefinition script]! Item was removed: - ----- Method: MCScriptDefinition>>accept: (in category 'visiting') ----- - accept: aVisitor - aVisitor visitScriptDefinition: self! Item was removed: - ----- Method: MCScriptDefinition>>description (in category 'accessing') ----- - description - ^{ packageName. self scriptSelector }! Item was removed: - ----- Method: MCScriptDefinition>>evaluate (in category 'installing') ----- - evaluate - Compiler evaluate: script environment: Environment current! Item was removed: - ----- Method: MCScriptDefinition>>initializeWithScript:packageName: (in category 'initializing') ----- - initializeWithScript: aString packageName: packageString - script := aString. - packageName := packageString! Item was removed: - ----- Method: MCScriptDefinition>>installScript (in category 'installing') ----- - installScript - self installScript: script! Item was removed: - ----- Method: MCScriptDefinition>>installScript: (in category 'installing') ----- - installScript: aString - | sel pi | - sel := (self scriptSelector, ':') asSymbol. - pi := self packageInfo. - (pi respondsTo: sel) - ifTrue: [pi perform: sel with: aString]! Item was removed: - ----- Method: MCScriptDefinition>>isScriptDefinition (in category 'testing') ----- - isScriptDefinition - ^true! Item was removed: - ----- Method: MCScriptDefinition>>load (in category 'installing') ----- - load - self installScript! Item was removed: - ----- Method: MCScriptDefinition>>packageInfo (in category 'accessing') ----- - packageInfo - ^ PackageInfo named: packageName! Item was removed: - ----- Method: MCScriptDefinition>>packageName (in category 'accessing') ----- - packageName - ^ packageName! Item was removed: - ----- Method: MCScriptDefinition>>script (in category 'accessing') ----- - script - ^ script! Item was removed: - ----- Method: MCScriptDefinition>>scriptSelector (in category 'accessing') ----- - scriptSelector - ^ self class scriptSelector! Item was removed: - ----- Method: MCScriptDefinition>>sortKey (in category 'accessing') ----- - sortKey - ^ '!!', self scriptSelector "force to the front so it gets loaded first"! Item was removed: - ----- Method: MCScriptDefinition>>source (in category 'accessing') ----- - source - ^ script! Item was removed: - ----- Method: MCScriptDefinition>>summary (in category 'accessing') ----- - summary - ^ packageName, ' package ', self scriptSelector! Item was removed: - ----- Method: MCScriptDefinition>>unload (in category 'installing') ----- - unload - self installScript: nil! Item was removed: - MCDoItParser subclass: #MCScriptParser - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Chunk Format'! Item was removed: - ----- Method: MCScriptParser class>>pattern (in category 'constants') ----- - pattern - ^'(PackageInfo named: *'! Item was removed: - ----- Method: MCScriptParser>>addDefinitionsTo: (in category 'evaluating') ----- - 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 removed: - MCWriteOnlyRepository subclass: #MCSmtpRepository - instanceVariableNames: 'email' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Repositories'! Item was removed: - ----- Method: MCSmtpRepository class>>description (in category 'configuring') ----- - description - ^ 'SMTP'! Item was removed: - ----- Method: MCSmtpRepository class>>morphicConfigure (in category 'configuring') ----- - morphicConfigure - | address | - address := UIManager default request: 'Email address:'. - ^ address isEmpty ifFalse: [self new emailAddress: address]! Item was removed: - ----- Method: MCSmtpRepository>>basicStoreVersion: (in category 'private') ----- - basicStoreVersion: aVersion - MailSender sendMessage: (self messageForVersion: aVersion)! Item was removed: - ----- Method: MCSmtpRepository>>bodyForVersion: (in category 'converting') ----- - bodyForVersion: aVersion - ^ String streamContents: - [ :s | - s nextPutAll: 'from version info:'; cr; cr. - s nextPutAll: aVersion info summary]! Item was removed: - ----- Method: MCSmtpRepository>>description (in category 'user interface') ----- - description - ^ 'mailto://', email! Item was removed: - ----- Method: MCSmtpRepository>>emailAddress: (in category 'accessing') ----- - emailAddress: aString - email := aString ! Item was removed: - ----- Method: MCSmtpRepository>>messageForVersion: (in category 'converting') ----- - 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 removed: - ----- Method: MCSmtpRepository>>subjectForVersion: (in category 'converting') ----- - subjectForVersion: aVersion - ^ '[Package] ', aVersion info name! Item was removed: - Object subclass: #MCSnapshot - instanceVariableNames: 'definitions' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Base'! - - !MCSnapshot commentStamp: 'hjh 1/22/2013 22:26' prior: 0! - A MCSnapshot is a snapshot of an MCPackage. It is a collection of MCDefinitions. - - ! Item was removed: - ----- Method: MCSnapshot class>>empty (in category 'as yet unclassified') ----- - empty - ^ self fromDefinitions: #()! Item was removed: - ----- Method: MCSnapshot class>>fromDefinitions: (in category 'as yet unclassified') ----- - fromDefinitions: aCollection - ^ self new initializeWithDefinitions: aCollection! Item was removed: - ----- Method: MCSnapshot>>= (in category 'accessing') ----- - = other - self == other ifTrue: [ ^ true ]. - self species = other species ifFalse: [ ^ false ]. - ^ definitions asArray = other definitions asArray! Item was removed: - ----- Method: MCSnapshot>>definitions (in category 'accessing') ----- - definitions - ^ definitions! Item was removed: - ----- Method: MCSnapshot>>hash (in category 'accessing') ----- - hash - ^ definitions asArray hash! Item was removed: - ----- Method: MCSnapshot>>initializeWithDefinitions: (in category 'initializing') ----- - initializeWithDefinitions: aCollection - definitions := aCollection.! Item was removed: - ----- Method: MCSnapshot>>install (in category 'loading') ----- - install - MCPackageLoader installSnapshot: self! Item was removed: - ----- Method: MCSnapshot>>patchRelativeToBase: (in category 'patching') ----- - patchRelativeToBase: aSnapshot - ^ MCPatch fromBase: aSnapshot target: self! Item was removed: - ----- Method: MCSnapshot>>updatePackage: (in category 'loading') ----- - updatePackage: aPackage - MCPackageLoader updatePackage: aPackage withSnapshot: self! Item was removed: - MCCodeTool subclass: #MCSnapshotBrowser - instanceVariableNames: 'categorySelection classSelection protocolSelection methodSelection switch' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-UI'! Item was removed: - ----- Method: MCSnapshotBrowser class>>forSnapshot: (in category 'instance creation') ----- - forSnapshot: aSnapshot - ^ self new snapshot: aSnapshot! Item was removed: - ----- Method: MCSnapshotBrowser>>aboutToStyle: (in category 'styling') ----- - aboutToStyle: aStyler - - | classDefinition shouldStyle | - classSelection ifNil: [ ^false ]. - self switchIsComment ifTrue: [ ^false ]. - methodSelection - ifNotNil: [ - classDefinition := items - detect: [:ea | - ea isClassDefinition and: [ ea className = classSelection ] ] - ifNone: [ - (Smalltalk at: classSelection ifAbsent: [ Object ]) asClassDefinition ]. - shouldStyle := true ] - ifNil: [ - classDefinition := nil. - shouldStyle := categorySelection ~= self extensionsCategory ]. - (Smalltalk classNamed: #SHMCClassDefinition) - ifNil: [ ^false ] - ifNotNil: [ :SHMCClassDefinition | - aStyler - environment: self; - classOrMetaClass: (classDefinition ifNotNil: [ - SHMCClassDefinition - classDefinition: classDefinition - items: items - meta: switch = #class ]) ]. - ^shouldStyle! Item was removed: - ----- Method: MCSnapshotBrowser>>allClassNames (in category 'accessing') ----- - allClassNames - ^ (items - select: [:ea | (ea isOrganizationDefinition | ea isScriptDefinition) not] - thenCollect: [:ea | ea className]) asSet. - ! Item was removed: - ----- Method: MCSnapshotBrowser>>annotations (in category 'text') ----- - annotations - methodSelection ifNotNil: [^ methodSelection annotations ]. - ^ ''! Item was removed: - ----- Method: MCSnapshotBrowser>>annotations: (in category 'text') ----- - annotations: stuff - self changed: #annotations! Item was removed: - ----- Method: MCSnapshotBrowser>>bindingOf: (in category 'binding') ----- - bindingOf: aSymbol - - (Smalltalk bindingOf: aSymbol) ifNotNil: [ :binding | ^binding ]. - items do: [ :each | - (each isClassDefinition and: [ - each className = aSymbol ]) ifTrue: [ ^aSymbol -> each ] ]. - ^nil! Item was removed: - ----- Method: MCSnapshotBrowser>>buttonSpecs (in category 'morphic ui') ----- - buttonSpecs - ^ #( - ((button: ('instance' switchBeInstance 'show instance' buttonEnabled switchIsInstance))) - ((button: ('class' switchBeClass 'show class' buttonEnabled switchIsClass))) - ((spacer)) - ((button: ('?' switchBeComment 'show comment' buttonEnabled switchIsComment shrinkWrap))) - )! Item was removed: - ----- Method: MCSnapshotBrowser>>categoryList (in category 'listing') ----- - categoryList - ^ self visibleCategories! Item was removed: - ----- Method: MCSnapshotBrowser>>categoryListMenu: (in category 'menus') ----- - categoryListMenu: aMenu - categorySelection - ifNotNil: [aMenu - add: (categorySelection = '*Extensions' - ifTrue: ['load all extension methods' translated] - ifFalse: ['load class category {1}' translated format: {categorySelection}]) - action: #loadCategorySelection]. - ^ aMenu! Item was removed: - ----- Method: MCSnapshotBrowser>>categorySelection (in category 'selecting') ----- - categorySelection - ^ categorySelection ifNil: [0] ifNotNil: [self visibleCategories indexOf: categorySelection]! Item was removed: - ----- Method: MCSnapshotBrowser>>categorySelection: (in category 'selecting') ----- - categorySelection: aNumber - categorySelection := aNumber = 0 ifFalse: [self visibleCategories at: aNumber]. - self classSelection: 0. - self changed: #categorySelection; - changed: #annotations; - changed: #classList. - ! Item was removed: - ----- Method: MCSnapshotBrowser>>classCommentString (in category 'text') ----- - classCommentString - ^ (items - detect: [:ea | ea isClassDefinition and: [ea className = classSelection]] - ifNone: [^ '']) comment.! Item was removed: - ----- Method: MCSnapshotBrowser>>classDefinitionString (in category 'text') ----- - classDefinitionString - | defs | - defs := items select: [:ea | (ea isClassDefinition or: [ea isClassDefinitionExtension]) - and: [ea className = classSelection]]. - - defs isEmpty ifTrue: [^ 'This class is defined elsewhere.']. - - ^ String streamContents: [:stream | - defs asArray sort - do: [:ea | ea printDefinitionOn: stream] - separatedBy: [stream nextPut: $.; cr] - ].! Item was removed: - ----- Method: MCSnapshotBrowser>>classList (in category 'listing') ----- - classList - ^ categorySelection = self extensionsCategory - ifTrue: [self labeledClassnames: self visibleClasses] - ifFalse: [self visibleClasses]! Item was removed: - ----- Method: MCSnapshotBrowser>>classListMenu: (in category 'menus') ----- - classListMenu: aMenu - classSelection ifNil: [ ^aMenu ]. - - super classListMenu: aMenu. - - aMenu - addLine; - add: ('load class {1}' translated format: {classSelection}) - action: #loadClassSelection; - add: ('load class {1} into other Environment...' translated format: {classSelection}) - action: #loadClassSelectionIntoOtherEnvironment. - ^ aMenu! Item was removed: - ----- Method: MCSnapshotBrowser>>classSelection (in category 'selecting') ----- - classSelection - ^ classSelection ifNil: [0] ifNotNil: [self visibleClasses indexOf: classSelection]! Item was removed: - ----- Method: MCSnapshotBrowser>>classSelection: (in category 'selecting') ----- - classSelection: aNumber - classSelection := aNumber = 0 ifFalse: [self visibleClasses at: aNumber]. - self protocolSelection: 0. - self changed: #classSelection; changed: #protocolList. - (self protocolList size = 1 - and: [self protocolList first first = $*]) - ifTrue: - [self protocolSelection: 1] - ifFalse: - [self changed: #annotations; - changed: #methodList] - ! Item was removed: - ----- Method: MCSnapshotBrowser>>defaultAnnotationPaneHeight (in category 'morphic ui') ----- - defaultAnnotationPaneHeight - "Overwritten to show only a single line of text. We do no compare versions here." - - ^ ToolBuilder default inputFieldHeight! Item was removed: - ----- Method: MCSnapshotBrowser>>defaultButtonRowSpacing (in category 'morphic ui') ----- - defaultButtonRowSpacing - "Overwritten to make our class switches buttons look like the ones in the regular system browser." - - ^ (-1 "px" * RealEstateAgent scaleFactor) truncated! Item was removed: - ----- Method: MCSnapshotBrowser>>defaultExtent (in category 'morphic ui') ----- - defaultExtent - ^ 650 at 400.! Item was removed: - ----- Method: MCSnapshotBrowser>>defaultLabel (in category 'morphic ui') ----- - defaultLabel - ^ 'Snapshot Browser'! Item was removed: - ----- Method: MCSnapshotBrowser>>extensionClassNames (in category 'accessing') ----- - extensionClassNames - ^ (self allClassNames difference: self packageClassNames) sorted! Item was removed: - ----- Method: MCSnapshotBrowser>>extensionsCategory (in category 'accessing') ----- - extensionsCategory - ^ '*Extensions'! Item was removed: - ----- Method: MCSnapshotBrowser>>fileOutMessage (in category 'menus') ----- - fileOutMessage - "Put a description of the selected message on a file" - - | definitions wildcard | - wildcard := protocolSelection = '-- all --'. - definitions := methodSelection - ifNotNil: [{methodSelection}] - ifNil: [items select: - [:item| - item isMethodDefinition - and: [item className = classSelection - and: [wildcard or: [item protocol = protocolSelection]]]]]. - definitions isEmpty ifTrue: - [^self]. - FileStream - writeSourceCodeFrom: ((MCStWriter on: (WriteStream on: (String new: 100))) - writeDefinitions: (definitions); - stream) - baseName: (methodSelection - ifNil: [categorySelection, '-', classSelection, (wildcard ifTrue: [''] ifFalse: ['-', protocolSelection])] - ifNotNil: [methodSelection actualClass name, '-', (methodSelection selector copyReplaceAll: ':' with: '')]) - isSt: true - useHtml: false! Item was removed: - ----- Method: MCSnapshotBrowser>>hasExtensions (in category 'accessing') ----- - hasExtensions - ^self extensionClassNames notEmpty! Item was removed: - ----- Method: MCSnapshotBrowser>>inspectSelection (in category 'menus') ----- - inspectSelection - ^ self methodSelection inspect! Item was removed: - ----- Method: MCSnapshotBrowser>>labeledClassnames: (in category 'private') ----- - labeledClassnames: classNames - | methodClassification | - methodClassification := Dictionary new. - items do: [:def | def isMethodDefinition ifTrue: [ - (methodClassification at: def className ifAbsentPut: [Set new]) - add: (def classIsMeta ifFalse: [$i] ifTrue: [$c])]]. - ^ classNames collect: [:className | - String streamContents: [:s | - s nextPutAll: className; space. - (methodClassification at: className) - do: [:each | each = $i - ifTrue: [s nextPutAll: '*inst'] - ifFalse: [s nextPutAll: '*class']] - separatedBy: [s nextPut: $,]]] - ! Item was removed: - ----- Method: MCSnapshotBrowser>>loadCategorySelection (in category 'menus') ----- - loadCategorySelection - "Load the entire selected category" - categorySelection ifNil: [ ^self ]. - self methodsForSelectedClassCategory do: [ :m | m load ].! Item was removed: - ----- Method: MCSnapshotBrowser>>loadClassSelection (in category 'menus') ----- - loadClassSelection - classSelection ifNil: [ ^self ]. - (self packageClasses detect: [ :ea | ea className = classSelection ] ifNone: [ ^self ]) load. - self methodsForSelectedClass do: [ :m | m load ].! Item was removed: - ----- Method: MCSnapshotBrowser>>loadClassSelectionIntoOtherEnvironment (in category 'menus') ----- - loadClassSelectionIntoOtherEnvironment - | env | - classSelection ifNil: [ ^self ]. - env := EnvironmentRequest signal. - env beCurrentDuring: [ - (self packageClasses detect: [ :ea | ea className = classSelection ] ifNone: [ ^self ]) - load. - self methodsForSelectedClass do: [ :m | m load ]].! Item was removed: - ----- Method: MCSnapshotBrowser>>loadMethodSelection (in category 'menus') ----- - loadMethodSelection - methodSelection ifNil: [ ^self ]. - methodSelection load.! Item was removed: - ----- Method: MCSnapshotBrowser>>loadProtocolSelection (in category 'menus') ----- - loadProtocolSelection - protocolSelection ifNil: [ ^self ]. - self methodsForSelectedProtocol do: [ :m | m load ].! Item was removed: - ----- Method: MCSnapshotBrowser>>methodList (in category 'listing') ----- - methodList - ^ self visibleMethods collect: [:ea | ea selector]! Item was removed: - ----- Method: MCSnapshotBrowser>>methodListMenu: (in category 'menus') ----- - methodListMenu: aMenu - super methodListMenu: aMenu. - self selectedMessageName - ifNotNil: [:msgName | aMenu addLine; add: 'load method' translated action: #loadMethodSelection]. - ^ aMenu! Item was removed: - ----- Method: MCSnapshotBrowser>>methodSelection (in category 'selecting') ----- - methodSelection - ^ methodSelection - ifNil: [0] - ifNotNil: [self visibleMethods indexOf: methodSelection]! Item was removed: - ----- Method: MCSnapshotBrowser>>methodSelection: (in category 'selecting') ----- - methodSelection: aNumber - methodSelection := aNumber = 0 ifFalse: [self visibleMethods at: aNumber]. - self changed: #methodSelection; changed: #text; changed: #annotations! Item was removed: - ----- Method: MCSnapshotBrowser>>methodsForSelectedClass (in category 'accessing') ----- - methodsForSelectedClass - ^ items select: - [ : ea | ea className = classSelection and: [ ea isMethodDefinition ] ]! Item was removed: - ----- Method: MCSnapshotBrowser>>methodsForSelectedClassAndMetaSelection (in category 'accessing') ----- - methodsForSelectedClassAndMetaSelection - ^ self methodsForSelectedClass select: - [ : each | each classIsMeta = self switchIsClass ]! Item was removed: - ----- Method: MCSnapshotBrowser>>methodsForSelectedClassCategory (in category 'accessing') ----- - methodsForSelectedClassCategory - ^ items select: - [ : ea | (self visibleClasses includes: ea className) and: [ ea isMethodDefinition ] ]! Item was removed: - ----- Method: MCSnapshotBrowser>>methodsForSelectedProtocol (in category 'accessing') ----- - methodsForSelectedProtocol - | methods | - protocolSelection ifNil: [^ Array empty]. - methods := self methodsForSelectedClassAndMetaSelection asOrderedCollection. - (protocolSelection = '-- all --') - ifFalse: [methods removeAllSuchThat: [:ea | ea category ~= protocolSelection]]. - ^ methods - - ! Item was removed: - ----- Method: MCSnapshotBrowser>>packageClassNames (in category 'accessing') ----- - packageClassNames - ^ self packageClasses collect: [:ea | ea className]! Item was removed: - ----- Method: MCSnapshotBrowser>>packageClasses (in category 'accessing') ----- - packageClasses - ^ items select: [:ea | ea isClassDefinition]! Item was removed: - ----- Method: MCSnapshotBrowser>>packageOrganizations (in category 'accessing') ----- - packageOrganizations - ^ items select: [:ea | ea isOrganizationDefinition]! Item was removed: - ----- Method: MCSnapshotBrowser>>panelSpecs (in category 'morphic ui') ----- - panelSpecs - "Put annotations below the code pane here to look more like the regular code browser." - - ^ #( - ((codePane: text) (0 0 1 1) ( 0 0 0 defaultAnnotationPaneHeightNegated )) - ((textMorph: annotations) (0 1 1 1) ( 0 defaultAnnotationPaneHeightNegated 0 0 )) - )! Item was removed: - ----- Method: MCSnapshotBrowser>>protocolList (in category 'listing') ----- - protocolList - ^ self visibleProtocols! Item was removed: - ----- Method: MCSnapshotBrowser>>protocolListMenu: (in category 'menus') ----- - protocolListMenu: aMenu - protocolSelection - ifNotNil: [aMenu - add: ('load protocol ''{1}''' translated format: {protocolSelection}) - action: #loadProtocolSelection ]. - ^ aMenu! Item was removed: - ----- Method: MCSnapshotBrowser>>protocolSelection (in category 'selecting') ----- - protocolSelection - ^ protocolSelection - ifNil: [0] - ifNotNil: [self visibleProtocols indexOf: protocolSelection]! Item was removed: - ----- Method: MCSnapshotBrowser>>protocolSelection: (in category 'selecting') ----- - protocolSelection: anInteger - protocolSelection := (anInteger = 0 ifFalse: [self visibleProtocols at: anInteger]). - self methodSelection: 0. - self changed: #protocolSelection; - changed: #methodList; - changed: #annotations! Item was removed: - ----- 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 removed: - ----- Method: MCSnapshotBrowser>>selectedClass (in category 'accessing') ----- - selectedClass - | environment | - classSelection ifNil: [ ^nil ]. - environment := self environmentInDisplayingImage. - ^ environment at: classSelection ifAbsent: [environment valueOf: classSelection] - ! Item was removed: - ----- Method: MCSnapshotBrowser>>selectedClassOrMetaClass (in category 'accessing') ----- - selectedClassOrMetaClass - | class | - classSelection ifNil: [ ^nil ]. - class := Smalltalk at: classSelection ifAbsent: [ ^nil ]. - ^self switchIsClass ifTrue: [ class class ] - ifFalse: [ class ].! Item was removed: - ----- Method: MCSnapshotBrowser>>selectedMessageCategoryName (in category 'accessing') ----- - selectedMessageCategoryName - ^protocolSelection! Item was removed: - ----- Method: MCSnapshotBrowser>>selectedMessageName (in category 'accessing') ----- - selectedMessageName - ^methodSelection ifNotNil: [^ methodSelection selector ]. - ! Item was removed: - ----- Method: MCSnapshotBrowser>>signalSwitchChanged (in category 'switch') ----- - signalSwitchChanged - self protocolSelection: 0. - self - changed: #switchIsInstance; - changed: #switchIsComment; - changed: #switchIsClass; - changed: #protocolList; - changed: #methodList; - changed: #text.! Item was removed: - ----- Method: MCSnapshotBrowser>>snapshot: (in category 'accessing') ----- - snapshot: aSnapshot - items := aSnapshot definitions sorted. - self categorySelection: 0.! Item was removed: - ----- Method: MCSnapshotBrowser>>switchBeClass (in category 'switch') ----- - switchBeClass - switch := #class. - self signalSwitchChanged.! Item was removed: - ----- Method: MCSnapshotBrowser>>switchBeComment (in category 'switch') ----- - switchBeComment - switch := #comment. - self signalSwitchChanged.! Item was removed: - ----- Method: MCSnapshotBrowser>>switchBeInstance (in category 'switch') ----- - switchBeInstance - switch := #instance. - self signalSwitchChanged.! Item was removed: - ----- Method: MCSnapshotBrowser>>switchIsClass (in category 'switch') ----- - switchIsClass - ^ switch = #class! Item was removed: - ----- Method: MCSnapshotBrowser>>switchIsComment (in category 'switch') ----- - switchIsComment - ^ switch = #comment.! Item was removed: - ----- Method: MCSnapshotBrowser>>switchIsInstance (in category 'switch') ----- - switchIsInstance - switch ifNil: [switch := #instance]. - ^ switch = #instance.! Item was removed: - ----- 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 removed: - ----- Method: MCSnapshotBrowser>>text: (in category 'text') ----- - text: aTextOrString - self changed: #text! Item was removed: - ----- Method: MCSnapshotBrowser>>visibleCategories (in category 'listing') ----- - visibleCategories - - | visibleCategories | - visibleCategories := Set new. - self packageOrganizations do: [ :each | visibleCategories addAll: each categories ]. - self packageClasses do: [ :each | visibleCategories add: each category ]. - self hasExtensions ifTrue: [ visibleCategories add: self extensionsCategory ]. - ^visibleCategories sorted: [:each | each ifNil: ['~(put nils to the end)']] ascending! Item was removed: - ----- Method: MCSnapshotBrowser>>visibleClasses (in category 'listing') ----- - visibleClasses - ^ categorySelection = self extensionsCategory - ifTrue: [self extensionClassNames] - ifFalse: [self packageClasses - select: [:ea | ea category = categorySelection] - thenCollect: [:ea | ea className]].! Item was removed: - ----- Method: MCSnapshotBrowser>>visibleMethods (in category 'listing') ----- - visibleMethods - ^ classSelection - ifNil: [#()] - ifNotNil: [self methodsForSelectedProtocol]! Item was removed: - ----- Method: MCSnapshotBrowser>>visibleProtocols (in category 'listing') ----- - visibleProtocols - | methods protocols | - self switchIsComment ifTrue: [^ Array empty]. - methods := self methodsForSelectedClassAndMetaSelection. - protocols := methods collect: [:ea | ea category] as: Set. - (protocols size > 1) ifTrue: [protocols add: '-- all --']. - ^ protocols sorted! Item was removed: - ----- Method: MCSnapshotBrowser>>widgetSpecs (in category 'morphic ui') ----- - widgetSpecs - - Preferences annotationPanes ifFalse: [ ^#( - ((listMorph: category) (0 0 0.25 0.4)) - ((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 -30)) - ((listMorph: protocol) (0.50 0 0.75 0.4)) - ((listMorph:selection:menu:keystroke: methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4)) - ((buttonRow) (0.25 0.4 0.5 0.4) (0 -30 0 0)) - ((codePane: text) (0 0.4 1 1)) - ) ]. - - ^#( - ((listMorph: category) (0 0 0.25 0.4)) - ((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 defaultButtonPaneHeightNegated)) - ((listMorph: protocol) (0.50 0 0.75 0.4)) - ((listMorph:selection:menu:keystroke: methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4)) - - ((buttonRow) (0.25 0.4 0.5 0.4) (0 defaultButtonPaneHeightNegated 0 0)) - ((panel) (0 0.4 1 1) (0 0 0 0)) - )! Item was removed: - MCReader subclass: #MCSnapshotReader - instanceVariableNames: 'definitions' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Storing'! Item was removed: - ----- Method: MCSnapshotReader class>>snapshotFromStream: (in category 'converting') ----- - snapshotFromStream: aStream - ^ (self on: aStream) snapshot! Item was removed: - ----- Method: MCSnapshotReader>>definitions (in category 'loading') ----- - definitions - definitions ifNil: [self loadDefinitions]. - ^ definitions! Item was removed: - ----- Method: MCSnapshotReader>>snapshot (in category 'accessing') ----- - snapshot - ^ MCSnapshot fromDefinitions: self definitions! Item was removed: - MCSnapshotReader subclass: #MCStReader - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Chunk Format'! Item was removed: - ----- Method: MCStReader class>>extension (in category 'constants') ----- - extension - ^ 'st'! Item was removed: - ----- Method: MCStReader>>addDefinitionsFromDoit: (in category 'private') ----- - addDefinitionsFromDoit: aString - (MCDoItParser forDoit: aString) ifNotNil: - [:parser | - parser addDefinitionsTo: definitions]! Item was removed: - ----- Method: MCStReader>>categoryFromDoIt: (in category 'private') ----- - categoryFromDoIt: aString - | tokens | - tokens := Scanner new scanTokens: aString. - tokens size = 3 ifFalse: [self error: 'Unrecognized category definition']. - ^ tokens at: 3! Item was removed: - ----- Method: MCStReader>>classDefinitionFrom: (in category 'converting') ----- - 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 removed: - ----- Method: MCStReader>>classInstVarNamesFor: (in category 'converting') ----- - 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 removed: - ----- Method: MCStReader>>commentFor: (in category 'converting') ----- - commentFor: aPseudoClass - | comment | - comment := aPseudoClass organization classComment. - ^ comment asString = '' - ifTrue: [comment] - ifFalse: [comment string]! Item was removed: - ----- Method: MCStReader>>commentStampFor: (in category 'converting') ----- - commentStampFor: aPseudoClass - | comment | - comment := aPseudoClass organization classComment. - ^ [comment stamp] on: MessageNotUnderstood do: [nil]! Item was removed: - ----- Method: MCStReader>>compiledCodeClassNames (in category 'private') ----- - 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 removed: - ----- Method: MCStReader>>loadDefinitions (in category 'evaluating') ----- - loadDefinitions - | filePackage | - filePackage := - FilePackage new - fullName: 'ReadStream'; - fileInFrom: self readStream. - definitions := OrderedCollection new. - filePackage classes do: - [:pseudoClass | - pseudoClass hasDefinition - ifTrue: [definitions add: - (pseudoClass asMCDefinitionBy: self)]. - definitions addAll: (self methodDefinitionsFor: pseudoClass). - definitions addAll: (self methodDefinitionsFor: pseudoClass metaClass)]. - filePackage doIts do: - [:ea | - self addDefinitionsFromDoit: ea string]. - ! Item was removed: - ----- Method: MCStReader>>methodDefinitionsFor: (in category 'converting') ----- - 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 removed: - ----- Method: MCStReader>>readStream (in category 'evaluating') ----- - readStream - ^ ('!!!! - - ', stream contents) readStream! Item was removed: - ----- Method: MCStReader>>systemOrganizationFromRecords: (in category 'converting') ----- - 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 removed: - ----- Method: MCStReader>>traitDefinitionFrom: (in category 'converting') ----- - 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 removed: - ----- Method: MCStReader>>typeOfSubclass: (in category 'private') ----- - 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 removed: - MCWriter subclass: #MCStWriter - instanceVariableNames: 'initStream' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Chunk Format'! Item was removed: - ----- Method: MCStWriter class>>readerClass (in category 'accessing') ----- - readerClass - ^ MCStReader! Item was removed: - ----- Method: MCStWriter>>chunkContents: (in category 'writing') ----- - chunkContents: aBlock - stream cr; nextChunkPut: (String streamContents: aBlock); cr! Item was removed: - ----- Method: MCStWriter>>visitClassDefinition: (in category 'visiting') ----- - visitClassDefinition: definition - self writeClassDefinition: definition. - definition hasClassInstanceVariables ifTrue: [self writeMetaclassDefinition: definition]. - definition hasComment ifTrue: [self writeClassComment: definition].! Item was removed: - ----- Method: MCStWriter>>visitClassTraitDefinition: (in category 'visiting') ----- - visitClassTraitDefinition: definition - self chunkContents: [:s | s - nextPutAll: definition baseTrait; - nextPutAll: ' classTrait'; - cr; tab; - nextPutAll: 'uses: '; - nextPutAll: (definition classTraitComposition ifNil: ['{}'])] - ! Item was removed: - ----- Method: MCStWriter>>visitMetaclassDefinition: (in category 'visiting') ----- - visitMetaclassDefinition: definition - self writeMetaclassDefinition: definition! Item was removed: - ----- Method: MCStWriter>>visitMethodDefinition: (in category 'visiting') ----- - visitMethodDefinition: definition - self writeMethodPreamble: definition. - self writeMethodSource: definition. - self writeMethodPostscript. - self writeMethodInitializer: definition.! Item was removed: - ----- Method: MCStWriter>>visitOrganizationDefinition: (in category 'visiting') ----- - visitOrganizationDefinition: defintion - defintion categories do: [:cat | self writeCategory: cat]. - ! Item was removed: - ----- Method: MCStWriter>>visitScriptDefinition: (in category 'visiting') ----- - visitScriptDefinition: definition - self writeScriptDefinition: definition - ! Item was removed: - ----- Method: MCStWriter>>visitTraitDefinition: (in category 'visiting') ----- - visitTraitDefinition: definition - self writeClassDefinition: definition. - definition hasComment ifTrue: [self writeClassComment: definition].! Item was removed: - ----- Method: MCStWriter>>writeCategory: (in category 'writing') ----- - writeCategory: categoryName - stream - nextChunkPut: 'SystemOrganization addCategory: ', categoryName printString; - cr! Item was removed: - ----- Method: MCStWriter>>writeClassComment: (in category 'writing') ----- - writeClassComment: definition - stream - cr; - nextPut: $!!; - nextPutAll: definition className; - nextPutAll: ' commentStamp: '; - store: definition commentStamp; - nextPutAll: ' prior: 0!!'; - cr; - nextChunkPut: definition comment; - cr.! Item was removed: - ----- Method: MCStWriter>>writeClassDefinition: (in category 'writing') ----- - writeClassDefinition: definition - self chunkContents: [:s | definition printDefinitionOn: stream]! Item was removed: - ----- Method: MCStWriter>>writeDefinitions: (in category 'writing') ----- - writeDefinitions: aCollection - "initStream is an ugly hack until we have proper init defs" - initStream := String new writeStream. - - (MCDependencySorter sortItems: aCollection) - do: [:ea | ea accept: self] - displayingProgress: 'Writing definitions...'. - - stream nextPutAll: initStream contents.! Item was removed: - ----- Method: MCStWriter>>writeMetaclassDefinition: (in category 'writing') ----- - writeMetaclassDefinition: definition - self chunkContents: [:str | - str nextPutAll: definition className; - nextPutAll: ' class'; - cr; tab. - definition hasClassTraitComposition ifTrue: [ - str nextPutAll: 'uses: '; - nextPutAll: definition classTraitCompositionString; - cr; tab]. - str nextPutAll: 'instanceVariableNames: '''; - nextPutAll: definition classInstanceVariablesString; - nextPut: $']! Item was removed: - ----- Method: MCStWriter>>writeMethodInitializer: (in category 'writing') ----- - writeMethodInitializer: aMethodDefinition - aMethodDefinition isInitializer ifTrue: - [initStream nextChunkPut: aMethodDefinition className, ' initialize'; cr]! Item was removed: - ----- Method: MCStWriter>>writeMethodPostscript (in category 'writing') ----- - writeMethodPostscript - stream - space; - nextPut: $!!; - cr! Item was removed: - ----- Method: MCStWriter>>writeMethodPreamble: (in category 'writing') ----- - writeMethodPreamble: definition - stream - cr; - nextPut: $!!; - nextPutAll: definition fullClassName; - nextPutAll: ' methodsFor: '; - nextPutAll: definition category asString printString; - nextPutAll: ' stamp: '; - nextPutAll: definition timeStamp asString printString; - nextPutAll: '!!'; - cr! Item was removed: - ----- Method: MCStWriter>>writeMethodSource: (in category 'writing') ----- - writeMethodSource: definition - stream nextChunkPut: definition source! Item was removed: - ----- 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 removed: - ----- Method: MCStWriter>>writeSnapshot: (in category 'writing') ----- - writeSnapshot: aSnapshot - self writeDefinitions: aSnapshot definitions! Item was removed: - MCDirectoryRepository subclass: #MCSubDirectoryRepository - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Repositories'! - - !MCSubDirectoryRepository commentStamp: 'nk 6/11/2004 18:56' prior: 0! - A MCDirectoryRepository that looks in subdirectories too.! Item was removed: - ----- Method: MCSubDirectoryRepository class>>description (in category 'user interface') ----- - description - ^ 'directory with subdirectories'! Item was removed: - ----- Method: MCSubDirectoryRepository>>allDirectories (in category 'enumerating') ----- - 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 removed: - ----- Method: MCSubDirectoryRepository>>allFileNames (in category 'enumerating') ----- - 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 removed: - ----- Method: MCSubDirectoryRepository>>description (in category 'user interface') ----- - description - ^ directory pathName, FileDirectory slash, '*'! Item was removed: - ----- Method: MCSubDirectoryRepository>>findFullNameForReading: (in category 'private') ----- - 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 removed: - ----- Method: MCSubDirectoryRepository>>findFullNameForWriting: (in category 'private') ----- - 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 removed: - ----- Method: MCSubDirectoryRepository>>readStreamForFileNamed:do: (in category 'private') ----- - readStreamForFileNamed: aString do: aBlock - | file val | - file := FileStream readOnlyFileNamed: (self findFullNameForReading: aString). - val := aBlock value: file. - file close. - ^ val! Item was removed: - ----- Method: MCSubDirectoryRepository>>writeStreamForFileNamed:replace:do: (in category 'private') ----- - 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 removed: - MCDoItParser subclass: #MCSystemCategoryParser - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Chunk Format'! Item was removed: - ----- Method: MCSystemCategoryParser class>>pattern (in category 'constants') ----- - pattern - ^ 'SystemOrganization*'! Item was removed: - ----- Method: MCSystemCategoryParser>>addDefinitionsTo: (in category 'evaluating') ----- - addDefinitionsTo: aCollection - | definition | - definition := aCollection detect: [:ea | ea isOrganizationDefinition ] ifNone: [aCollection add: (MCOrganizationDefinition categories: #())]. - definition categories: (definition categories copyWith: self category).! Item was removed: - ----- Method: MCSystemCategoryParser>>category (in category 'evaluating') ----- - category - | tokens | - tokens := Scanner new scanTokens: source. - tokens size = 3 ifFalse: [self error: 'Unrecognized category definition']. - ^ tokens at: 3! Item was removed: - MCMerger subclass: #MCThreeWayMerger - instanceVariableNames: 'index operations provisions redundantAdds' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Merging'! Item was removed: - ----- Method: MCThreeWayMerger class>>base:patch: (in category 'instance creation') ----- - base: aSnapshot patch: aPatch - aPatch isEmpty ifTrue: [MCNoChangesException signal]. - ^ self new - addBaseSnapshot: aSnapshot; - applyPatch: aPatch; - yourself - ! Item was removed: - ----- Method: MCThreeWayMerger class>>base:target:ancestor: (in category 'instance creation') ----- - base: aSnapshot target: targetSnapshot ancestor: ancestorSnapshot - ^ self base: aSnapshot patch: (targetSnapshot patchRelativeToBase: ancestorSnapshot)! Item was removed: - ----- Method: MCThreeWayMerger class>>new (in category 'instance creation') ----- - new - ^ self basicNew initialize! Item was removed: - ----- Method: MCThreeWayMerger>>addBaseSnapshot: (in category 'as yet unclassified') ----- - addBaseSnapshot: aSnapshot - aSnapshot definitions do: - [:ea | - index add: ea. - provisions addAll: ea provisions]! Item was removed: - ----- Method: MCThreeWayMerger>>addDefinition: (in category 'as yet unclassified') ----- - addDefinition: aDefinition - index - definitionLike: aDefinition - ifPresent: [:other | - (self removalForDefinition: aDefinition) - ifNotNil: - [:op | - self addOperation: (MCModification of: other to: aDefinition). - self removeOperation: op. - ^ self]. - other = aDefinition - ifFalse: [self addConflictWithOperation: (MCModification of: other to: aDefinition)] - ifTrue: [self redundantAdds add: aDefinition]] - ifAbsent: [self addOperation: (MCAddition of: aDefinition)]! Item was removed: - ----- Method: MCThreeWayMerger>>addOperation: (in category 'as yet unclassified') ----- - addOperation: anOperation - self operations add: anOperation! Item was removed: - ----- Method: MCThreeWayMerger>>applyPatch: (in category 'applying') ----- - applyPatch: aPatch - aPatch applyTo: self! Item was removed: - ----- Method: MCThreeWayMerger>>applyTo: (in category 'applying') ----- - applyTo: anObject - super applyTo: anObject. - self operations do: [:ea | ea applyTo: anObject]! Item was removed: - ----- Method: MCThreeWayMerger>>baseSnapshot (in category 'as yet unclassified') ----- - baseSnapshot - ^ (MCSnapshot fromDefinitions: index definitions)! Item was removed: - ----- Method: MCThreeWayMerger>>initialize (in category 'initialize-release') ----- - initialize - index := MCDefinitionIndex new. - provisions := Set new! Item was removed: - ----- Method: MCThreeWayMerger>>modificationConflictForDefinition: (in category 'as yet unclassified') ----- - modificationConflictForDefinition: aDefinition - ^ conflicts ifNotNil: - [conflicts detect: - [:ea | (ea definition isRevisionOf: aDefinition) and: - [ea operation isModification]] ifNone: []]! Item was removed: - ----- Method: MCThreeWayMerger>>modifyDefinition:to: (in category 'as yet unclassified') ----- - modifyDefinition: baseDefinition to: targetDefinition - index - definitionLike: baseDefinition - ifPresent: [:other | other = baseDefinition - ifTrue: [self addOperation: (MCModification of: baseDefinition to: targetDefinition)] - ifFalse: [other = targetDefinition - ifFalse: [self addConflictWithOperation: - (MCModification of: other to: targetDefinition)]]] - ifAbsent: [self addConflictWithOperation: (MCAddition of: targetDefinition)]! Item was removed: - ----- Method: MCThreeWayMerger>>operations (in category 'accessing') ----- - operations - ^ operations ifNil: [operations := OrderedCollection new]! Item was removed: - ----- Method: MCThreeWayMerger>>provisions (in category 'accessing') ----- - provisions - ^ provisions! Item was removed: - ----- Method: MCThreeWayMerger>>redundantAdds (in category 'as yet unclassified') ----- - redundantAdds - ^ redundantAdds ifNil: [redundantAdds := Set new]! Item was removed: - ----- Method: MCThreeWayMerger>>removalForDefinition: (in category 'as yet unclassified') ----- - removalForDefinition: aDefinition - ^ operations ifNotNil: - [operations - detect: [:ea | (ea definition isRevisionOf: aDefinition) and: [ea isRemoval]] - ifNone: []]! Item was removed: - ----- Method: MCThreeWayMerger>>removeConflict: (in category 'as yet unclassified') ----- - removeConflict: aConflict - conflicts remove: aConflict! Item was removed: - ----- Method: MCThreeWayMerger>>removeDefinition: (in category 'as yet unclassified') ----- - removeDefinition: aDefinition - index - definitionLike: aDefinition - ifPresent: [:other | other = aDefinition - ifTrue: - [(self modificationConflictForDefinition: aDefinition) - ifNotNil: - [:c | - self addOperation: c operation. - self removeConflict: c. - ^ self]. - (self redundantAdds includes: aDefinition) - ifFalse: [self addOperation: (MCRemoval of: aDefinition)]] - ifFalse: - [self addConflictWithOperation: (MCRemoval of: other)]] - ifAbsent: []! Item was removed: - ----- Method: MCThreeWayMerger>>removeOperation: (in category 'as yet unclassified') ----- - removeOperation: anOperation - operations remove: anOperation! Item was removed: - Model subclass: #MCTool - instanceVariableNames: 'morph label modalProcess modalValue' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-UI'! Item was removed: - ----- Method: MCTool>>answer: (in category 'morphic ui') ----- - answer: anObject - self wasInterrupted - ifTrue: [^ self inform: 'This modal dialog was interrupted\and thus cannot proceed.\\Please close it or cancel the operation.' translated withCRs]. - modalValue := anObject. - self close.! Item was removed: - ----- Method: MCTool>>build:with: (in category 'toolbuilder') ----- - build: specsSelector with: mcToolBuilder - - | windowBuilder | - windowBuilder := mcToolBuilder. - (self perform: specsSelector) do: - [:spec | | send fractions offsets | - send := spec first. - fractions := (spec at: 2 ifAbsent: [#(0 0 1 1)]) copy. - offsets := (spec at: 3 ifAbsent: [#(0 0 0 0)]) copy. - - fractions withIndexDo: [:numberOrSymbol :index | - numberOrSymbol isSymbol - ifTrue: [fractions at: index put: (self perform: numberOrSymbol)]]. - offsets withIndexDo: [:numberOrSymbol :index | - numberOrSymbol isSymbol - ifTrue: [offsets at: index put: (self perform: numberOrSymbol)]]. - - windowBuilder frame: (LayoutFrame - fractions: (fractions first @ fractions second corner: fractions third @ fractions fourth) - offsets: (offsets first @ offsets second corner: offsets third @ offsets fourth)). - - windowBuilder perform: send first withArguments: send allButFirst].! Item was removed: - ----- Method: MCTool>>buildWindow (in category 'toolbuilder') ----- - buildWindow - ^ ToolBuilder build: self! Item was removed: - ----- Method: MCTool>>buildWith: (in category 'toolbuilder') ----- - buildWith: builder - - | windowBuilder | - windowBuilder := MCToolWindowBuilder builder: builder tool: self. - self build: #widgetSpecs with: windowBuilder. - ^ windowBuilder build - ! Item was removed: - ----- Method: MCTool>>buttonEnabled (in category 'morphic ui') ----- - buttonEnabled - ^ true! Item was removed: - ----- Method: MCTool>>buttonSelected (in category 'morphic ui') ----- - buttonSelected - ^ false! Item was removed: - ----- Method: MCTool>>buttonSpecs (in category 'morphic ui') ----- - buttonSpecs - ^ #()! Item was removed: - ----- Method: MCTool>>buttonState (in category 'morphic ui') ----- - buttonState - ^ true! Item was removed: - ----- Method: MCTool>>close (in category 'morphic ui') ----- - close - self window delete! Item was removed: - ----- Method: MCTool>>defaultAnnotationPaneHeight (in category 'morphic ui') ----- - defaultAnnotationPaneHeight - "Answer the receiver's preferred default height for new annotation panes. - Since MC compares two annotations, reserve a bit less than a double the traditional height." - - ^ ToolBuilder default inputFieldHeightFor: 2 "lines"! Item was removed: - ----- Method: MCTool>>defaultAnnotationPaneHeightNegated (in category 'morphic ui') ----- - defaultAnnotationPaneHeightNegated - - ^ self defaultAnnotationPaneHeight negated! Item was removed: - ----- Method: MCTool>>defaultButtonPaneHeight (in category 'morphic ui') ----- - defaultButtonPaneHeight - "Answer the user's preferred default height for new button panes." - - ^ ToolBuilder default buttonRowHeight! Item was removed: - ----- Method: MCTool>>defaultButtonPaneHeightNegated (in category 'morphic ui') ----- - defaultButtonPaneHeightNegated - - ^ self defaultButtonPaneHeight negated! Item was removed: - ----- Method: MCTool>>defaultButtonRowSpacing (in category 'morphic ui') ----- - defaultButtonRowSpacing - - ^ ToolBuilder default panelSpacing! Item was removed: - ----- Method: MCTool>>defaultButtonRowSpacingNegated (in category 'morphic ui') ----- - defaultButtonRowSpacingNegated - - ^ self defaultButtonRowSpacing negated! Item was removed: - ----- Method: MCTool>>defaultExtent (in category 'morphic ui') ----- - defaultExtent - ^ 500 at 500! Item was removed: - ----- Method: MCTool>>defaultInputFieldHeight (in category 'morphic ui') ----- - defaultInputFieldHeight - - ^ ToolBuilder default inputFieldHeight! Item was removed: - ----- Method: MCTool>>defaultLabel (in category 'morphic ui') ----- - defaultLabel - ^ self class name! Item was removed: - ----- Method: MCTool>>defaultWindowColor (in category 'user interface') ----- - defaultWindowColor - ^ (Color r: 0.65 g: 0.691 b: 0.876)! Item was removed: - ----- Method: MCTool>>fillMenu:fromSpecs: (in category 'morphic ui') ----- - fillMenu: aMenu fromSpecs: anArray - anArray do: - [:spec | - spec == #addLine - ifTrue: [aMenu addLine] - ifFalse: - [aMenu - add: spec first - target: self - selector: spec second - argumentList: (spec allButFirst: 2)]]. - ^aMenu! Item was removed: - ----- Method: MCTool>>findListMorph: (in category 'morphic ui') ----- - findListMorph: aSymbol - ^ morph submorphs detect: [:ea | (ea respondsTo: #getListSelector) and: [ea getListSelector = aSymbol]] ifNone: []! Item was removed: - ----- Method: MCTool>>getMenu: (in category 'morphic ui') ----- - getMenu: aMenu - ^aMenu! Item was removed: - ----- Method: MCTool>>initialExtent (in category 'morphic ui') ----- - initialExtent - - ^ self defaultExtent! Item was removed: - ----- Method: MCTool>>label (in category 'morphic ui') ----- - label - ^ label ifNil: [self defaultLabel]! Item was removed: - ----- Method: MCTool>>label: (in category 'morphic ui') ----- - label: aString - label := aString! Item was removed: - ----- Method: MCTool>>panelSpecs (in category 'morphic ui') ----- - panelSpecs - ^ #()! Item was removed: - ----- Method: MCTool>>performButtonAction:enabled: (in category 'morphic ui') ----- - performButtonAction: anActionSelector enabled: anEnabledSelector - (self perform: anEnabledSelector) - ifTrue: [ self perform: anActionSelector ]! Item was removed: - ----- Method: MCTool>>refresh (in category 'morphic ui') ----- - refresh - "Do nothing by default."! Item was removed: - ----- Method: MCTool>>show (in category 'morphic ui') ----- - show - modalProcess := nil. - Smalltalk at: #ToolBuilder ifPresent: [:tb | tb open: self. ^ self]. - ^self window openInWorld; yourself! Item was removed: - ----- Method: MCTool>>showLabelled: (in category 'morphic ui') ----- - showLabelled: labelString - modalProcess := nil. - self label: labelString. - ^(self window) - openInWorld; - yourself! Item was removed: - ----- Method: MCTool>>showModally (in category 'morphic ui') ----- - showModally - modalProcess := Processor activeProcess. - ToolBuilder default - open: self window; - runModal: self window. - morph := nil. - ^ modalValue! Item was removed: - ----- Method: MCTool>>wasInterrupted (in category 'morphic ui') ----- - wasInterrupted - ^ modalProcess notNil and: [modalProcess ~~ Processor activeProcess]! Item was removed: - ----- Method: MCTool>>widgetSpecs (in category 'morphic ui') ----- - widgetSpecs - ^ #()! Item was removed: - ----- Method: MCTool>>window (in category 'morphic ui') ----- - window - ^ morph ifNil: [morph := self buildWindow]! Item was removed: - ----- Method: MCTool>>windowTitle (in category 'morphic ui') ----- - windowTitle - - ^ label! Item was removed: - Object subclass: #MCToolWindowBuilder - instanceVariableNames: 'builder window currentComposite currentFrame tool' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-UI'! Item was removed: - ----- Method: MCToolWindowBuilder class>>builder:tool: (in category 'instance creation') ----- - builder: aBuilder tool: aTool - ^ self basicNew initializeWithBuilder: aBuilder tool: aTool! Item was removed: - ----- Method: MCToolWindowBuilder>>build (in category 'building') ----- - build - ^ builder build: window! Item was removed: - ----- Method: MCToolWindowBuilder>>button: (in category 'building-parts') ----- - button: spec - - | button | - button := builder pluggableButtonSpec new. - button model: tool. - button label: spec first asString. - button action: spec second. - button help: spec third. - button enabled: (spec at: 4 ifAbsent: [#buttonEnabled]). - button state: (spec at: 5 ifAbsent: [#buttonSelected]). - button horizontalResizing: (spec at: 6 ifAbsent: [#spaceFill]). - - "No need to currentFrame. See #buttonRowFor:." - currentComposite children add: button.! Item was removed: - ----- Method: MCToolWindowBuilder>>buttonRow (in category 'building-composites') ----- - buttonRow - ^ self buttonRowFor: #buttonSpecs! Item was removed: - ----- Method: MCToolWindowBuilder>>buttonRowFor: (in category 'building-composites') ----- - buttonRowFor: specsSelector - - self buttonRowFor: specsSelector spacing: nil.! Item was removed: - ----- Method: MCToolWindowBuilder>>buttonRowFor:spacing: (in category 'building-composites') ----- - buttonRowFor: specsSelector spacing: spacing - - | panel priorComposite | - panel := builder pluggablePanelSpec new. - panel children: OrderedCollection new. - panel layout: #horizontal. - panel spacing: (spacing ifNil: [tool defaultButtonRowSpacing]). - panel frame: currentFrame. - currentComposite children add: panel. - - priorComposite := currentComposite. - currentComposite := panel. - tool build: specsSelector with: self. - currentComposite := priorComposite. - ! Item was removed: - ----- Method: MCToolWindowBuilder>>codePane: (in category 'building-parts') ----- - codePane: aSymbol - | text | - text := builder pluggableCodePaneSpec new. - text - model: tool; - getText: aSymbol; - setText: (aSymbol, ':') asSymbol; - frame: currentFrame. - currentComposite children add: text! Item was removed: - ----- Method: MCToolWindowBuilder>>frame: (in category 'accessing') ----- - frame: aLayoutFrame - currentFrame := aLayoutFrame! Item was removed: - ----- Method: MCToolWindowBuilder>>initializeWithBuilder:tool: (in category 'initialize-release') ----- - initializeWithBuilder: aBuilder tool: aTool - builder := aBuilder. - tool := aTool. - window := builder pluggableWindowSpec new. - window children: OrderedCollection new. - window label: tool label asString. - window model: tool. - window extent: tool defaultExtent. - currentComposite := window.! Item was removed: - ----- Method: MCToolWindowBuilder>>inputMorph: (in category 'building-parts') ----- - inputMorph: aSymbol - | text | - text := builder pluggableInputFieldSpec new. - text - model: tool; - getText: aSymbol; - setText: (aSymbol, ':') asSymbol; - frame: currentFrame. - currentComposite children add: text! Item was removed: - ----- Method: MCToolWindowBuilder>>listMorph: (in category 'building-parts') ----- - listMorph: listSymbol - ^ self - listMorph: (listSymbol, 'List') asSymbol - selection: (listSymbol, 'Selection') asSymbol - menu: (listSymbol, 'ListMenu:') asSymbol! Item was removed: - ----- Method: MCToolWindowBuilder>>listMorph:keystroke: (in category 'building-parts') ----- - listMorph: listSymbol keystroke: keystrokeSymbol - ^ (self - listMorph: (listSymbol, 'List') asSymbol - selection: (listSymbol, 'Selection') asSymbol - menu: (listSymbol, 'ListMenu:') asSymbol) - keystrokeActionSelector: keystrokeSymbol; - yourself! Item was removed: - ----- Method: MCToolWindowBuilder>>listMorph:selection: (in category 'building-parts') ----- - listMorph: listSymbol selection: selectionSymbol - self listMorph: listSymbol selection: selectionSymbol menu: nil! Item was removed: - ----- Method: MCToolWindowBuilder>>listMorph:selection:menu: (in category 'building-parts') ----- - listMorph: listSymbol selection: selectionSymbol menu: menuSymbol - self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil! Item was removed: - ----- Method: MCToolWindowBuilder>>listMorph:selection:menu:keystroke: (in category 'building-parts') ----- - listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol - | list | - list := builder pluggableListSpec new. - list - model: tool; - list: listSymbol; - getIndex: selectionSymbol; - setIndex: (selectionSymbol, ':') asSymbol; - frame: currentFrame. - menuSymbol ifNotNil: [list menu: menuSymbol]. - keystrokeSymbol ifNotNil: [list keyPress: keystrokeSymbol]. - currentComposite children add: list - ! Item was removed: - ----- Method: MCToolWindowBuilder>>multiListMorph:selection:listSelection:menu: (in category 'building-parts') ----- - multiListMorph: listSymbol selection: selectionSymbol listSelection: listSelectionSymbol menu: menuSymbol - | list | - list := builder pluggableMultiSelectionListSpec new. - list - model: tool; - list: listSymbol; - getIndex: selectionSymbol; - setIndex: (selectionSymbol, ':') asSymbol; - getSelectionList: listSelectionSymbol; - setSelectionList: (listSelectionSymbol, 'put:') asSymbol; - frame: currentFrame. - menuSymbol ifNotNil: [list menu: menuSymbol]. - currentComposite children add: list - ! Item was removed: - ----- Method: MCToolWindowBuilder>>panel (in category 'building-composites') ----- - panel - "Convenience if you only want to have a single inner panel." - - ^ self panelFor: #panelSpecs! Item was removed: - ----- Method: MCToolWindowBuilder>>panelFor: (in category 'building-composites') ----- - panelFor: specsSelector - - | panel priorComposite | - panel := builder pluggablePanelSpec new. - panel children: OrderedCollection new. - panel frame: currentFrame. - currentComposite children add: panel. - - priorComposite := currentComposite. - currentComposite := panel. - tool build: specsSelector with: self. - currentComposite := priorComposite. - ! Item was removed: - ----- Method: MCToolWindowBuilder>>spacer (in category 'building-parts') ----- - spacer - - currentComposite children add: builder pluggableSpacerSpec new.! Item was removed: - ----- Method: MCToolWindowBuilder>>textMorph: (in category 'building-parts') ----- - textMorph: aSymbol - | text | - text := builder pluggableTextSpec new. - text - model: tool; - getText: aSymbol; - setText: (aSymbol, ':') asSymbol; - frame: currentFrame. - currentComposite children add: text! Item was removed: - ----- Method: MCToolWindowBuilder>>treeMorph: (in category 'building-parts') ----- - treeMorph: listSymbol - ^ self - treeMorph: (listSymbol, 'Tree') asSymbol - selection: (listSymbol, 'SelectionWrapper') asSymbol - menu: (listSymbol, 'TreeMenu:') asSymbol! Item was removed: - ----- Method: MCToolWindowBuilder>>treeMorph:selection:menu: (in category 'building-parts') ----- - treeMorph: listSymbol selection: selectionSymbol menu: menuSymbol - self notYetImplemented! Item was removed: - ----- Method: MCToolWindowBuilder>>treeOrListMorph: (in category 'building-parts') ----- - treeOrListMorph: listSymbol - ^ self listMorph: listSymbol! Item was removed: - MCClassDefinition subclass: #MCTraitDefinition - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Modeling'! Item was removed: - ----- Method: MCTraitDefinition class>>name:traitComposition:category:comment:commentStamp: (in category 'instance creation') ----- - 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 removed: - ----- Method: MCTraitDefinition>>= (in category 'visiting') ----- - = aDefinition - self flag: #traits. "Ugly we harcoded the super superclass method. We will have to refactor the definition hierarchy" - - ^ (aDefinition isKindOf: MCDefinition) - and: [(self isRevisionOf: aDefinition) - and: [self traitCompositionString = aDefinition traitCompositionString - and: [category = aDefinition category - and: [comment = aDefinition comment]]]]! Item was removed: - ----- Method: MCTraitDefinition>>accept: (in category 'visiting') ----- - accept: aVisitor - ^ aVisitor visitTraitDefinition: self - ! Item was removed: - ----- Method: MCTraitDefinition>>classTraitCompositionString (in category 'accessing') ----- - classTraitCompositionString - ^self traitComposition ifNil: ['{}'].! Item was removed: - ----- Method: MCTraitDefinition>>createClass (in category 'visiting') ----- - createClass - ^ClassDescription - newTraitNamed: name - uses: (Compiler evaluate: self traitCompositionString) - category: category - in: Environment current - - ! Item was removed: - ----- Method: MCTraitDefinition>>hasClassInstanceVariables (in category 'testing') ----- - hasClassInstanceVariables - ^ false - - ! Item was removed: - ----- Method: MCTraitDefinition>>hasTraitComposition (in category 'testing') ----- - hasTraitComposition - ^self traitCompositionString ~= '{}'! Item was removed: - ----- Method: MCTraitDefinition>>hash (in category 'comparing') ----- - hash - - | hash | - hash := name hashWithInitialHash: 0. - hash := self traitCompositionString hashWithInitialHash: hash. - hash := (category ifNil: ['']) hashWithInitialHash: hash. - ^hash - ! Item was removed: - ----- Method: MCTraitDefinition>>initializeWithName:traitComposition:category:comment:commentStamp: (in category 'initializing') ----- - initializeWithName: classNameString - traitComposition: traitCompositionString - category: categoryString - comment: commentString - commentStamp: commentStampString - - name := classNameString asSymbol. - traitComposition := traitCompositionString. - category := categoryString. - comment := commentString withSqueakLineEndings. - commentStamp := commentStampString ifNil: [self defaultCommentStamp] - ! Item was removed: - ----- Method: MCTraitDefinition>>load (in category 'installing') ----- - load - self createClass ifNotNil: [:trait | - self hasComment ifTrue: [trait classComment: comment stamp: commentStamp]]! Item was removed: - ----- Method: MCTraitDefinition>>printClassSideDefinitionOn: (in category 'printing') ----- - printClassSideDefinitionOn: stream - stream - nextPutAll: self className; - nextPutAll: ' classTrait '; - cr; tab; - nextPutAll: 'uses: '; - nextPutAll: self classTraitCompositionString! Item was removed: - ----- Method: MCTraitDefinition>>printDefinitionOn: (in category 'printing') ----- - printDefinitionOn: stream - stream nextPutAll: 'Trait named: #', self className; - cr; - tab; - nextPutAll: 'uses: '; - nextPutAll: self traitCompositionString; - cr; - tab; - nextPutAll: 'category: '; - store: self category asString - ! Item was removed: - ----- Method: MCTraitDefinition>>requirements (in category 'comparing') ----- - requirements - "Assuming that traits in a composition can be identified by - testing for the first character beeing an uppercase character - (and thus not a special character such as {, # etc.)" - - | tokens traitNames | - self hasTraitComposition ifFalse: [ ^Array empty ]. - tokens := (Scanner new scanTokens: self traitComposition) flattened. - traitNames := tokens select: [:each | each first isUppercase]. - ^traitNames asArray! Item was removed: - ----- Method: MCTraitDefinition>>traitComposition (in category 'accessing') ----- - traitComposition - ^traitComposition! Item was removed: - MCDoItParser subclass: #MCTraitParser - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Modeling'! Item was removed: - ----- Method: MCTraitParser class>>pattern (in category 'constants') ----- - pattern - ^ 'Trait named:*'! Item was removed: - ----- Method: MCTraitParser>>addDefinitionsTo: (in category 'reader') ----- - addDefinitionsTo: aCollection - | tokens definition traitCompositionString | - tokens := Scanner new scanTokens: source. - traitCompositionString := ((ReadStream on: source) - match: 'uses:'; - upToAll: 'category:') withBlanksTrimmed. - definition := MCTraitDefinition - name: (tokens at: 3) - traitComposition: traitCompositionString - category: tokens last - comment: '' - commentStamp: ''. - aCollection add: definition.! Item was removed: - Object subclass: #MCVariableDefinition - instanceVariableNames: 'name' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Modeling'! Item was removed: - ----- Method: MCVariableDefinition class>>name: (in category 'instance creation') ----- - name: aString - ^ self new name: aString - ! Item was removed: - ----- Method: MCVariableDefinition>>= (in category 'comparing') ----- - = other - ^ (self species = other species) - and: [self name = other name]! Item was removed: - ----- Method: MCVariableDefinition>>hash (in category 'comparing') ----- - hash - ^ name hash! Item was removed: - ----- Method: MCVariableDefinition>>isClassInstanceVariable (in category 'testing') ----- - isClassInstanceVariable - ^ false! Item was removed: - ----- Method: MCVariableDefinition>>isClassInstanceVariableDefinition (in category 'testing') ----- - isClassInstanceVariableDefinition - ^ false! Item was removed: - ----- Method: MCVariableDefinition>>isClassVariable (in category 'testing') ----- - isClassVariable - ^ false! Item was removed: - ----- Method: MCVariableDefinition>>isInstanceVariable (in category 'testing') ----- - isInstanceVariable - ^ false! Item was removed: - ----- Method: MCVariableDefinition>>isInstanceVariableDefinition (in category 'testing') ----- - isInstanceVariableDefinition - ^ false! Item was removed: - ----- Method: MCVariableDefinition>>isOrderDependend (in category 'testing') ----- - isOrderDependend - ^true! Item was removed: - ----- Method: MCVariableDefinition>>isPoolImport (in category 'testing') ----- - isPoolImport - ^ false! Item was removed: - ----- Method: MCVariableDefinition>>name (in category 'accessing') ----- - name - ^ name! Item was removed: - ----- Method: MCVariableDefinition>>name: (in category 'accessing') ----- - name: aString - name := aString! Item was removed: - ----- Method: MCVariableDefinition>>printOn: (in category 'printing') ----- - printOn: aStream - super printOn: aStream. - aStream nextPut: $(; nextPutAll: self name; nextPut: $)! Item was removed: - Object subclass: #MCVersion - instanceVariableNames: 'package info snapshot dependencies' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Versioning'! Item was removed: - ----- Method: MCVersion class>>package: (in category 'instance creation') ----- - package: aPackage - ^ self package: aPackage info: MCVersionInfo new! Item was removed: - ----- Method: MCVersion class>>package:info: (in category 'instance creation') ----- - package: aPackage info: aVersionInfo - ^ self package: aPackage info: aVersionInfo snapshot: aPackage snapshot! Item was removed: - ----- Method: MCVersion class>>package:info:snapshot: (in category 'instance creation') ----- - package: aPackage info: aVersionInfo snapshot: aSnapshot - ^ self package: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: #()! Item was removed: - ----- Method: MCVersion class>>package:info:snapshot:dependencies: (in category 'instance creation') ----- - package: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection - ^ self new initializeWithPackage: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection! Item was removed: - ----- Method: MCVersion>>addToCache (in category 'actions') ----- - addToCache - MCCacheRepository default storeVersion: self! Item was removed: - ----- Method: MCVersion>>adopt (in category 'actions') ----- - adopt - self workingCopy adopt: self! Item was removed: - ----- Method: MCVersion>>allAvailableDependenciesDo: (in category 'enumerating') ----- - allAvailableDependenciesDo: aBlock - - self dependencies do: - [:ea | - [ | version | - version := ea resolve. - version allAvailableDependenciesDo: aBlock. - aBlock value: version] - on: Error do: []]! Item was removed: - ----- Method: MCVersion>>allDependenciesDo: (in category 'enumerating') ----- - allDependenciesDo: aBlock - self allDependenciesDo: aBlock ifUnresolved: [:ignored | true]! Item was removed: - ----- Method: MCVersion>>allDependenciesDo:ifUnresolved: (in category 'enumerating') ----- - allDependenciesDo: aBlock ifUnresolved: failBlock - | dict | - dict := Dictionary new. - self allDependenciesNotIn: dict do: aBlock ifUnresolved: failBlock! Item was removed: - ----- Method: MCVersion>>allDependenciesNotIn:do:ifUnresolved: (in category 'enumerating') ----- - allDependenciesNotIn: aDictionary do: aBlock ifUnresolved: failBlock - - self dependencies do: - [:ea | | version | - version := aDictionary at: ea ifAbsent: [ea resolve]. - version - ifNil: [failBlock value: ea] - ifNotNil: [(aDictionary includes: version) ifFalse: - [aDictionary at: ea put: version. - version - allDependenciesNotIn: aDictionary - do: aBlock - ifUnresolved: failBlock. - aBlock value: version]]]! Item was removed: - ----- Method: MCVersion>>asDiffAgainst: (in category 'converting') ----- - asDiffAgainst: aVersion - aVersion info = self info ifTrue: [self error: 'Cannot diff against self!!']. - ^ MCDiffyVersion - package: self package - info: self info - snapshot: self snapshot - dependencies: self dependencies - baseVersion: aVersion! Item was removed: - ----- Method: MCVersion>>browse (in category 'actions') ----- - browse - (MCSnapshotBrowser forSnapshot: self snapshot) - label: 'Snapshot of ', self fileName; - show! Item was removed: - ----- Method: MCVersion>>canOptimizeLoading (in category 'testing') ----- - canOptimizeLoading - "Answer wether I can provide a patch for the working copy without the usual diff pass" - ^false! Item was removed: - ----- Method: MCVersion>>changes (in category 'accessing') ----- - changes - ^ self snapshot patchRelativeToBase: package snapshot! Item was removed: - ----- Method: MCVersion>>dependencies (in category 'accessing') ----- - dependencies - ^ dependencies ifNil: [#()]! Item was removed: - ----- Method: MCVersion>>fileName (in category 'accessing') ----- - fileName - |rawName cookedName| - - rawName := info name. - "care for invalid filename characters" - cookedName := rawName copy - replaceAll: $/ with: $_; - replaceAll: $: with: $_.. - ^ (cookedName, '.', self writerClass extension) asMCVersionName! Item was removed: - ----- Method: MCVersion>>fileOutOn: (in category 'actions') ----- - fileOutOn: aStream - self writerClass fileOut: self on: aStream! Item was removed: - ----- Method: MCVersion>>info (in category 'accessing') ----- - info - ^ info! Item was removed: - ----- Method: MCVersion>>initializeWithPackage:info:snapshot:dependencies: (in category 'initialize-release') ----- - initializeWithPackage: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection - self - setPackage: aPackage - info: aVersionInfo - snapshot: aSnapshot - dependencies: aCollection. - self addToCache! Item was removed: - ----- Method: MCVersion>>isCacheable (in category 'testing') ----- - isCacheable - ^true! Item was removed: - ----- Method: MCVersion>>isDiffy (in category 'testing') ----- - isDiffy - ^ false! Item was removed: - ----- Method: MCVersion>>load (in category 'actions') ----- - load - self workingCopy withEnvironmentActiveDo: [MCVersionLoader loadVersion: self]! Item was removed: - ----- Method: MCVersion>>logLoadingOn: (in category 'printing') ----- - logLoadingOn: aStream - aStream - nextPutAll: '========== ', self info name, ' =========='; cr; - nextPutAll: self info message asString; cr; - flush. - - package hasWorkingCopy ifFalse: [^self]. - - package workingCopy ancestors do: [:each | - (self info hasAncestor: each) - ifTrue: [(self info allAncestorsOnPathTo: each) - do: [:ver | aStream cr; nextPutAll: '>>> ', ver name, ' <<<'; cr; - nextPutAll: ver message; cr; flush]]]! Item was removed: - ----- Method: MCVersion>>merge (in category 'actions') ----- - merge - self workingCopy withEnvironmentActiveDo: [MCVersionMerger mergeVersion: self]! Item was removed: - ----- Method: MCVersion>>open (in category 'actions') ----- - open - (MCVersionInspector new version: self) show! Item was removed: - ----- Method: MCVersion>>package (in category 'accessing') ----- - package - ^ package! Item was removed: - ----- Method: MCVersion>>printOn: (in category 'printing') ----- - printOn: aStream - super printOn: aStream. - aStream nextPut: $(. - aStream nextPutAll: self info name. - aStream nextPut: $).! Item was removed: - ----- Method: MCVersion>>reparent (in category 'actions') ----- - reparent - "Let aNode be the sole parent of this version" - self workingCopy reparent: self! Item was removed: - ----- Method: MCVersion>>setPackage:info:snapshot:dependencies: (in category 'initialize-release') ----- - setPackage: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection - package := aPackage. - info := aVersionInfo. - snapshot := aSnapshot. - dependencies := aCollection! Item was removed: - ----- Method: MCVersion>>shouldMerge (in category 'testing') ----- - shouldMerge - "answer true if we have to do a full merge and false if we can simply load instead" - | pkg wc current | - (pkg := self package) hasWorkingCopy ifFalse: [^false "no wc -> load"]. - (wc := pkg workingCopy) modified ifTrue: [^true "modified -> merge"]. - wc ancestors isEmpty ifTrue: [^true "no ancestor info -> merge"]. - current := wc ancestors first. - (self info hasAncestor: current) ifTrue: [^false "direct descendant of wc -> load"]. - "new branch -> merge" - ^true! Item was removed: - ----- Method: MCVersion>>snapshot (in category 'accessing') ----- - snapshot - ^ snapshot! Item was removed: - ----- Method: MCVersion>>summary (in category 'accessing') ----- - summary - ^ String streamContents: - [:s | - s nextPutAll: info summaryHeader. - (dependencies isNil or: [dependencies isEmpty]) ifFalse: - [s cr; nextPutAll: 'Dependencies: '. - dependencies - do: [:ea | s nextPutAll: ea versionInfo name] - separatedBy: [s nextPutAll: ', ']]. - s cr; cr; nextPutAll: info message]! Item was removed: - ----- Method: MCVersion>>withAllDependenciesDo: (in category 'enumerating') ----- - withAllDependenciesDo: aBlock - self allDependenciesDo: aBlock ifUnresolved: [:ignored|]. - aBlock value: self! Item was removed: - ----- Method: MCVersion>>withAllDependenciesDo:ifUnresolved: (in category 'enumerating') ----- - withAllDependenciesDo: aBlock ifUnresolved: failBlock - | dict | - dict := Dictionary new. - self allDependenciesNotIn: dict do: aBlock ifUnresolved: failBlock. - aBlock value: self! Item was removed: - ----- Method: MCVersion>>workingCopy (in category 'accessing') ----- - workingCopy - ^ package workingCopy! Item was removed: - ----- Method: MCVersion>>writerClass (in category 'accessing') ----- - writerClass - ^ MCMczWriter ! Item was removed: - Object subclass: #MCVersionDependency - instanceVariableNames: 'package versionInfo' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Versioning'! Item was removed: - ----- Method: MCVersionDependency class>>package:info: (in category 'instance creation') ----- - package: aPackage info: aVersionInfo - ^ self basicNew initializeWithPackage: aPackage info: aVersionInfo! Item was removed: - ----- Method: MCVersionDependency>>= (in category 'comparing') ----- - = other - ^ other species = self species - and: [other versionInfo = versionInfo - and: [other package = package]]! Item was removed: - ----- Method: MCVersionDependency>>hash (in category 'comparing') ----- - hash - ^ versionInfo hash! Item was removed: - ----- Method: MCVersionDependency>>initializeWithPackage:info: (in category 'initialize-release') ----- - initializeWithPackage: aPackage info: aVersionInfo - package := aPackage. - versionInfo := aVersionInfo! Item was removed: - ----- Method: MCVersionDependency>>isCurrent (in category 'testing') ----- - isCurrent - ^ package hasWorkingCopy - and: [self isFulfilled - and: [package workingCopy modified not]]! Item was removed: - ----- Method: MCVersionDependency>>isFulfilled (in category 'testing') ----- - isFulfilled - ^package hasWorkingCopy - and: [self isFulfilledBy: package workingCopy ancestry]! Item was removed: - ----- Method: MCVersionDependency>>isFulfilledBy: (in category 'testing') ----- - isFulfilledBy: anAncestry - ^ anAncestry ancestors includes: versionInfo! Item was removed: - ----- Method: MCVersionDependency>>isFulfilledByAncestors (in category 'testing') ----- - isFulfilledByAncestors - ^ package hasWorkingCopy - and: [self isFulfilledByAncestorsOf: package workingCopy ancestry]! Item was removed: - ----- Method: MCVersionDependency>>isFulfilledByAncestorsOf: (in category 'testing') ----- - isFulfilledByAncestorsOf: anAncestry - ^ anAncestry hasAncestor: versionInfo! Item was removed: - ----- Method: MCVersionDependency>>isOlder (in category 'testing') ----- - isOlder - "Answer true if I represent an older version of a package that is loaded." - ^ package hasWorkingCopy - and: [self isFulfilled not - and: [ self isFulfilledByAncestors - and: [package workingCopy modified not]]]! Item was removed: - ----- Method: MCVersionDependency>>package (in category 'accessing') ----- - package - ^ package! Item was removed: - ----- Method: MCVersionDependency>>packageAndBranchName (in category 'accessing') ----- - packageAndBranchName - ^self versionInfo packageAndBranchName! Item was removed: - ----- Method: MCVersionDependency>>printOn: (in category 'printing') ----- - printOn: aStream - super printOn: aStream. - aStream nextPut: $(. - versionInfo printOn: aStream. - aStream nextPut: $).! Item was removed: - ----- Method: MCVersionDependency>>repositoryGroup (in category 'accessing') ----- - repositoryGroup - ^ self package workingCopy repositoryGroup! Item was removed: - ----- Method: MCVersionDependency>>resolve (in category 'resolving') ----- - resolve - ^ self repositoryGroup - versionWithInfo: versionInfo - ifNone: [ MCRepositoryGroup default versionWithInfo: versionInfo ifNone: []]! Item was removed: - ----- Method: MCVersionDependency>>versionInfo (in category 'accessing') ----- - versionInfo - ^ versionInfo! Item was removed: - MCTool subclass: #MCVersionHistoryBrowser - instanceVariableNames: 'ancestry index package infos' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-UI'! Item was removed: - ----- Method: MCVersionHistoryBrowser>>ancestry: (in category 'accessing') ----- - ancestry: anAncestry - ancestry := anAncestry! Item was removed: - ----- Method: MCVersionHistoryBrowser>>baseSnapshot (in category 'accessing') ----- - baseSnapshot - ^ self snapshotForInfo: ancestry! Item was removed: - ----- Method: MCVersionHistoryBrowser>>defaultExtent (in category 'morphic ui') ----- - defaultExtent - ^ 440 at 169. - ! Item was removed: - ----- Method: MCVersionHistoryBrowser>>defaultLabel (in category 'morphic ui') ----- - defaultLabel - ^ '{1} History' translated format: {ancestry name}! Item was removed: - ----- Method: MCVersionHistoryBrowser>>getMenu: (in category 'morphic ui') ----- - getMenu: aMenu - | menuSpecs | - self selection < 1 ifTrue: [^ aMenu]. "Nothing selected = nothing to do" - menuSpecs := (self selectedInfo ancestors collect: [:parent | - {'view changes from ', parent name . #viewChanges: . parent}]), - #(('spawn history' spawnHistory) - ('search history' searchHistory)). - self selection > 1 ifTrue: [menuSpecs := {{'view changes to ', ancestry name . #viewChanges}}, menuSpecs]. - self fillMenu: aMenu fromSpecs: menuSpecs. - ^ aMenu! Item was removed: - ----- Method: MCVersionHistoryBrowser>>index (in category 'accessing') ----- - index - "Answer the value of index" - - ^ index! Item was removed: - ----- Method: MCVersionHistoryBrowser>>index: (in category 'accessing') ----- - index: anObject - "Set the value of index" - - index := anObject! Item was removed: - ----- Method: MCVersionHistoryBrowser>>infos (in category 'accessing') ----- - infos - ^ infos ifNil: [infos := ancestry topologicalAncestors]! Item was removed: - ----- Method: MCVersionHistoryBrowser>>list (in category 'accessing') ----- - list - ^ self infos collect: [:ea | ea name]! Item was removed: - ----- Method: MCVersionHistoryBrowser>>package (in category 'accessing') ----- - package - ^ package! Item was removed: - ----- Method: MCVersionHistoryBrowser>>package: (in category 'accessing') ----- - package: aMCPackage - package := aMCPackage! Item was removed: - ----- Method: MCVersionHistoryBrowser>>repositoryGroup (in category 'accessing') ----- - repositoryGroup - - ^ self package workingCopy repositoryGroup! Item was removed: - ----- Method: MCVersionHistoryBrowser>>searchHistory (in category 'morphic ui') ----- - searchHistory - (Project uiManager - edit: (String streamContents: - [:s| - self selectedInfo topologicalAncestors - do: [:versionInfo | s nextPutAll: versionInfo summary] - separatedBy: [s cr; cr]]) - label: ('Version History: {1}' translated format: {self selectedInfo versionName})) - extent: (0.5 at 0.9) * Display height! Item was removed: - ----- Method: MCVersionHistoryBrowser>>selectedInfo (in category 'accessing') ----- - selectedInfo - ^ self infos at: self selection ifAbsent: [nil]! Item was removed: - ----- Method: MCVersionHistoryBrowser>>selectedSnapshot (in category 'accessing') ----- - selectedSnapshot - ^ self selectedInfo isWorkingAncestry - ifTrue: [self package snapshot] - ifFalse: [self snapshotForInfo: self selectedInfo]! Item was removed: - ----- Method: MCVersionHistoryBrowser>>selection (in category 'accessing') ----- - selection - ^ index ifNil: [0]! Item was removed: - ----- Method: MCVersionHistoryBrowser>>selection: (in category 'accessing') ----- - selection: aNumber - index := aNumber. - self changed: #selection; changed: #summary! Item was removed: - ----- Method: MCVersionHistoryBrowser>>snapshotForInfo: (in category 'accessing') ----- - snapshotForInfo: aVersionInfo - ^ (self repositoryGroup versionWithInfo: aVersionInfo) snapshot! Item was removed: - ----- Method: MCVersionHistoryBrowser>>spawnHistory (in category 'morphic ui') ----- - spawnHistory - MCVersionHistoryBrowser new - ancestry: self selectedInfo; - package: package; - show! Item was removed: - ----- Method: MCVersionHistoryBrowser>>summary (in category 'accessing') ----- - summary - | selInfo | - selInfo := self selectedInfo. - ^ selInfo - ifNil: [''] - ifNotNil: [selInfo summary]! Item was removed: - ----- Method: MCVersionHistoryBrowser>>viewChanges (in category 'morphic ui') ----- - viewChanges - self viewChanges: ancestry snapshot: self baseSnapshot - relativeTo: self selectedInfo snapshot: self selectedSnapshot! Item was removed: - ----- Method: MCVersionHistoryBrowser>>viewChanges: (in category 'morphic ui') ----- - viewChanges: otherInfo - self viewChanges: self selectedInfo snapshot: self selectedSnapshot - relativeTo: otherInfo snapshot: (self snapshotForInfo: otherInfo)! Item was removed: - ----- Method: MCVersionHistoryBrowser>>viewChanges:snapshot:relativeTo:snapshot: (in category 'morphic ui') ----- - viewChanges: ancestorInfo snapshot: ancestorSnapshot relativeTo: baseInfo snapshot: baseSnapshot - "Note that the patchLabel will be parsed in MCPatchBrowser>>installSelection, so don't translate it!!" - | patch patchLabel | - patchLabel := 'changes between {1} and {2}' translated format: { baseInfo name. ancestorInfo name }. - patch := ancestorSnapshot patchRelativeToBase: baseSnapshot. - (MCPatchBrowser forPatch: patch) label: patchLabel; show! Item was removed: - ----- Method: MCVersionHistoryBrowser>>widgetSpecs (in category 'morphic ui') ----- - widgetSpecs - ^ #( - ((listMorph:selection:menu: list selection getMenu:) (0 0 0.3 1)) - ((textMorph: summary) (0.3 0 1 1)) - )! Item was removed: - MCAncestry subclass: #MCVersionInfo - instanceVariableNames: 'id name message date time author' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Versioning'! - - !MCVersionInfo commentStamp: '<historical>' prior: 0! - Adds to the record of ancestry, other identifying details.! Item was removed: - ----- Method: MCVersionInfo class>>name:id:message:date:time:author:ancestors: (in category 'instance creation') ----- - 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 removed: - ----- Method: MCVersionInfo class>>name:id:message:date:time:author:ancestors:stepChildren: (in category 'instance creation') ----- - 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 removed: - ----- Method: MCVersionInfo>>= (in category 'comparing') ----- - = other - ^ other species = self species - and: [other hasID: id]! Item was removed: - ----- Method: MCVersionInfo>>asDictionary (in category 'converting') ----- - asDictionary - ^ Dictionary new - at: #name put: name; - at: #id put: id asString; - at: #message put: message; - at: #date put: date; - at: #time put: time; - at: #author put: author; - at: #ancestors put: (self ancestors collect: [:a | a asDictionary]); - yourself! Item was removed: - ----- Method: MCVersionInfo>>author (in category 'pillaging') ----- - author - ^ author! Item was removed: - ----- Method: MCVersionInfo>>copyWithTrimmedAncestry (in category 'initialize-release') ----- - copyWithTrimmedAncestry - ^ self copy postCopyWithTrimmedAncestry! Item was removed: - ----- Method: MCVersionInfo>>date (in category 'pillaging') ----- - date - ^ date! Item was removed: - ----- Method: MCVersionInfo>>dateAndTime (in category 'accessing') ----- - dateAndTime - ^ DateAndTime - date: date - time: (time ifNil: [ Time midnight ])! Item was removed: - ----- Method: MCVersionInfo>>hasID: (in category 'private') ----- - hasID: aUUID - ^ id = aUUID! Item was removed: - ----- Method: MCVersionInfo>>hash (in category 'comparing') ----- - hash - ^ id hash! Item was removed: - ----- Method: MCVersionInfo>>id (in category 'pillaging') ----- - id - ^ id ! Item was removed: - ----- Method: MCVersionInfo>>initializeWithName:id:message:date:time:author:ancestors:stepChildren: (in category 'initialize-release') ----- - initializeWithName: vName id: aUUID message: aString date: aDate time: aTime author: initials ancestors: aCollection stepChildren: stepCollection - name := vName asString asMCVersionName. - id := aUUID. - message := aString. - date := aDate. - time := aTime. - author := initials. - ancestors := aCollection. - stepChildren := stepCollection! Item was removed: - ----- Method: MCVersionInfo>>message (in category 'accessing') ----- - message - ^ message ifNil: ['']! Item was removed: - ----- Method: MCVersionInfo>>name (in category 'accessing') ----- - name - ^ name ifNil: [self nameForWorkingCopy]! Item was removed: - ----- Method: MCVersionInfo>>nameWithout: (in category 'accessing') ----- - nameWithout: packageName - | result | - result := self name. - (result beginsWith: packageName , '-') ifTrue: [ - result := result copyFrom: packageName size + 2 to: result size]. - ^result! Item was removed: - ----- Method: MCVersionInfo>>packageAndBranchName (in category 'accessing') ----- - packageAndBranchName - ^ name - ifNil: [ self name ] - ifNotNil: [ name asMCVersionName packageAndBranchName ]! Item was removed: - ----- Method: MCVersionInfo>>printOn: (in category 'printing') ----- - printOn: aStream - super printOn: aStream. - aStream nextPut: $(; nextPutAll: self name; nextPut: $) - ! Item was removed: - ----- Method: MCVersionInfo>>summary (in category 'accessing') ----- - summary - ^ String streamContents: - [:s | - s - nextPutAll: self summaryHeader; cr; cr; - nextPutAll: self message. - ]! Item was removed: - ----- Method: MCVersionInfo>>summaryHeader (in category 'accessing') ----- - summaryHeader - ^ String streamContents: - [:s | - s - nextPutAll: 'Name: '; nextPutAll: self name; cr. - date ifNotNil: - [s - nextPutAll: 'Author: '; nextPutAll: author; cr; - nextPutAll: 'Time: '; nextPutAll: date asString, ', ', time asString; cr]. - id ifNotNil: - [s nextPutAll: 'UUID: '; nextPutAll: id asString; cr]. - s - nextPutAll: 'Ancestors: '; nextPutAll: self ancestorString. - self stepChildren isEmpty ifFalse: - [s cr; nextPutAll: 'Backported From: '; nextPutAll: self stepChildrenString]. - ]! Item was removed: - ----- Method: MCVersionInfo>>time (in category 'pillaging') ----- - time - ^ time! Item was removed: - ----- Method: MCVersionInfo>>timeStamp (in category 'accessing') ----- - timeStamp - ^ TimeStamp date: date time: (time ifNil: [Time fromString: '00:00'])! Item was removed: - ----- Method: MCVersionInfo>>timeString (in category 'accessing') ----- - timeString - ^ date asString, ', ', time asString! Item was removed: - ----- Method: MCVersionInfo>>versionName (in category 'accessing') ----- - versionName - ^ name - ifNil: [ self name ] - ifNotNil: [ name asMCVersionName ]! Item was removed: - ----- Method: MCVersionInfo>>versionNumber (in category 'accessing') ----- - versionNumber - ^ self versionName versionNumber! Item was removed: - MCWriter subclass: #MCVersionInfoWriter - instanceVariableNames: 'written' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Storing'! Item was removed: - ----- Method: MCVersionInfoWriter>>isWritten: (in category 'testing') ----- - isWritten: aVersionInfo - ^ self written includes: aVersionInfo! Item was removed: - ----- Method: MCVersionInfoWriter>>writeVersionInfo: (in category 'writing') ----- - 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 removed: - ----- Method: MCVersionInfoWriter>>written (in category 'accessing') ----- - written - ^ written ifNil: [written := Set new]! Item was removed: - ----- Method: MCVersionInfoWriter>>wrote: (in category 'accessing') ----- - wrote: aVersionInfo - self written add: aVersionInfo! Item was removed: - MCTool subclass: #MCVersionInspector - instanceVariableNames: 'version' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-UI'! Item was removed: - ----- Method: MCVersionInspector>>adopt (in category 'accessing') ----- - adopt - (self confirm: - 'Modifying ancestry can be dangerous unless you know - what you are doing. Are you sure you want to adopt - ',self version info name, ' as an ancestor of your working copy?') - ifTrue: [self version adopt]! Item was removed: - ----- Method: MCVersionInspector>>browse (in category 'accessing') ----- - browse - self version browse! Item was removed: - ----- Method: MCVersionInspector>>buttonSpecs (in category 'morphic ui') ----- - buttonSpecs - - ^ #( - ((button: ('Refresh' refresh 'refresh the version-list'))) - ((button: (Browse browse 'Browse this version' hasVersion))) - ((button: (History history 'Browse the history of this version' hasVersion))) - ((button: (Changes changes 'Browse the changes this version would make to the image' hasVersion))) - ((button: (Load load 'Load this version into the image' hasVersion))) - ((button: (Merge merge 'Merge this version into the image' hasVersion))) - ((button: (Adopt adopt 'Adopt this version as an ancestor of your working copy' hasVersion))) - ((button: (Reparent reparent 'Adopt this version as the sole ancestor of your working copy' hasVersion))) - ((button: (Copy save 'Copy this version to another repository' hasVersion))) - ((button: (Diff diff 'Create an equivalent version based on an earlier release' hasVersion))) - )! Item was removed: - ----- Method: MCVersionInspector>>changes (in category 'accessing') ----- - changes - (MCPatchBrowser forPatch: self version changes) - showLabelled: 'Changes from ', self version info name! Item was removed: - ----- Method: MCVersionInspector>>defaultExtent (in category 'morphic ui') ----- - defaultExtent - ^ 450 at 200! Item was removed: - ----- Method: MCVersionInspector>>defaultLabel (in category 'morphic ui') ----- - defaultLabel - ^ 'Version: ', self version info name! Item was removed: - ----- Method: MCVersionInspector>>diff (in category 'accessing') ----- - diff - | ancestorVersion | - self pickAncestor ifNotNil: - [:ancestor | - ancestorVersion := self version workingCopy repositoryGroup versionWithInfo: ancestor. - (self version asDiffAgainst: ancestorVersion) open]! Item was removed: - ----- Method: MCVersionInspector>>hasVersion (in category 'accessing') ----- - hasVersion - ^version notNil! Item was removed: - ----- Method: MCVersionInspector>>history (in category 'accessing') ----- - history - (MCVersionHistoryBrowser new - package: self version package; - ancestry: self versionInfo) show! Item was removed: - ----- Method: MCVersionInspector>>load (in category 'accessing') ----- - load - Cursor wait showWhile: [self version load]! Item was removed: - ----- Method: MCVersionInspector>>merge (in category 'accessing') ----- - merge - self version merge! Item was removed: - ----- 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 = 0 ifFalse: [versions at: index]! Item was removed: - ----- Method: MCVersionInspector>>pickRepository (in category 'morphic ui') ----- - pickRepository - | index | - index := UIManager default chooseFrom: (self repositories collect: [:ea | ea description]) - title: 'Repository:'. - ^ index = 0 ifFalse: [self repositories at: index]! Item was removed: - ----- Method: MCVersionInspector>>reparent (in category 'accessing') ----- - reparent - (self confirm:'Adopt ',self version info name, ' as the sole ancestor of your working copy?') - ifTrue: [ - self version reparent. - self refresh]! Item was removed: - ----- Method: MCVersionInspector>>repositories (in category 'morphic ui') ----- - repositories - ^ MCRepositoryGroup default repositories! Item was removed: - ----- Method: MCVersionInspector>>save (in category 'accessing') ----- - save - self pickRepository ifNotNil: - [:ea | - ea storeVersion: self version]! Item was removed: - ----- Method: MCVersionInspector>>summary (in category 'accessing') ----- - summary - ^self hasVersion - ifTrue: [ self versionSummary ] - ifFalse: [ String new ]! Item was removed: - ----- Method: MCVersionInspector>>version (in category 'accessing') ----- - version - ^ version! Item was removed: - ----- Method: MCVersionInspector>>version: (in category 'accessing') ----- - version: aVersion - version := aVersion! Item was removed: - ----- Method: MCVersionInspector>>versionInfo (in category 'accessing') ----- - versionInfo - ^ self version info! Item was removed: - ----- Method: MCVersionInspector>>versionSummary (in category 'accessing') ----- - versionSummary - ^ self version summary! Item was removed: - ----- Method: MCVersionInspector>>widgetSpecs (in category 'morphic ui') ----- - widgetSpecs - ^ #( - ((buttonRow) (0 0 1 0) (0 0 0 defaultButtonPaneHeight)) - ((textMorph: summary) (0 0 1 1) (0 defaultButtonPaneHeight 0 0)) - )! Item was removed: - Object subclass: #MCVersionLoader - instanceVariableNames: 'versions' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Loading'! Item was removed: - ----- Method: MCVersionLoader class>>loadVersion: (in category 'loading') ----- - loadVersion: aVersion - self new - addVersion: aVersion; - load! Item was removed: - ----- Method: MCVersionLoader class>>new (in category 'instance creation') ----- - new - ^ self basicNew initialize! Item was removed: - ----- Method: MCVersionLoader>>addDependency: (in category 'loading') ----- - addDependency: aDependency - | dep | - aDependency isCurrent ifTrue: [^ self]. - (self depAgeIsOk: aDependency) ifFalse: [^ self]. - dep := aDependency resolve. - dep - ifNil: [self confirmMissingDependency: aDependency] - ifNotNil: [(versions includes: dep) ifFalse: [self addVersion: dep]]! Item was removed: - ----- Method: MCVersionLoader>>addVersion: (in category 'loading') ----- - addVersion: aVersion - aVersion dependencies do: [ :ea | self addDependency: ea]. - versions add: aVersion. - ! Item was removed: - ----- Method: MCVersionLoader>>checkForModifications (in category 'checking') ----- - checkForModifications - | modifications | - modifications := versions select: [:ea | ea package workingCopy modified]. - modifications isEmpty ifFalse: [self warnAboutLosingChangesTo: modifications].! Item was removed: - ----- Method: MCVersionLoader>>checkIfDepIsOlder: (in category 'checking') ----- - checkIfDepIsOlder: aDependency - ^ aDependency isOlder not - or: [self confirm: 'load older dependency ', aDependency versionInfo name , '?']! Item was removed: - ----- Method: MCVersionLoader>>confirmMissingDependency: (in category 'checking') ----- - confirmMissingDependency: aDependency - | name | - name := aDependency versionInfo name. - (self confirm: 'Can''t find dependency ', name, '. ignore?') - ifFalse: [self error: 'Can''t find dependency ', name]! Item was removed: - ----- Method: MCVersionLoader>>depAgeIsOk: (in category 'checking') ----- - depAgeIsOk: aDependency - ^ aDependency isOlder not - or: [self confirm: 'load older dependency ', aDependency versionInfo name , '?']! Item was removed: - ----- Method: MCVersionLoader>>initialize (in category 'initialize-release') ----- - initialize - versions := OrderedCollection new! Item was removed: - ----- Method: MCVersionLoader>>load (in category 'loading') ----- - load - | loader | - self checkForModifications. - loader := MCPackageLoader new. - versions do: [:ea | - loader appendToPreamble: (String streamContents: [:s | ea logLoadingOn: s]). - ea canOptimizeLoading - ifTrue: [ea patch applyTo: loader] - ifFalse: [loader updatePackage: ea package withSnapshot: ea snapshot]]. - loader loadWithNameLike: versions first info name. - versions do: [:ea | ea workingCopy loaded: ea]! Item was removed: - ----- Method: MCVersionLoader>>warnAboutLosingChangesTo: (in category 'checking') ----- - warnAboutLosingChangesTo: versionCollection - self notify: (String streamContents: [:s | - s nextPutAll: 'You are about to load new versions of the following packages that have unsaved changes in the image. If you continue, you will lose these changes.'; cr. - versionCollection do: - [:ea | - s cr; space; space; nextPutAll: ea package name]])! Item was removed: - Object subclass: #MCVersionMerger - instanceVariableNames: 'records merger' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Versioning'! Item was removed: - ----- Method: MCVersionMerger class>>mergeVersion: (in category 'merging') ----- - mergeVersion: aVersion - self new - addVersion: aVersion; - mergeWithNameLike: aVersion info name! Item was removed: - ----- Method: MCVersionMerger class>>new (in category 'instance creation') ----- - new - ^ self basicNew initialize! Item was removed: - ----- Method: MCVersionMerger>>addVersion: (in category 'accessing') ----- - 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 removed: - ----- Method: MCVersionMerger>>initialize (in category 'initialize-release') ----- - initialize - records := OrderedCollection new. - merger := MCThreeWayMerger new.! Item was removed: - ----- Method: MCVersionMerger>>merge (in category 'merging') ----- - 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 removed: - ----- Method: MCVersionMerger>>mergeWithNameLike: (in category 'merging') ----- - 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 removed: - ----- Method: MCVersionMerger>>resolveConflicts (in category 'testing') ----- - resolveConflicts - (records allSatisfy: [:ea | ea isAncestorMerge]) ifTrue: [MCNoChangesException signal. ^ false]. - ^ ((MCMergeResolutionRequest new merger: merger) - signal: 'Merging ', records first version info name) = true! Item was removed: - ByteString variableByteSubclass: #MCVersionName - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Modeling'! - - !MCVersionName commentStamp: 'cmm 3/4/2011 13:32' prior: 0! - A MCVersionName models the Monticello file / version name, in the format [Package]-[Author].[version-number]([ancestorAuthor.ancestorVersionNumber]).[mc?]. - - Any file-extension, if present, is ignored.! Item was removed: - ----- Method: MCVersionName class>>on: (in category 'instance creation') ----- - on: aString - "aString may be with or without a mc? extension." - ^ (self new: aString size) - replaceFrom: 1 - to: aString size - with: aString - startingAt: 1 ; - yourself! Item was removed: - ----- Method: MCVersionName>>= (in category 'comparing') ----- - = aByteString - "Ignore any file-extension for comparison of MCVersionNames." - | myVersionName | - aByteString isString ifFalse: [ ^ false ]. - myVersionName := self versionName. - ^ (myVersionName - compare: myVersionName - with: aByteString asMCVersionName versionName - collated: AsciiOrder) = 2! Item was removed: - ----- Method: MCVersionName>>asMCVersionName (in category 'converting') ----- - asMCVersionName - ^ self! Item was removed: - ----- Method: MCVersionName>>author (in category 'accessing') ----- - author - "The author initials embedded in the filename." - - ^(self versionName copyAfterLast: $-) copyUpTo: $.! Item was removed: - ----- Method: MCVersionName>>baseVersionName (in category 'accessing') ----- - baseVersionName - "The version name of our ancestor, if this is a Diffy filename." - - ^(MCDiffyVersion baseNameFrom: (self copyUpThrough: $))) asMCVersionName! Item was removed: - ----- Method: MCVersionName>>hash (in category 'comparing') ----- - hash - ^ self versionName hash! Item was removed: - ----- Method: MCVersionName>>isValid (in category 'testing') ----- - isValid - ^ [ (self endsWith: '.mcm') or: - [ self packageName notEmpty and: - [ self author notEmpty and: [ self versionNumber > 0 ] ] ] ] - on: Error - do: - [ : err | false ]! Item was removed: - ----- Method: MCVersionName>>packageAndBranchName (in category 'accessing') ----- - packageAndBranchName - "The MC package name, possibly with branch name, embedded into this filename." - - ^self versionName copyUpToLast: $-! Item was removed: - ----- Method: MCVersionName>>packageName (in category 'accessing') ----- - packageName - "The MC Package name embedded into this filename." - - ^self packageAndBranchName copyUpTo: $.! Item was removed: - ----- Method: MCVersionName>>species (in category 'private') ----- - species - ^ ByteString! Item was removed: - ----- Method: MCVersionName>>versionName (in category 'accessing') ----- - versionName - "Answer my version name as a ByteString, without the file suffix or any ancestor-attributes." - | end | - self isEmpty ifTrue: [^ String empty]. - end := self indexOf: $( ifAbsent: [ - | size | - size := self size. - (size > 4 - and: [ (self at: size - 3) == $. - and: [ (self at: size - 2) == $m - and: [ (self at: size - 1) == $c ] ] ]) - ifTrue: [size - 3] - ifFalse: [size + 1]]. - ^self first: end - 1! Item was removed: - ----- Method: MCVersionName>>versionNumber (in category 'accessing') ----- - versionNumber - "The Integer version number identified by this filename." - | v | - v := (self versionName copyAfterLast: $-) copyAfter: $.. - ^(v notEmpty and: [v first isDigit]) - ifTrue: [ v asInteger ] - ifFalse: [ 0 ]! Item was removed: - Notification subclass: #MCVersionNameAndMessageRequest - instanceVariableNames: 'suggestion initialMessage patchBlock' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Versioning'! Item was removed: - ----- Method: MCVersionNameAndMessageRequest>>defaultAction (in category 'handling') ----- - defaultAction - ^ MCSaveVersionDialog new - versionName: suggestion; - logMessage: initialMessage; - patchBlock: patchBlock; - selection: 1; - showModally! Item was removed: - ----- Method: MCVersionNameAndMessageRequest>>initialMessage (in category 'accessing') ----- - initialMessage - ^ initialMessage! Item was removed: - ----- Method: MCVersionNameAndMessageRequest>>initialMessage: (in category 'accessing') ----- - initialMessage: aString - initialMessage := aString! Item was removed: - ----- Method: MCVersionNameAndMessageRequest>>patchBlock (in category 'accessing') ----- - patchBlock - ^ patchBlock! Item was removed: - ----- Method: MCVersionNameAndMessageRequest>>patchBlock: (in category 'accessing') ----- - patchBlock: aBlock - patchBlock := aBlock - ! Item was removed: - ----- Method: MCVersionNameAndMessageRequest>>suggestedName (in category 'accessing') ----- - suggestedName - ^ suggestion! Item was removed: - ----- Method: MCVersionNameAndMessageRequest>>suggestedName: (in category 'accessing') ----- - suggestedName: aString - suggestion := aString! Item was removed: - Object subclass: #MCVersionNotification - instanceVariableNames: 'version ancestor repository changes' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Repositories'! Item was removed: - ----- Method: MCVersionNotification class>>version:repository: (in category 'instance creation') ----- - version: aVersion repository: aRepository - ^ self basicNew initializeWithVersion: aVersion repository: aRepository! Item was removed: - ----- Method: MCVersionNotification>>fromAddress (in category 'accessing') ----- - fromAddress - ^ 'monticello at beta4.com'! Item was removed: - ----- Method: MCVersionNotification>>initializeWithVersion:repository: (in category 'private') ----- - initializeWithVersion: aVersion repository: aRepository - version := aVersion. - repository := aRepository. - ancestor := repository withCache closestAncestorVersionFor: version info ifNone: []. - changes := ancestor - ifNil: [#()] - ifNotNil: [(version snapshot patchRelativeToBase: ancestor snapshot) operations sorted]! Item was removed: - ----- Method: MCVersionNotification>>messageText (in category 'accessing') ----- - 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 removed: - ----- Method: MCVersionNotification>>messageTo: (in category 'private') ----- - 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 removed: - ----- Method: MCVersionNotification>>notify: (in category 'notifying') ----- - notify: aString - | message | - message := self messageTo: aString. - SMTPClient - deliverMailFrom: message from - to: { message to } - text: message text - usingServer: MailSender smtpServer! Item was removed: - MCReader subclass: #MCVersionReader - instanceVariableNames: 'package info definitions dependencies stepChildren' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Storing'! Item was removed: - ----- Method: MCVersionReader class>>file:streamDo: (in category 'reading') ----- - file: fileName streamDo: aBlock - - ^FileStream readOnlyFileNamed: fileName do: aBlock! Item was removed: - ----- Method: MCVersionReader class>>fileReaderServicesForFile:suffix: (in category 'file services') ----- - fileReaderServicesForFile: fullName suffix: suffix - self isAbstract ifTrue: [^ Array empty]. - ^ ((suffix = self extension) or: [ suffix = '*' ]) - ifTrue: [self services] - ifFalse: [Array empty] - ! Item was removed: - ----- Method: MCVersionReader class>>initialize (in category 'file services') ----- - initialize - "MCVersionReader initialize" - Smalltalk - at: #MczInstaller - ifPresent: [:installer | FileServices unregisterFileReader: installer]. - self concreteSubclassesDo: [:aClass | FileServices registerFileReader: aClass]. - - "get rid of AnObsoleteMCMcReader and AnObsoleteMCMcvReader" - (FileServices registeredFileReaderClasses select: [ :ea | ea isObsolete ]) do: - [ :ea | FileServices unregisterFileReader: ea ] - ! Item was removed: - ----- Method: MCVersionReader class>>loadVersionFile: (in category 'file services') ----- - loadVersionFile: fileName - | version | - version := self versionFromFile: fileName. - version workingCopy repositoryGroup addRepository: (MCDirectoryRepository path: (FileDirectory dirPathFor: fileName)). - version load! Item was removed: - ----- Method: MCVersionReader class>>loadVersionStream:fromDirectory: (in category '*monticello-file services') ----- - loadVersionStream: stream fromDirectory: directory - | version | - version := self versionFromStream: stream. - directory isRemoteDirectory ifFalse: [ - version workingCopy repositoryGroup addRepository: - (MCDirectoryRepository directory: directory). ]. - version load. - ! Item was removed: - ----- Method: MCVersionReader class>>mergeVersionFile: (in category 'file services') ----- - mergeVersionFile: fileName - (self versionFromFile: fileName) merge! Item was removed: - ----- Method: MCVersionReader class>>mergeVersionStream: (in category '*monticello-file services') ----- - mergeVersionStream: stream - (self versionFromStream: stream) merge! Item was removed: - ----- Method: MCVersionReader class>>on:fileName: (in category 'reading') ----- - on: s fileName: f - ^ self on: s! Item was removed: - ----- Method: MCVersionReader class>>openVersionFile: (in category 'file services') ----- - openVersionFile: fileName - (self versionFromFile: fileName) open! Item was removed: - ----- Method: MCVersionReader class>>openVersionFromStream: (in category '*monticello-file services') ----- - openVersionFromStream: stream - (self versionFromStream: stream) open! Item was removed: - ----- Method: MCVersionReader class>>serviceLoadVersion (in category '*monticello-file services-override-override') ----- - serviceLoadVersion - ^ (SimpleServiceEntry - provider: self - label: 'load version' - selector: #loadVersionStream:fromDirectory: - description: 'load a package version' - buttonLabel: 'load') - argumentGetter: [ :fileList | { fileList readOnlyStream . fileList directory } ]! Item was removed: - ----- Method: MCVersionReader class>>serviceMergeVersion (in category '*monticello-file services-override-override') ----- - serviceMergeVersion - ^ (SimpleServiceEntry - provider: self - label: 'merge version' - selector: #mergeVersionStream: - description: 'merge a package version into the image' - buttonLabel: 'merge') - argumentGetter: [ :fileList | fileList readOnlyStream ]! Item was removed: - ----- Method: MCVersionReader class>>serviceOpenVersion (in category '*monticello-file services-override-override') ----- - serviceOpenVersion - ^ (SimpleServiceEntry - provider: self - label: 'open version' - selector: #openVersionFromStream: - description: 'open a package version' - buttonLabel: 'open') - argumentGetter: [ :fileList | fileList readOnlyStream ]! Item was removed: - ----- Method: MCVersionReader class>>services (in category 'file services') ----- - services - ^{ - self serviceLoadVersion. - self serviceMergeVersion. - self serviceOpenVersion }! Item was removed: - ----- Method: MCVersionReader class>>unload (in category 'file services') ----- - unload - FileServices unregisterFileReader: self ! Item was removed: - ----- Method: MCVersionReader class>>versionFromFile: (in category 'reading') ----- - versionFromFile: fileName - ^ self file: fileName streamDo: [:stream | self versionFromStream: stream]! Item was removed: - ----- Method: MCVersionReader class>>versionFromStream: (in category 'reading') ----- - versionFromStream: aStream - ^ (self on: aStream) version! Item was removed: - ----- Method: MCVersionReader class>>versionInfoFromStream: (in category 'reading') ----- - versionInfoFromStream: aStream - ^ (self on: aStream) info! Item was removed: - ----- Method: MCVersionReader>>basicVersion (in category 'accessing') ----- - basicVersion - ^ MCVersion - package: self package - info: self info - snapshot: self snapshot - dependencies: self dependencies! Item was removed: - ----- Method: MCVersionReader>>definitions (in category 'accessing') ----- - definitions - definitions ifNil: [self loadDefinitions]. - ^ definitions! Item was removed: - ----- Method: MCVersionReader>>dependencies (in category 'accessing') ----- - dependencies - dependencies ifNil: [self loadDependencies]. - ^ dependencies! Item was removed: - ----- Method: MCVersionReader>>info (in category 'accessing') ----- - info - info ifNil: [self loadVersionInfo]. - ^ info! Item was removed: - ----- Method: MCVersionReader>>initialize (in category 'lifecycle') ----- - initialize! Item was removed: - ----- Method: MCVersionReader>>loadDefinitions (in category 'loading') ----- - loadDefinitions - self subclassResponsibility ! Item was removed: - ----- Method: MCVersionReader>>loadDependencies (in category 'loading') ----- - loadDependencies - self subclassResponsibility ! Item was removed: - ----- Method: MCVersionReader>>loadPackage (in category 'loading') ----- - loadPackage - self subclassResponsibility ! Item was removed: - ----- Method: MCVersionReader>>loadVersionInfo (in category 'loading') ----- - loadVersionInfo - self subclassResponsibility! Item was removed: - ----- Method: MCVersionReader>>package (in category 'accessing') ----- - package - package ifNil: [self loadPackage]. - ^ package! Item was removed: - ----- Method: MCVersionReader>>snapshot (in category 'accessing') ----- - snapshot - ^ MCSnapshot fromDefinitions: self definitions! Item was removed: - ----- Method: MCVersionReader>>version (in category 'accessing') ----- - version - ^ self basicVersion! Item was removed: - Object subclass: #MCVersionSorter - instanceVariableNames: 'layers depthIndex depths stepparents roots' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Versioning'! Item was removed: - ----- Method: MCVersionSorter class>>new (in category 'instance creation') ----- - new - ^ self basicNew initialize! Item was removed: - ----- Method: MCVersionSorter>>addAllAncestorsOf:to: (in category 'accessing') ----- - addAllAncestorsOf: aVersionInfo to: aSet - (aSet includes: aVersionInfo) ifTrue: [^ self]. - aSet add: aVersionInfo. - (self knownAncestorsOf: aVersionInfo) do: - [:ea | - self addAllAncestorsOf: ea to: aSet]! Item was removed: - ----- Method: MCVersionSorter>>addAllVersionInfos: (in category 'accessing') ----- - addAllVersionInfos: aCollection - aCollection do: [:ea | self addVersionInfo: ea]! Item was removed: - ----- Method: MCVersionSorter>>addToCurrentLayer: (in category 'accessing') ----- - 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 removed: - ----- Method: MCVersionSorter>>addVersionInfo: (in category 'accessing') ----- - addVersionInfo: aVersionInfo - roots add: aVersionInfo. - self registerStepChildrenOf: aVersionInfo seen: Set new! Item was removed: - ----- Method: MCVersionSorter>>allAncestorsOf: (in category 'ancestry') ----- - allAncestorsOf: aVersionInfo - | all | - all := Set new. - self addAllAncestorsOf: aVersionInfo to: all. - ^ all! Item was removed: - ----- Method: MCVersionSorter>>initialize (in category 'initialize-release') ----- - initialize - stepparents := Dictionary new. - roots := OrderedCollection new.! Item was removed: - ----- Method: MCVersionSorter>>knownAncestorsOf: (in category 'ancestry') ----- - knownAncestorsOf: aVersionInfo - ^ aVersionInfo ancestors, (self stepParentsOf: aVersionInfo) asArray! Item was removed: - ----- Method: MCVersionSorter>>layers (in category 'accessing') ----- - layers - ^ layers! Item was removed: - ----- Method: MCVersionSorter>>popLayer (in category 'private') ----- - popLayer - depthIndex := depthIndex - 1! Item was removed: - ----- Method: MCVersionSorter>>processVersionInfo: (in category 'private') ----- - processVersionInfo: aVersionInfo - (self addToCurrentLayer: aVersionInfo) ifTrue: - [self pushLayer. - (self knownAncestorsOf: aVersionInfo) do: [:ea | self processVersionInfo: ea]. - self popLayer] - ! Item was removed: - ----- Method: MCVersionSorter>>pushLayer (in category 'private') ----- - pushLayer - depthIndex := depthIndex + 1. - depthIndex > layers size ifTrue: [layers add: OrderedCollection new]. - ! Item was removed: - ----- Method: MCVersionSorter>>registerStepChildrenOf:seen: (in category 'private') ----- - 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 removed: - ----- Method: MCVersionSorter>>sortedVersionInfos (in category 'versions') ----- - sortedVersionInfos - layers := OrderedCollection with: OrderedCollection new. - depthIndex := 1. - depths := Dictionary new. - roots do: [:ea | self processVersionInfo: ea]. - ^ layers gather: [:ea | ea]! Item was removed: - ----- Method: MCVersionSorter>>stepParentsOf: (in category 'ancestry') ----- - stepParentsOf: aVersionInfo - ^ (stepparents at: aVersionInfo ifAbsentPut: [Set new])! Item was removed: - MCAncestry subclass: #MCWorkingAncestry - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Versioning'! - - !MCWorkingAncestry commentStamp: '<historical>' prior: 0! - The interim record of ancestry for a working copy, gets merged version added to the ancestry, and is used to create the VersionInfo when the working copy becomes a version. ! Item was removed: - ----- Method: MCWorkingAncestry>>addAncestor: (in category 'accessing') ----- - addAncestor: aNode - ancestors := (self ancestors reject: [:each | aNode hasAncestor: each]) - copyWith: aNode! Item was removed: - ----- Method: MCWorkingAncestry>>addStepChild: (in category 'accessing') ----- - addStepChild: aVersionInfo - stepChildren := stepChildren copyWith: aVersionInfo! Item was removed: - ----- Method: MCWorkingAncestry>>infoWithName:message: (in category 'versions') ----- - 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 removed: - ----- Method: MCWorkingAncestry>>isWorkingAncestry (in category 'testing') ----- - isWorkingAncestry - ^ true! Item was removed: - ----- Method: MCWorkingAncestry>>name (in category 'testing') ----- - name - ^ self nameForWorkingCopy! Item was removed: - ----- Method: MCWorkingAncestry>>reparent: (in category 'operations') ----- - reparent: aNode - "Let aNode be the sole parent of this version" - ancestors := { aNode } - ! Item was removed: - ----- Method: MCWorkingAncestry>>summary (in category 'accessing') ----- - summary - ^ 'Ancestors: ', self ancestorString! Item was removed: - MCPackageManager subclass: #MCWorkingCopy - instanceVariableNames: 'versionInfo ancestry counter repositoryGroup requiredPackages environment' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Versioning'! Item was removed: - ----- Method: MCWorkingCopy class>>adoptVersionInfoFrom: (in category 'operations') ----- - 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 removed: - ----- Method: MCWorkingCopy class>>ancestorsFromArray:cache: (in category 'operations') ----- - ancestorsFromArray: anArray cache: aDictionary - ^ anArray ifNotNil: [anArray collect: [:dict | self infoFromDictionary: dict cache: aDictionary]]! Item was removed: - ----- Method: MCWorkingCopy class>>checkModified: (in category 'operations') ----- - 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 removed: - ----- Method: MCWorkingCopy class>>cleanUp (in category 'class initialization') ----- - cleanUp - self - " stubAllAncestry ;" - flushObsoletePackageInfos! Item was removed: - ----- Method: MCWorkingCopy class>>flushObsoletePackageInfos (in category 'cleanup') ----- - flushObsoletePackageInfos - PackageOrganizer default flushObsoletePackages: [ : eachPackageInfo | eachPackageInfo class isObsolete ]! Item was removed: - ----- Method: MCWorkingCopy class>>infoFromDictionary:cache: (in category 'operations') ----- - 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 removed: - ----- Method: MCWorkingCopy class>>initialize (in category 'class initialization') ----- - 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 removed: - ----- Method: MCWorkingCopy class>>startUp: (in category 'system startup') ----- - startUp: resuming - "Ensure Monticello is receiving system change notifications." - - resuming ifTrue: - [Smalltalk - at: #SystemChangeNotifier - ifPresent: [:scn| self reregisterForNotificationsWith: scn uniqueInstance]] - ! Item was removed: - ----- Method: MCWorkingCopy class>>stubAllAncestry (in category 'cleanup') ----- - stubAllAncestry - "Replace VersionInfo instances which are more than 10 versions behind with a MCInfoProxy which will dynamically re-retrieve them from the current repository if necessary." - MCWorkingCopy allManagers do: [ : each | each stubAncestry ]! Item was removed: - ----- Method: MCWorkingCopy class>>updateInstVars (in category 'system maintenance') ----- - updateInstVars - self allInstances do: [:ea | ea updateInstVars]! Item was removed: - ----- Method: MCWorkingCopy>>adopt: (in category 'operations') ----- - adopt: aVersion - ancestry addAncestor: aVersion info. - self changed.! Item was removed: - ----- Method: MCWorkingCopy>>ancestors (in category 'accessing') ----- - ancestors - ^ ancestry ancestors! Item was removed: - ----- Method: MCWorkingCopy>>ancestry (in category 'accessing') ----- - ancestry - ^ ancestry! Item was removed: - ----- Method: MCWorkingCopy>>backportChangesTo: (in category 'operations') ----- - backportChangesTo: aVersionInfo - | baseVersion fullPatch currentVersionInfo currentVersion newSnapshot newAncestry | - currentVersionInfo := self currentVersionInfo. - baseVersion := self repositoryGroup versionWithInfo: aVersionInfo. - currentVersion := self repositoryGroup versionWithInfo: currentVersionInfo. - fullPatch := currentVersion snapshot patchRelativeToBase: baseVersion snapshot. - (MCChangeSelectionRequest new - patch: fullPatch; - label: 'Changes to Backport'; - signal ) ifNotNil: - [:partialPatch | - newSnapshot := MCPatcher apply: partialPatch to: baseVersion snapshot. - newAncestry := MCWorkingAncestry new - addAncestor: aVersionInfo; - addStepChild: currentVersionInfo; - yourself. - MCPackageLoader updatePackage: package withSnapshot: newSnapshot. - ancestry := newAncestry. - self modified: false; modified: true]! Item was removed: - ----- Method: MCWorkingCopy>>browse (in category 'ui') ----- - browse - - (MCSnapshotBrowser forSnapshot: self package snapshot) - label: 'Snapshot Browser: ', self packageName; - show.! Item was removed: - ----- Method: MCWorkingCopy>>changesRelativeToRepository: (in category 'operations') ----- - changesRelativeToRepository: aRepository - | ancestorVersion ancestorSnapshot | - ancestorVersion := aRepository withCache - closestAncestorVersionFor: ancestry - ifNone: [ nil ]. - ancestorSnapshot := ancestorVersion - ifNil: [ MCSnapshot empty ] - ifNotNil: [ ancestorVersion snapshot ]. - ^ package snapshot patchRelativeToBase: ancestorSnapshot! Item was removed: - ----- Method: MCWorkingCopy>>checkModified (in category 'operations') ----- - checkModified - self ancestors size = 1 - ifFalse: [ - self modified: true] - ifTrue: [ - | cleanSnapshot currentSnapshot modification | - cleanSnapshot := self findSnapshotWithVersionInfo: self ancestors first. - currentSnapshot := self package snapshot. - modification := currentSnapshot patchRelativeToBase: cleanSnapshot. - self modified: modification isEmpty not]. - ! Item was removed: - ----- Method: MCWorkingCopy>>clearRequiredPackages (in category 'accessing') ----- - clearRequiredPackages - requiredPackages := nil! Item was removed: - ----- Method: MCWorkingCopy>>currentVersionInfo (in category 'accessing') ----- - currentVersionInfo - ^ (self needsSaving or: [ancestry ancestors isEmpty]) - ifTrue: [self newVersion info] - ifFalse: [ancestry ancestors first]! Item was removed: - ----- Method: MCWorkingCopy>>description (in category 'accessing') ----- - description - ^ self packageNameWithStar, ' (', (ancestry ancestorStringWithout: self packageName), ')'! Item was removed: - ----- Method: MCWorkingCopy>>environment (in category 'accessing') ----- - environment - ^ environment ifNil: [Smalltalk globals]! Item was removed: - ----- Method: MCWorkingCopy>>environment: (in category 'accessing') ----- - environment: anEnvironment - "Anything that is loaded to me should go into anEnvironment from now on." - environment := anEnvironment. - package := package inEnvironment: anEnvironment.! Item was removed: - ----- Method: MCWorkingCopy>>findSnapshotWithVersionInfo: (in category 'private') ----- - findSnapshotWithVersionInfo: aVersionInfo - ^ aVersionInfo - ifNil: [MCSnapshot empty] - ifNotNil: [(self repositoryGroup versionWithInfo: aVersionInfo) - ifNil: [MCSnapshot empty] - ifNotNil: [:aVersion | aVersion snapshot]]! Item was removed: - ----- Method: MCWorkingCopy>>initialize (in category 'private') ----- - initialize - super initialize. - ancestry := MCWorkingAncestry new! Item was removed: - ----- Method: MCWorkingCopy>>loaded: (in category 'operations') ----- - loaded: aVersion - ancestry := MCWorkingAncestry new addAncestor: aVersion info. - requiredPackages := OrderedCollection withAll: (aVersion dependencies collect: [:ea | ea package]). - self modified: false. - self changed! Item was removed: - ----- Method: MCWorkingCopy>>merge: (in category 'operations') ----- - merge: targetVersion - | ancestorInfo merger ancestorSnapshot packageSnapshot | - targetVersion dependencies do: [:ea | ea resolve merge]. - ancestorInfo := targetVersion info commonAncestorWith: ancestry. - - ancestorInfo = targetVersion info ifTrue: [^ MCNoChangesException signal]. - - packageSnapshot := package snapshot. - ancestorSnapshot := ancestorInfo - ifNotNil: [(self findSnapshotWithVersionInfo: ancestorInfo)] - ifNil: [self notifyNoCommonAncestorWith: targetVersion. MCSnapshot empty]. - - (ancestry ancestors size = 1 - and: [ancestry ancestors first = ancestorInfo - and: [(packageSnapshot patchRelativeToBase: ancestorSnapshot) isEmpty]]) - ifTrue: [^ targetVersion load]. - - merger := MCThreeWayMerger - base: packageSnapshot - target: targetVersion snapshot - ancestor: ancestorSnapshot. - ((MCMergeResolutionRequest new merger: merger) - signal: 'Merging ', targetVersion info name) = true ifTrue: - [merger loadWithNameLike: targetVersion info name. - ancestry addAncestor: targetVersion info]. - self changed! Item was removed: - ----- Method: MCWorkingCopy>>merged: (in category 'operations') ----- - merged: aVersion - ancestry addAncestor: aVersion info. - self changed. - self checkModified.! Item was removed: - ----- Method: MCWorkingCopy>>needsSaving (in category 'accessing') ----- - needsSaving - ^ self modified or: [self requiredPackages anySatisfy: [:ea | ea workingCopy needsSaving]]! Item was removed: - ----- Method: MCWorkingCopy>>newRepositoryGroupIfDefault (in category 'repositories') ----- - newRepositoryGroupIfDefault - repositoryGroup == MCRepositoryGroup default - ifTrue: [repositoryGroup := MCRepositoryGroup new]. - ^ repositoryGroup! Item was removed: - ----- Method: MCWorkingCopy>>newVersion (in category 'operations') ----- - newVersion - | packageSnapshot parentSnapshot patch patchBlock | - parentSnapshot := self parentSnapshot. - patchBlock := [patch := (packageSnapshot := package snapshot) patchRelativeToBase: parentSnapshot]. - patchBlock value. "Ensure that this is called at least once." - ^ (self requestVersionNameAndMessageWithSuggestion: self uniqueVersionName - initialMessage: self patchMessageSuggestion - patchBlock: patchBlock - ) ifNotNil: [:tuple | - self newVersionWithName: tuple first withBlanksTrimmed - message: (self patchMessageStripped: tuple second) - snapshot: ((tuple size >= 3 and: [tuple third notNil and: [tuple third notEmpty]]) - ifTrue: [ MCPatcher apply: (patch ignoring: tuple third) to: parentSnapshot] - ifFalse: [packageSnapshot])]! Item was removed: - ----- Method: MCWorkingCopy>>newVersionWithName:message: (in category 'operations') ----- - newVersionWithName: nameString message: messageString - ^self newVersionWithName: nameString message: messageString snapshot: package snapshot! Item was removed: - ----- Method: MCWorkingCopy>>newVersionWithName:message:snapshot: (in category 'operations') ----- - newVersionWithName: nameString message: messageString snapshot: aSnapshot - | info deps clean | - info := ancestry infoWithName: nameString message: messageString. - ancestry := MCWorkingAncestry new addAncestor: info. - clean := (package snapshot patchRelativeToBase: aSnapshot) isEmpty. - self modified: clean; modified: clean not. "hack to ensure label is updated" - - deps := self requiredPackages collect: - [:ea | - MCVersionDependency - package: ea - info: ea workingCopy currentVersionInfo]. - - ^ MCVersion - package: package - info: info - snapshot: aSnapshot - dependencies: deps! Item was removed: - ----- Method: MCWorkingCopy>>nextVersionName (in category 'private') ----- - nextVersionName - | branch oldName | - ancestry ancestors isEmpty - ifTrue: - [ counter ifNil: [ counter := 0 ]. - branch := package name ] - ifFalse: - [ oldName := ancestry ancestors first versionName. - branch := oldName packageAndBranchName. - counter ifNil: - [ counter := (ancestry ancestors detectMax: - [ : eachVersionInfo | eachVersionInfo versionNumber ]) - ifNil: [ 0 ] - ifNotNil: - [ : highestNumbered | highestNumbered versionNumber ] ] ]. - counter := counter + 1. - ^ branch , '-' , Utilities authorInitials , '.' , counter asString! Item was removed: - ----- Method: MCWorkingCopy>>notifyNoCommonAncestorWith: (in category 'operations') ----- - notifyNoCommonAncestorWith: aVersion - self notify: - 'Could not find a common ancestor between (', - aVersion info name, - ') and (', - ancestry ancestorString, '). - Proceeding with this merge may cause spurious conflicts.'! Item was removed: - ----- Method: MCWorkingCopy>>parentSnapshot (in category 'private') ----- - parentSnapshot - "prefer parent in selected repository" - MCRepositoryRequest signal ifNotNil: [:repo | - self ancestors do: [:ancestor | - (repo versionWithInfo: ancestor) - ifNotNil: [:ver | ^ver snapshot]]]. - "otherwise, look in all repositories" - self ancestors do: [:ancestor | - (self repositoryGroup versionWithInfo: ancestor) - ifNotNil: [:ver | ^ver snapshot]]. - "otherwise" - ^MCSnapshot empty! Item was removed: - ----- Method: MCWorkingCopy>>patchMessageAncestry (in category 'operations') ----- - patchMessageAncestry - ^ String streamContents: [:strm | - strm nextPutAll: ancestry summary; cr. - self ancestors do: [:ancestor | - strm cr. - strm nextPutAll: ancestor name; nextPut: $:; crtab. - strm nextPutAll: ancestor message; cr.]] - ! Item was removed: - ----- Method: MCWorkingCopy>>patchMessageChanges (in category 'operations') ----- - patchMessageChanges - | changes | - changes := package snapshot patchRelativeToBase: self parentSnapshot. - ^ (MCPatchMessage new patch: changes) message! Item was removed: - ----- Method: MCWorkingCopy>>patchMessageChangesDelimiter (in category 'operations') ----- - patchMessageChangesDelimiter - ^'=== text below is ignored ==='! Item was removed: - ----- Method: MCWorkingCopy>>patchMessageChangesHeader (in category 'operations') ----- - patchMessageChangesHeader - ^ancestry summary, String cr, - 'Added, Modified, Deleted', - (self ancestors ifEmpty: [''] ifNotEmpty: [' vs. ', self ancestors first name]), ':'! Item was removed: - ----- Method: MCWorkingCopy>>patchMessageDefault (in category 'operations') ----- - patchMessageDefault - ^ 'empty log message'! Item was removed: - ----- Method: MCWorkingCopy>>patchMessageStripped: (in category 'operations') ----- - patchMessageStripped: aString - | pos | - pos := aString findString: self patchMessageChangesDelimiter. - ^ (pos > 0 - ifTrue: [aString first: pos - 1] - ifFalse: [aString]) withBlanksTrimmed! Item was removed: - ----- Method: MCWorkingCopy>>patchMessageSuggestion (in category 'operations') ----- - patchMessageSuggestion - ^ String streamContents: [:strm | strm - nextPutAll: self patchMessageDefault; cr;cr; - nextPutAll: self patchMessageChangesDelimiter; cr; - nextPutAll: self patchMessageAncestry; cr; cr; - nextPutAll: self patchMessageChanges]! Item was removed: - ----- Method: MCWorkingCopy>>possiblyNewerVersions (in category 'private') ----- - possiblyNewerVersions - - ^Array streamContents: [:strm | - self repositoryGroup repositories do: [:repo | - strm nextPutAll: (self possiblyNewerVersionsIn: repo)]]! Item was removed: - ----- Method: MCWorkingCopy>>possiblyNewerVersionsIn: (in category 'private') ----- - possiblyNewerVersionsIn: aRepository - ^ aRepository possiblyNewerVersionsOfAnyOf: - ((self ancestors collect: [:each | each versionName]) - ifEmpty: [Array empty] - ifNotEmpty: [:ancestors | {ancestors detectMax: [:v | v versionNumber ]}])! Item was removed: - ----- Method: MCWorkingCopy>>printOn: (in category 'accessing') ----- - printOn: stream - super printOn: stream. - stream - nextPut: $(; - nextPutAll: self packageName; - nextPut: $)! Item was removed: - ----- Method: MCWorkingCopy>>renameToBe: (in category 'operations') ----- - renameToBe: newPackageName - | newWorkingCopy definitions | - self modified ifTrue: [ self error: 'Should only rename an unmodified package.' ]. - (MCWorkingCopy allManagers anySatisfy: - [ : each | each packageName = newPackageName ]) ifTrue: [ self error: newPackageName , ' is already taken.' ]. - definitions := self package snapshot definitions. - PackageInfo registerPackageName: newPackageName. - newWorkingCopy := (MCWorkingCopy forPackage: (MCPackage new name: newPackageName)) - repositoryGroup: self repositoryGroup ; - requiredPackages: self requiredPackages copy ; - modified: true ; - yourself. - definitions do: - [ : each | each - handlePackageRename: self package name - to: newPackageName ]. - self ancestors do: - [ : each | newWorkingCopy ancestry addAncestor: each ]. - newWorkingCopy package snapshot definitions size = definitions size ifTrue: - [ PackageOrganizer default unregisterPackage: (PackageInfo named: self packageName). - self unregister ]. - ^ newWorkingCopy! Item was removed: - ----- Method: MCWorkingCopy>>reparent: (in category 'operations') ----- - reparent: aVersion - "Let aNode be the sole parent of this version" - ancestry reparent: aVersion info. - self - checkModified ; - changed! Item was removed: - ----- Method: MCWorkingCopy>>repositoryGroup (in category 'repositories') ----- - repositoryGroup - ^ repositoryGroup ifNil: [repositoryGroup := MCRepositoryGroup new]! Item was removed: - ----- Method: MCWorkingCopy>>repositoryGroup: (in category 'repositories') ----- - repositoryGroup: aRepositoryGroup - repositoryGroup := aRepositoryGroup! Item was removed: - ----- Method: MCWorkingCopy>>requestVersionNameAndMessageWithSuggestion:initialMessage:patchBlock: (in category 'private') ----- - requestVersionNameAndMessageWithSuggestion: nameString initialMessage: msgString patchBlock: aPatchBlock - ^ (MCVersionNameAndMessageRequest new - suggestedName: nameString; - initialMessage: msgString; - patchBlock: aPatchBlock - ) signal! Item was removed: - ----- Method: MCWorkingCopy>>requirePackage: (in category 'accessing') ----- - requirePackage: aPackage - (self requiredPackages includes: aPackage) ifFalse: [requiredPackages add: aPackage]! Item was removed: - ----- Method: MCWorkingCopy>>requiredPackages (in category 'accessing') ----- - requiredPackages - ^ requiredPackages ifNil: [requiredPackages := OrderedCollection new]! Item was removed: - ----- Method: MCWorkingCopy>>requiredPackages: (in category 'private') ----- - requiredPackages: aCollection - requiredPackages := aCollection! Item was removed: - ----- Method: MCWorkingCopy>>stubAncestry (in category 'operations') ----- - stubAncestry - "Stub all but the most recent 10 of my ancestry tree to save memory with a proxy which can be transparently accessed later, if necessary." - self ancestors ifEmpty: [ ^ self ]. - repositoryGroup ifNotNil: - [ | tenAgo count | - count := 0. - ancestry ancestorsDoWhileTrue: - [ : each | tenAgo := each. - (count := count + 1) < 10 ]. - tenAgo - stubAncestryFor: self - using: repositoryGroup ]! Item was removed: - ----- Method: MCWorkingCopy>>uniqueVersionName (in category 'private') ----- - uniqueVersionName - |versionName| - counter := nil. - [versionName := self nextVersionName. - (MCRepository packageCache includesVersionNamed: versionName) - or: [self repositoryGroup includesVersionNamed: versionName]] whileTrue. - ^ versionName! Item was removed: - ----- Method: MCWorkingCopy>>unload (in category 'operations') ----- - unload - self withEnvironmentActiveDo: [MCPackageLoader unloadPackage: self package]. - self unregisterSubpackages. - self unregister.! Item was removed: - ----- Method: MCWorkingCopy>>updateInstVars (in category 'migration') ----- - updateInstVars - ancestry ifNil: - [ancestry := MCWorkingAncestry new. - versionInfo ifNotNil: - [versionInfo ancestors do: [:ea | ancestry addAncestor: ea]. - versionInfo := nil]]! Item was removed: - ----- Method: MCWorkingCopy>>versionInfo: (in category 'accessing') ----- - versionInfo: aVersionInfo - ancestry := MCWorkingAncestry new addAncestor: aVersionInfo! Item was removed: - ----- Method: MCWorkingCopy>>versionSeparator (in category 'private') ----- - versionSeparator - ^ $_! Item was removed: - ----- Method: MCWorkingCopy>>withEnvironmentActiveDo: (in category 'private') ----- - withEnvironmentActiveDo: aBlock - ^ self environment beCurrentDuring: aBlock! Item was removed: - MCTool subclass: #MCWorkingCopyBrowser - instanceVariableNames: 'workingCopy workingCopyWrapper repository defaults' - classVariableNames: 'CheckForNewerVersionsBeforeSave ExternalMenuEntries' - poolDictionaries: '' - category: 'Monticello-UI'! Item was removed: - ----- Method: MCWorkingCopyBrowser class>>addMenuSpec: (in category 'hooks') ----- - addMenuSpec: aMCMenuSpec - "Register a context menu entry in the monticello browser from an external package. - The MCWorkingCopyBrowser model is passed as argument." - self externalMenuEntries - remove: aMCMenuSpec - ifAbsent: ["Remove any previous entry with description string"]; - add: aMCMenuSpec.! Item was removed: - ----- Method: MCWorkingCopyBrowser class>>checkForNewerVersionsBeforeSave (in category 'preferences') ----- - checkForNewerVersionsBeforeSave - "Preference accessor" - <preference: 'Check for new versions before save' - category: 'Monticello' - description: 'If true, MC will warn before committing to repositories that have possibly newer versions of the package being saved.' - type: #Boolean> - ^CheckForNewerVersionsBeforeSave ifNil:[true]! Item was removed: - ----- Method: MCWorkingCopyBrowser class>>checkForNewerVersionsBeforeSave: (in category 'preferences') ----- - checkForNewerVersionsBeforeSave: aBool - "Sets the CheckForNewerVersionsBeforeSave preference" - CheckForNewerVersionsBeforeSave := aBool! Item was removed: - ----- Method: MCWorkingCopyBrowser class>>externalMenuEntries (in category 'hooks') ----- - externalMenuEntries - - ExternalMenuEntries ifNil: [ExternalMenuEntries := Set new]. - ^ ExternalMenuEntries! Item was removed: - ----- Method: MCWorkingCopyBrowser class>>initialize (in category 'class initialization') ----- - initialize - (TheWorldMenu respondsTo: #registerOpenCommand:) - ifTrue: [TheWorldMenu registerOpenCommand: {'Monticello Browser'. {self. #open}}]! Item was removed: - ----- Method: MCWorkingCopyBrowser class>>new (in category 'instance creation') ----- - new - ^ self basicNew initialize! Item was removed: - ----- Method: MCWorkingCopyBrowser class>>open (in category 'instance creation') ----- - open - self new show! Item was removed: - ----- Method: MCWorkingCopyBrowser>>addPackageRepository (in category 'actions') ----- - addPackageRepository - - workingCopy ifNotNil: - [ - (self pickRepositorySatisfying: [ :repos | (workingCopy repositoryGroup includes: repos) not ]) - ifNotNil: - [:repos | - workingCopy repositoryGroup addRepository: repos. - self repository: repos. - self - changed: #repositoryList; - changed: #repositorySelection. - self changedButtons]]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>addRepository (in category 'actions') ----- - addRepository - self newRepository ifNotNil: - [:repos | self addRepository: repos ]. - ! Item was removed: - ----- Method: MCWorkingCopyBrowser>>addRepository: (in category 'actions') ----- - addRepository: aRepository - self repository: aRepository. - self repositoryGroup addRepository: aRepository. - self changed: #repositoryList; changed: #repositorySelection. - self changedButtons.! Item was removed: - ----- Method: MCWorkingCopyBrowser>>addRepositoryToPackage (in category 'actions') ----- - addRepositoryToPackage - self repository ifNotNil: - [:repos | - (self pickWorkingCopySatisfying: [ :p | (p repositoryGroup includes: repos) not ]) ifNotNil: - [:wc | - workingCopy := wc. - workingCopy repositoryGroup addRepository: repos. - self repository: repos. - self - changed: #workingCopySelection; - changed: #repositoryList; - changed: #repositorySelection. - self changedButtons]]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>addRepositoryToWorkingCopy (in category 'actions') ----- - addRepositoryToWorkingCopy - workingCopy ifNotNil: - [:wc | - workingCopy repositoryGroup addRepository: self repository. - self - changed: #workingCopySelection; - changed: #repositoryList; - changed: #repositorySelection. - self changedButtons]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>addRequiredPackage (in category 'actions') ----- - addRequiredPackage - | chosen | - workingCopy ifNotNil: - [:wc | - chosen := self pickWorkingCopySatisfying: - [:ea | ea ~= wc and: [(wc requiredPackages includes: ea package) not]]. - chosen ifNotNil: - [wc requirePackage: chosen package. - self workingCopyListChanged]]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>addWorkingCopy (in category 'actions') ----- - addWorkingCopy - |name| - name := Project uiManager request: 'Name of package:' translated. - name isEmptyOrNil ifFalse: - [PackageInfo registerPackageName: name. - workingCopy := MCWorkingCopy forPackage: (MCPackage new name: name). - workingCopyWrapper := nil. - self repositorySelection: 0]. - self workingCopyListChanged; changed: #workingCopySelection; changed: #repositoryList. - self changedButtons.! Item was removed: - ----- Method: MCWorkingCopyBrowser>>backportChanges (in category 'actions') ----- - backportChanges - self canBackport ifFalse: [^self]. - workingCopy ifNotNil: - [workingCopy needsSaving ifTrue: [^ self inform: 'You must save the working copy before backporting.' translated]. - self pickAncestorVersionInfo ifNotNil: - [:baseVersionInfo | - workingCopy backportChangesTo: baseVersionInfo]]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>browseWorkingCopy (in category 'actions') ----- - browseWorkingCopy - workingCopy ifNotNil: [:wc | wc browse].! Item was removed: - ----- Method: MCWorkingCopyBrowser>>buttonSpecs (in category 'morphic ui') ----- - buttonSpecs - - ^ #( - ((button: ('+Package' addWorkingCopy 'Add a new package and make it the working copy'))) - ((button: (Browse browseWorkingCopy 'Browse the working copy of the selected package' hasWorkingCopy))) - ((button: (Scripts editLoadScripts 'Edit the load/unload scripts of this package' hasWorkingCopy))) - ((button: (History viewHistory 'View the working copy''s history' hasWorkingCopy))) - ((button: (Changes viewChanges 'View the working copy''s changes relative to the installed version from the repository' canSave))) - ((button: (Backport backportChanges 'Backport the working copy''s changes to an ancestor' canBackport))) - ((button: (Save saveVersion 'Save the working copy as a new version to the selected repository' canSave))) - ((button: ('+Repository' addRepository 'Add an existing repository to the list of those visible'))) - ((button: (Open openRepository 'Open a browser on the selected repository' hasRepository))) - )! Item was removed: - ----- Method: MCWorkingCopyBrowser>>canBackport (in category 'actions') ----- - canBackport - ^ self hasWorkingCopy and: [workingCopy needsSaving not]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>canSave (in category 'morphic ui') ----- - canSave - ^ self hasWorkingCopy and: [self hasRepository]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>changeEnvironment (in category 'actions') ----- - changeEnvironment - workingCopy ifNil: [^ self]. - workingCopy environment: EnvironmentRequest signal! Item was removed: - ----- Method: MCWorkingCopyBrowser>>changedButtons (in category 'morphic ui') ----- - changedButtons - self changed: #hasWorkingCopy. - self changed: #canSave. - self changed: #canBackport. - self changed: #hasRepository. - ! Item was removed: - ----- Method: MCWorkingCopyBrowser>>checkAllPackages (in category 'actions') ----- - checkAllPackages - MCWorkingCopy checkModified: true. - ! Item was removed: - ----- Method: MCWorkingCopyBrowser>>checkForNewerVersions (in category 'actions') ----- - checkForNewerVersions - "Answer true if there are no newer versions preventing us from saving a version." - - | newer | - newer := workingCopy possiblyNewerVersionsIn: self repository. - - newer ifEmpty: [^ true]. - - ^ self confirm: ('CAUTION!! {1}:\\ {2}\\Do you really want to save this version?' translated withCRs format: { - newer size = 1 - ifTrue: ['This version in the repository may be newer' translated] - ifFalse: ['These {1} versions in the repository may be newer' translated format: {newer size}]. - newer asCommaString withNoLineLongerThan: 150})! Item was removed: - ----- Method: MCWorkingCopyBrowser>>clearRequiredPackages (in category 'actions') ----- - clearRequiredPackages - workingCopy ifNotNil: - [:wc | - wc clearRequiredPackages. - self workingCopyListChanged]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>copyImageVersions (in category 'actions') ----- - copyImageVersions - self repository ifNotNil: [ : repos | repos copyImageVersions ]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>defaultExtent (in category 'morphic ui') ----- - defaultExtent - ^ 670 at 300! Item was removed: - ----- Method: MCWorkingCopyBrowser>>defaultLabel (in category 'morphic ui') ----- - defaultLabel - ^ 'Monticello Browser' translated! Item was removed: - ----- Method: MCWorkingCopyBrowser>>defaults (in category 'morphic ui') ----- - defaults - ^ defaults ifNil: [defaults := Dictionary new]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>deleteWorkingCopy (in category 'actions') ----- - deleteWorkingCopy - workingCopy unregister. - self workingCopySelection: 0. - self workingCopyListChanged.! Item was removed: - ----- Method: MCWorkingCopyBrowser>>demoteRepository (in category 'actions') ----- - demoteRepository - self repository ifNotNil: - [ : repo | self repositoryGroup demoteRepository: repo. - self - changed: #repositoryList ; - changed: #repositorySelection ]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>editLoadScripts (in category 'morphic ui') ----- - editLoadScripts - - | arg | - self hasWorkingCopy ifFalse: [^self]. - arg := Project uiManager - chooseOptionFrom: #('edit preamble' 'edit postscript' 'edit preambleOfRemoval' 'edit postscriptOfRemoval') - values: #(#preamble #postscript #preambleOfRemoval #postscriptOfRemoval). - - arg ifNotNil: [ - self editScript: arg].! Item was removed: - ----- Method: MCWorkingCopyBrowser>>editRepository (in category 'actions') ----- - editRepository - | newRepo | - - newRepo := self repository openAndEditTemplateCopy. - newRepo ifNotNil: [ - newRepo class = self repository class - ifTrue: [ - self repository copyFrom: newRepo. - self changed: #repositoryList ] - ifFalse: [self inform: 'Must not change repository type!!' translated]]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>editScript: (in category 'morphic ui') ----- - editScript: scriptSymbol - - | script | - script := workingCopy packageInfo perform: scriptSymbol. - script openLabel: ('{1} of the Package {2}' translated format: {scriptSymbol. workingCopy package name}).! Item was removed: - ----- Method: MCWorkingCopyBrowser>>flushCachedVersions (in category 'actions') ----- - flushCachedVersions - | beforeBytes afterBytes beforeVersions afterVersions | - Cursor wait showWhile: [ - Smalltalk garbageCollect. - beforeBytes := Smalltalk bytesLeft: true. - beforeVersions := MCVersion allSubInstances size. - MCFileBasedRepository flushAllCaches. - afterBytes := Smalltalk bytesLeft: true. - afterVersions := MCVersion allSubInstances size. - ]. - ^self inform: ('{1} versions flushed\{2} bytes reclaimed' translated format: {beforeVersions - afterVersions. beforeBytes - afterBytes})! Item was removed: - ----- Method: MCWorkingCopyBrowser>>flushCachedVersionsAncestry (in category 'actions') ----- - flushCachedVersionsAncestry - | beforeBytes afterBytes beforeVersions afterVersions beforeInfos afterInfos | - Cursor wait showWhile: - [ beforeBytes := Smalltalk garbageCollect. - beforeVersions := MCVersion allSubInstances size. - beforeInfos := MCVersionInfo instanceCount. - MCFileBasedRepository flushAllCaches. - MCWorkingCopy stubAllAncestry. - afterBytes := Smalltalk garbageCollect. - afterVersions := MCVersion allSubInstances size. - afterInfos := MCVersionInfo instanceCount ]. - self inform: - ('{1} versions flushed\{2\ infos flushed\{3} reclaimed' translated - format: {beforeVersions - afterVersions. beforeInfos - afterInfos. (afterBytes - beforeBytes) asBytesDescription}).! Item was removed: - ----- Method: MCWorkingCopyBrowser>>hasRepository (in category 'morphic ui') ----- - hasRepository - ^ self repository notNil! Item was removed: - ----- Method: MCWorkingCopyBrowser>>hasWorkingCopy (in category 'morphic ui') ----- - hasWorkingCopy - ^ workingCopy notNil! Item was removed: - ----- Method: MCWorkingCopyBrowser>>initialize (in category 'morphic ui') ----- - initialize - MCWorkingCopy addDependent: self. - self workingCopies do: [:ea | ea addDependent: self].! Item was removed: - ----- Method: MCWorkingCopyBrowser>>insertExternalMenuEntries: (in category 'morphic ui') ----- - insertExternalMenuEntries: aMenu - - self class externalMenuEntries ifNotEmpty: [ - aMenu addLine. - self class externalMenuEntries do: [:each | - aMenu - add: each entry - target: each target - selector: each selector - argument: self]].! Item was removed: - ----- Method: MCWorkingCopyBrowser>>inspectWorkingCopy (in category 'actions') ----- - inspectWorkingCopy - workingCopy ifNotNil: [workingCopy inspect]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>loadRepositories (in category 'actions') ----- - loadRepositories - FileStream fileIn: 'MCRepositories.st'. - self changed: #repositoryList. - self changedButtons. - ! Item was removed: - ----- Method: MCWorkingCopyBrowser>>newRepository (in category 'actions') ----- - newRepository - | types index | - types := MCRepository allConcreteSubclasses asArray. - index := Project uiManager chooseFrom: (types collect: [:ea | ea description]) - title: 'Repository type:' translated. - ^ index = 0 ifFalse: [(types at: index) morphicConfigure]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>openRepository (in category 'actions') ----- - openRepository - self repository ifNotNil: [:repos | repos morphicOpen: workingCopy ]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>pickAncestorVersionInfo (in category 'morphic ui') ----- - pickAncestorVersionInfo - | ancestors index | - ancestors := workingCopy ancestry breadthFirstAncestors. - index := Project uiManager chooseFrom: (ancestors collect: [:ea | ea name]) - title: 'Ancestor:' translated. - ^ index = 0 ifFalse: [ ancestors at: index]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>pickRepositorySatisfying: (in category 'morphic ui') ----- - pickRepositorySatisfying: aBlock - | repos index | - repos := MCRepositoryGroup default repositories select: aBlock. - index := Project uiManager chooseFrom: (repos collect: [:ea | ea description]) - title: 'Repository:' translated. - ^ index = 0 ifFalse: [repos at: index]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>pickWorkingCopy (in category 'morphic ui') ----- - pickWorkingCopy - ^self pickWorkingCopySatisfying: [ :c | true ]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>pickWorkingCopySatisfying: (in category 'morphic ui') ----- - pickWorkingCopySatisfying: aBlock - | copies index | - copies := self workingCopies select: aBlock. - copies isEmpty ifTrue: [ ^nil ]. - index := Project uiManager chooseFrom: (copies collect: [:ea | ea packageName]) - title: 'Package:' translated. - ^ index = 0 ifFalse: [ copies at: index]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>recompilePackage (in category 'actions') ----- - recompilePackage - (workingCopy withEnvironmentActiveDo: [workingCopy package packageInfo methods]) - do: [:ea | ea actualClass recompile: ea methodSymbol] - displayingProgress: 'Recompiling...' translated.! Item was removed: - ----- Method: MCWorkingCopyBrowser>>removeRepository (in category 'actions') ----- - removeRepository - self repository ifNotNil: - [:repos | - self repositoryGroup removeRepository: repos. - self repositorySelection: (1 min: self repositories size)]. - self changed: #repositoryList. - self changedButtons. - ! Item was removed: - ----- Method: MCWorkingCopyBrowser>>renamePackage (in category 'actions') ----- - renamePackage - | newName | - workingCopy ifNil: - [ self inform: 'Please select a package to be renamed.' translated. - ^ self ]. - workingCopy modified ifTrue: - [ self inform: 'Only unmodified packages should be renamed.' translated. - ^ self ]. - newName := Project uiManager - request: 'New name of package:' translated - initialAnswer: workingCopy packageName. - newName isEmptyOrNil ifFalse: - [ | newWorkingCopy | - newWorkingCopy := workingCopy renameToBe: newName. - workingCopy package snapshot definitions - ifEmpty: - [ "It worked." - workingCopy unregister. - workingCopy := newWorkingCopy. - self repositorySelection: 0. - self - workingCopyListChanged ; - changed: #workingCopySelection ; - changed: #repositoryList. - self changedButtons ] - ifNotEmpty: - [ "It didn't work, browse the remaining definitions." - self browseWorkingCopy ] ]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>repositories (in category 'morphic ui') ----- - repositories - ^ self repositoryGroup repositories! Item was removed: - ----- Method: MCWorkingCopyBrowser>>repository (in category 'actions') ----- - repository - workingCopy ifNotNil: [repository := self defaults at: workingCopy ifAbsent: []]. - ^ repository! Item was removed: - ----- Method: MCWorkingCopyBrowser>>repository: (in category 'actions') ----- - repository: aRepository - repository := aRepository. - workingCopy ifNotNil: [self defaults at: workingCopy put: aRepository]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>repositoryGroup (in category 'morphic ui') ----- - repositoryGroup - ^ workingCopy - ifNil: [MCRepositoryGroup default] - ifNotNil: [workingCopy repositoryGroup]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>repositoryList (in category 'morphic ui') ----- - repositoryList - ^ self repositories collect: [:ea | ea description]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>repositoryListMenu: (in category 'morphic ui') ----- - repositoryListMenu: aMenu - "first add repository-specific commands" - self repository ifNotNil: - [ self - fillMenu: aMenu - fromSpecs: - #(('open repository' #openRepository) - ('edit repository info' #editRepository) - ('add to package...' #addRepositoryToPackage) - ('remove repository' #removeRepository) - ('demote to bottom' #demoteRepository) - ('copy image versions here' #copyImageVersions)). - aMenu - add: - (self repository alwaysStoreDiffs - ifTrue: ['store full versions'] - ifFalse: ['store diffs']) - target: self - selector: #toggleDiffs ; - addLine ]. - "then the non-specific commands" - ^self fillMenu: aMenu fromSpecs: - #( ('load repositories' #loadRepositories) - ('save repositories' #saveRepositories) - ('flush cached versions' #flushCachedVersions))! Item was removed: - ----- Method: MCWorkingCopyBrowser>>repositorySelection (in category 'morphic ui') ----- - repositorySelection - ^ self repositories indexOf: self repository! Item was removed: - ----- Method: MCWorkingCopyBrowser>>repositorySelection: (in category 'morphic ui') ----- - repositorySelection: aNumber - - aNumber = 0 - ifTrue: [self repository: nil] - ifFalse: [aNumber > self repositories size - ifFalse: [self repository: (self repositories at: aNumber)] - ifTrue: [ "List of repositories not up to date. Refresh it." - self repository: nil. - self changed: #repositoryList]]. - self changed: #repositorySelection. - self changedButtons.! Item was removed: - ----- Method: MCWorkingCopyBrowser>>representsSameBrowseeAs: (in category 'morphic ui') ----- - representsSameBrowseeAs: anotherModel - ^ self class = anotherModel class! Item was removed: - ----- Method: MCWorkingCopyBrowser>>revertPackage (in category 'actions') ----- - revertPackage - self pickAncestorVersionInfo ifNotNil: [:info | - (self repositoryGroup versionWithInfo: info - ifNone: [^self inform: ('No repository found for {1}' translated format: {info name})] - ) load]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>saveRepositories (in category 'actions') ----- - saveRepositories - FileStream forceNewFileNamed: 'MCRepositories.st' do: [:f | - MCRepositoryGroup default repositoriesDo: [:r | - r asCreationTemplate ifNotNil: [:template | - f nextPutAll: 'MCRepositoryGroup default addRepository: (', template , ')!!'; cr]]]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>saveVersion (in category 'actions') ----- - saveVersion - | repo version | - self canSave ifFalse: [^self]. - repo := self repository. - - repo cacheAllFileNamesDuring: [ - self class checkForNewerVersionsBeforeSave ==> [self checkForNewerVersions] - ifFalse: [^self]. - - (repo == MCRepository trunk and: [SystemVersion current isFeatureFreeze]) - ifTrue: [self inform: 'FEATURE FREEZE. A new release is being prepared.\Please do only do bugfixes, but no new features.' translated withCRs]. - (repo == MCRepository trunk and: [SystemVersion current isCodeFreeze]) - ifTrue: [self inform: 'CODE FREEZE. The new release is almost ready.\Please do only do URGENT fixes, if any.' translated withCRs]. - - version := self withRepository: repo do: [workingCopy newVersion]]. - version ifNil: [^ self]. - - (MCVersionInspector new version: version) show. - Cursor wait showWhile: [repo storeVersion: version]. - MCCacheRepository default cacheAllFileNamesDuring: - [repo cacheAllFileNamesDuring: - [version allAvailableDependenciesDo: - [:dep | - (repo includesVersionNamed: dep info name) - ifFalse: [repo storeVersion: dep]]]].! Item was removed: - ----- Method: MCWorkingCopyBrowser>>searchHistory (in category 'actions') ----- - searchHistory - workingCopy ifNotNil: - [(UIManager default - edit: (String streamContents: - [:s| - "Ignore the initial MCWorkingAncestry instance." - workingCopy ancestry topologicalAncestors allButFirst - do: [:versionInfo| - s nextPutAll: versionInfo summary] - separatedBy: [s cr; cr"; next: 32 put: $-; cr; cr"]]) - label: ('Version History: {1}' translated format: {workingCopy packageName})) - extent: (0.6 at 1) * Display height * 0.9]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>toggleDiffs (in category 'morphic ui') ----- - toggleDiffs - self repository alwaysStoreDiffs - ifTrue: [self repository doNotAlwaysStoreDiffs] - ifFalse: [self repository doAlwaysStoreDiffs]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>unloadPackage (in category 'actions') ----- - unloadPackage - workingCopy unload. - self workingCopySelection: 0. - self workingCopyListChanged.! Item was removed: - ----- Method: MCWorkingCopyBrowser>>unsortedWorkingCopies (in category 'morphic ui') ----- - unsortedWorkingCopies - ^ MCWorkingCopy allManagers ! Item was removed: - ----- Method: MCWorkingCopyBrowser>>update: (in category 'morphic ui') ----- - update: aSymbol - self unsortedWorkingCopies do: [:ea | ea addDependent: self]. - self workingCopyListChanged.! Item was removed: - ----- Method: MCWorkingCopyBrowser>>viewChanges (in category 'actions') ----- - viewChanges - | patch | - self canSave ifTrue: - [patch := workingCopy changesRelativeToRepository: self repository withCache. - patch isNil ifTrue: [ ^self ]. - patch isEmpty - ifTrue: [ workingCopy modified: false. - self inform: ('No changes between your working copy of the package\\ {1}\\ and the repository at location\\ {2}' translated withCRs asText format: { workingCopy packageName asText allBold. self repository description asText allBold })] - ifFalse: - [ workingCopy modified: true. - (MCPatchBrowser forPatch: patch) - label: ('Patch Browser: {1}' translated format: {workingCopy description}); - environmentInDisplayingImage: workingCopy environment; - show ] ]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>viewHistory (in category 'actions') ----- - viewHistory - workingCopy ifNotNil: - [(MCWorkingHistoryBrowser new - ancestry: workingCopy ancestry; - package: workingCopy package) - label: ('Version History: {1}' translated format: {workingCopy packageName}); - show]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>widgetSpecs (in category 'morphic ui') ----- - widgetSpecs - ^ #( - ((buttonRow) (0 0 1 0) (0 0 0 defaultButtonPaneHeight)) - ((treeOrListMorph: workingCopy) (0 0 0.5 1) (0 defaultButtonPaneHeight 0 0)) - ((listMorph: repository) (0.5 0 1 1) (0 defaultButtonPaneHeight 0 0)) - )! Item was removed: - ----- Method: MCWorkingCopyBrowser>>withRepository:do: (in category 'actions') ----- - withRepository: aRepository do: aBlock - ^aBlock - on: MCRepositoryRequest - do: [:req | req resume: aRepository]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>workingCopies (in category 'morphic ui') ----- - workingCopies - ^ MCWorkingCopy allManagers sort: - [ :a :b | a package name <= b package name ]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>workingCopy: (in category 'morphic ui') ----- - workingCopy: wc - workingCopy := wc. - self - changed: #workingCopySelection; - changed: #repositoryList; - changed: #repositorySelection. - self changedButtons. - ! Item was removed: - ----- Method: MCWorkingCopyBrowser>>workingCopyList (in category 'morphic ui') ----- - workingCopyList - ^ self workingCopies collect: - [:ea | - (workingCopy notNil and: [workingCopy requiredPackages includes: ea package]) - ifTrue: [Text string: ea description emphasis: { TextEmphasis bold }] - ifFalse: [ea description]]! Item was removed: - ----- Method: MCWorkingCopyBrowser>>workingCopyListChanged (in category 'morphic ui') ----- - workingCopyListChanged - self changed: #workingCopyList. - self changed: #workingCopyTree. - self changedButtons. - ! Item was removed: - ----- Method: MCWorkingCopyBrowser>>workingCopyListMenu: (in category 'morphic ui') ----- - workingCopyListMenu: aMenu - workingCopy ifNil: [^ aMenu]. - self fillMenu: aMenu fromSpecs: - #(('add required package' #addRequiredPackage) - ('clear required packages' #clearRequiredPackages) - ('add repository...' #addPackageRepository) - ('browse package' #browseWorkingCopy) - ('view changes' #viewChanges) - ('view history' #viewHistory) - ('search history' #searchHistory) - ('recompile package' #recompilePackage) - ('revert package...' #revertPackage) - ('unload package' #unloadPackage) - ('delete working copy' #deleteWorkingCopy) - ('inspect working copy' #inspectWorkingCopy) - ('rename package...' #renamePackage) - ('change environment...' #changeEnvironment)). - (Smalltalk includesKey: #SARMCPackageDumper) ifTrue: [ - aMenu add: 'make SAR' target: self selector: #fileOutAsSAR - ]. - self fillMenu: aMenu fromSpecs: - #( addLine - ('check all packages for changes' #checkAllPackages)). - self insertExternalMenuEntries: aMenu. - ^aMenu! Item was removed: - ----- Method: MCWorkingCopyBrowser>>workingCopySelection (in category 'morphic ui') ----- - workingCopySelection - ^ self workingCopies indexOf: workingCopy! Item was removed: - ----- Method: MCWorkingCopyBrowser>>workingCopySelection: (in category 'morphic ui') ----- - workingCopySelection: aNumber - self workingCopy: - (aNumber = 0 - ifTrue:[nil] - ifFalse:[self workingCopies at: aNumber]). ! Item was removed: - ----- Method: MCWorkingCopyBrowser>>workingCopySelectionWrapper (in category 'morphic ui') ----- - workingCopySelectionWrapper - ^workingCopyWrapper! Item was removed: - ----- Method: MCWorkingCopyBrowser>>workingCopySelectionWrapper: (in category 'morphic ui') ----- - workingCopySelectionWrapper: aWrapper - workingCopyWrapper := aWrapper. - self changed: #workingCopySelectionWrapper. - self workingCopy: (aWrapper ifNotNil:[aWrapper item])! Item was removed: - ----- Method: MCWorkingCopyBrowser>>workingCopyTree (in category 'morphic ui') ----- - workingCopyTree - ^ self workingCopies collect:[:each| MCDependentsWrapper with: each model: self].! Item was removed: - ----- Method: MCWorkingCopyBrowser>>workingCopyTreeMenu: (in category 'morphic ui') ----- - workingCopyTreeMenu: aMenu - ^self workingCopyListMenu: aMenu - ! Item was removed: - MCVersionHistoryBrowser subclass: #MCWorkingHistoryBrowser - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-UI'! Item was removed: - ----- Method: MCWorkingHistoryBrowser>>baseSnapshot (in category 'accessing') ----- - baseSnapshot - ^ package snapshot! Item was removed: - MCRepository subclass: #MCWriteOnlyRepository - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Repositories'! Item was removed: - ----- Method: MCWriteOnlyRepository>>includesVersionNamed: (in category 'versions') ----- - includesVersionNamed: aString - ^ false! Item was removed: - ----- Method: MCWriteOnlyRepository>>morphicOpen: (in category 'user interface') ----- - morphicOpen: aWorkingCopy - self inform: 'This repository is write-only'! Item was removed: - ----- Method: MCWriteOnlyRepository>>versionNamesForPackageNamed: (in category 'versions') ----- - versionNamesForPackageNamed: aString - "Answer a collection of MCVersionNames whose Package is named aString." - ^{}! Item was removed: - ----- Method: MCWriteOnlyRepository>>versionWithInfo:ifAbsent: (in category 'versions') ----- - versionWithInfo: aVersionInfo ifAbsent: aBlock - ^ aBlock value! Item was removed: - Object subclass: #MCWriter - instanceVariableNames: 'stream' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Storing'! Item was removed: - ----- Method: MCWriter class>>extension (in category 'accessing') ----- - extension - ^ self readerClass extension! Item was removed: - ----- Method: MCWriter class>>on: (in category 'writing') ----- - on: aStream - ^ self new stream: aStream! Item was removed: - ----- Method: MCWriter class>>readerClass (in category 'accessing') ----- - readerClass - ^ self subclassResponsibility ! Item was removed: - ----- Method: MCWriter>>stream (in category 'accessing') ----- - stream - ^ stream! Item was removed: - ----- Method: MCWriter>>stream: (in category 'accessing') ----- - stream: aStream - stream := aStream! Item was removed: - Object subclass: #MethodAddition - instanceVariableNames: 'text category changeStamp requestor logSource myClass methodAndNode selector compiledMethod priorMethodOrNil' - classVariableNames: '' - poolDictionaries: '' - category: 'Monticello-Loading'! - - !MethodAddition commentStamp: 'rej 2/25/2007 19:30' prior: 0! - I represent the addition of a method to a class. I can produce the CompiledMethod, install it, and then notify the system that the method has been added. This allows Monticello to implement atomic addition. A loader can compile all classes and methods first and then install all methods only after they have been all compiled, and in a way that executes little code.½! Item was removed: - ----- Method: MethodAddition>>compile (in category 'compiling') ----- - 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 removed: - ----- Method: MethodAddition>>compile:classified:withStamp:notifying:logSource:inClass: (in category 'initialize-release') ----- - 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 removed: - ----- Method: MethodAddition>>createCompiledMethod (in category 'compiling') ----- - 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 removed: - ----- Method: MethodAddition>>installMethod (in category 'compiling') ----- - installMethod - compiledMethod - ifNil: [Transcript cr; show: 'failed to install ', myClass name, '>>', selector] - ifNotNil: [myClass addSelectorSilently: selector withMethod: compiledMethod]! Item was removed: - ----- Method: MethodAddition>>notifyObservers (in category 'compiling') ----- - notifyObservers - compiledMethod ifNil: [^self]. "this can occur if syntax errors on package load are proceeded through" - 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 removed: - ----- Method: MethodAddition>>writeSourceToLog (in category 'compiling') ----- - writeSourceToLog - (logSource and: [myClass acceptsLoggingOfCompilation]) ifTrue: [ - myClass logMethodSource: text forMethodWithNode: methodAndNode - inCategory: category withStamp: changeStamp notifying: requestor. - ]. - ! Item was removed: - ----- Method: MethodReference>>asMethodDefinition (in category '*monticello') ----- - asMethodDefinition - ^ MCMethodDefinition forMethodReference: self! Item was removed: - ----- Method: MethodReference>>isLocalSelector (in category '*monticello') ----- - isLocalSelector - ^self actualClass - includesLocalSelector: self methodSymbol! Item was removed: - ----- Method: MethodReference>>mcModel (in category '*monticello') ----- - mcModel - "If my package is in a MCMagmaRepository, answer its mcModel." - ^ self asMethodDefinition mcModel! Item was removed: - ----- Method: MethodReference>>mcPatchOperations (in category '*monticello') ----- - mcPatchOperations - "Answer a collection of MCPatchOperations that can be displayed in a MCPatchBrowser which will reflect the history of this objects definition in relation to each other (not simply compared to the image version)." - ^(self mcRevisions reversed - inject: OrderedCollection new - into: - [ : coll : each | coll - ifEmpty: - [ coll - add: (MCAddition of: each) ; - yourself ] - ifNotEmpty: - [ coll - add: - (MCModification - of: - (coll last isAddition - ifTrue: [ coll last definition ] - ifFalse: [ coll last modification ]) - to: each) ; - yourself ] ]) reversed! Item was removed: - ----- Method: MethodReference>>mcRevisions (in category '*monticello') ----- - mcRevisions - "Answer a collection of MCMethodDefinitions for this method, which are in the first Magma-backed repository in the list of repositories of my working-copy." - ^ self mcModel ifNotNil: [ : mcmodel | mcmodel revisionsOf: self asMethodDefinition ]! Item was removed: - ----- Method: MethodReference>>packageInfo (in category '*monticello') ----- - packageInfo - "Answer the PackageInfo containing this method." - | methodCategory classCategory | - methodCategory := self category. - classCategory := methodCategory first = $* ifFalse: [ self actualClass theNonMetaClass category ]. - ^ PackageInfo allPackages - detect: - [ : each | - "detect: [ : each | each methods includes: self ]" "<-- too slow" - (each isYourClassExtension: methodCategory) or: - [ classCategory notNil and: [ each systemCategories includes: classCategory ] ] ] - ifFound: [ : foundPackage | PackageInfo named: foundPackage packageName ] - ifNone: [ nil ]! Item was removed: - ----- Method: MethodReference>>workingCopy (in category '*monticello') ----- - workingCopy - "Answer the MCWorkingCopy in which I am defined." - ^ self packageInfo ifNotNil: [ : pi | pi workingCopy ]! Item was removed: - ----- Method: Object>>isConflict (in category '*monticello') ----- - isConflict - ^false! Item was removed: - ----- Method: Object>>isMCPatchOperation (in category '*Monticello-Patching-testing') ----- - isMCPatchOperation - ^false! Item was removed: - ----- Method: PackageInfo>>mcPackage (in category '*monticello') ----- - mcPackage - ^ MCPackage named: self packageName! Item was removed: - ----- Method: PackageInfo>>workingCopy (in category '*monticello') ----- - workingCopy - ^ self mcPackage workingCopy! Item was removed: - ----- Method: PseudoClass>>asClassDefinition (in category '*monticello') ----- - asClassDefinition - ^ MCClassDefinition - name: self name - superclassName: self superclass name - category: self category - instVarNames: self instVarNames - classVarNames: self classVarNames - poolDictionaryNames: self poolDictionaryNames - classInstVarNames: self classInstVarNames - type: self typeOfClass - comment: self organization classComment asString - commentStamp: self organization commentStamp ! Item was removed: - ----- Method: PseudoClass>>asMCDefinitionBy: (in category '*monticello') ----- - asMCDefinitionBy: aMCReader - ^ aMCReader classDefinitionFrom: self! Item was removed: - ----- Method: PseudoClass>>isMeta (in category '*monticello-override') ----- - isMeta - ^false! Item was removed: - ----- Method: PseudoMetaclass>>isMeta (in category '*monticello-override') ----- - isMeta - ^true! Item was removed: - ----- Method: PseudoTrait>>asMCDefinitionBy: (in category '*monticello') ----- - asMCDefinitionBy: aMCReader - ^ aMCReader traitDefinitionFrom: self! Item was removed: - ----- Method: String>>withLoadedPackageVersions (in category '*monticello') ----- - withLoadedPackageVersions - "Everywhere the receiver contains a package version in the format: PackageName-author.123 for which a version of that package is loaded in the image, answer a new String with each of those package versions changed to reflect the currently loaded version." - | string | - string := self. - MCWorkingCopy allManagers do: - [ : eachWorkingCopy | | start packageName | - start := 1. - packageName := eachWorkingCopy packageName. - [ start := string - findString: packageName - startingAt: start. - start > 0 and: [ string size > (start + packageName size + 4) ] ] whileTrue: - [ | dot end versionName | - dot := string - indexOf: $. - startingAt: (end := start + packageName size). - dot > 0 ifTrue: - [ end := (dot + 1 to: string size) - detect: [ : n | (string at: n) isDigit not ] - ifNone: [ 0 ]. - (end > (dot + 1) and: - [ (dot + 1 to: end - 1) allSatisfy: - [ : n | (string at: n) isDigit ] ]) - ifTrue: - [ versionName := string - copyFrom: start - to: end - 1. - versionName asMCVersionName packageName = packageName ifTrue: - [ string := string - copyReplaceTokens: versionName - with: eachWorkingCopy ancestors first name ] ] - ifFalse: [ end := start + packageName size ] ]. - start := end ] ]. - ^ string! Item was removed: - ----- Method: Time class>>fromString: (in category '*monticello') ----- - fromString: aString - ^ self readFrom: (ReadStream on: aString). - ! Item was removed: - ----- Method: TimeStamp class>>fromMethodTimeStamp: (in category '*monticello-instance creation') ----- - fromMethodTimeStamp: aString - | stream | - stream := ReadStream on: aString. - stream skipSeparators. - stream skipTo: Character space. - ^self readFrom: stream.! Item was removed: - ----- Method: TimeStamp class>>fromString: (in category '*monticello-instance creation') ----- - fromString: aString - "Answer a new instance for the value given by aString. - - TimeStamp fromString: '1-10-2000 11:55:00 am'. - " - - ^self readFrom: (ReadStream on: aString).! Item was removed: - ----- Method: TimeStamp class>>readFrom: (in category '*monticello-instance creation') ----- - readFrom: stream - | date time | - stream skipSeparators. - date := Date readFrom: stream. - stream skipSeparators. - time := Time readFrom: stream. - ^self - date: date - time: time! Item was removed: - (PackageInfo named: 'Monticello') postscript: '(ServiceRegistry current serviceWithId: #browserMethodMenu) services - removeAllSuchThat: [:service | #(browseMcMethodRevisions browseMcMethodOrigin) includes: service id]. - (ServiceRegistry current serviceWithId: #browserClassMenu) services - removeAllSuchThat: [:service | #(browseMcClassRevisions browseMcClassOrigin) includes: service id].'!
More information about the Squeak-dev mailing list |