[squeak-dev] The Inbox: Monticello-JPhS.554.mczcommits at source.squeak.org commits at source.squeak.orgWed May 22 21:27:05 UTC 2013
A new version of Monticello was added to project The Inbox: http://source.squeak.org/inbox/Monticello-JPhS.554.mcz ==================== Summary ==================== Name: Monticello-JPhS.554 Author: JPhS Time: 22 May 2013, 9:03:01.876 pm UUID: e5e4f26d-123b-49ba-8495-a921baa2a39e Ancestors: Monticello-JPhS.553 ~ There are no longer both versions of the source code displayed in the "remote"-textfield but instead the new code (if JanusState is enabled). =============== Diff against Monticello-bf.541 =============== Item was changed: SystemOrganization addCategory: #'Monticello-Base'! SystemOrganization addCategory: #'Monticello-Chunk Format'! 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'! + SystemOrganization addCategory: #'Monticello-Extension'! Item was added: + Object subclass: #JanusConstants + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Monticello-Extension'! + + !JanusConstants commentStamp: 'mg 5/11/2013 11:16:42.292' prior: 0! + I represent constants used for the Monticello extension Janus.! Item was added: + ----- Method: JanusConstants class>>compareButton (in category 'UI elements') ----- + compareButton + ^ #((Compare changesComparedToSecondVersion 'Compare the changes between the two selected versions' hasReferenceVersion)).! Item was added: + ----- Method: JanusConstants class>>mockClassName (in category 'Tests') ----- + mockClassName + ^ #FirstClass! Item was added: + ----- Method: JanusConstants class>>repositoryInspectorOriginalSize (in category 'UI elements') ----- + repositoryInspectorOriginalSize + ^ (450 at 300)! Item was added: + Object subclass: #JanusDiff + instanceVariableNames: 'difference joinMappings' + classVariableNames: '' + poolDictionaries: '' + category: 'Monticello-Extension'! Item was added: + ----- Method: JanusDiff>>calculateJoinMappings (in category 'as yet unclassified') ----- + calculateJoinMappings + "Calculate the join parameters between src and dst + and store in joinMappings." + + self joinMappings: self calculatedJoinMappings! Item was added: + ----- Method: JanusDiff>>calculatedJoinMappings (in category 'as yet unclassified') ----- + calculatedJoinMappings + "Calculate the join parameters between src and dst + and answer. + sl = src line, dl = dst line, j = joins, ds = dst run start, ss = src run start + de = dst run end, se = dst run end, mds = match dst start, mss = match src start" + + |sl dl j ds ss de se mds mss| + sl := dl := 0. + j := OrderedCollection new. + ds := de:= ss := se := mss := mds := 0. + self difference do: [:p | + p key = #match ifTrue: [ + sl := sl + 1. + dl := dl + 1. + mss = 0 ifTrue: [mss := sl. mds := dl]. + (ds > 0 or: [ss > 0]) ifTrue: [ + ss = 0 ifTrue: [ss := sl]. + ds = 0 ifTrue: [ds := dl]. + se = 0 ifTrue: [se := ss - 1]. + de = 0 ifTrue: [de := ds - 1]. + j add: (self newJoinSectionFrom: (ss to: se) to: (ds to: de)). + ds := de := ss := se := 0]]. + p key = #remove ifTrue: [ + mss > 0 ifTrue: [ + j add: (self newMatchJoinSectionFrom: (mss to: sl) to: (mds to: dl)). + mss := mds := 0]. + sl := sl + 1. + ss = 0 ifTrue: [ss := sl]. + se := sl]. + p key = #insert ifTrue: [ + mss > 0 ifTrue: [ + j add: (self newMatchJoinSectionFrom: (mss to: sl) to: (mds to: dl)). + mss := mds := 0]. + dl := dl + 1. + ss > 0 ifTrue: [ + se = 0 ifTrue: [se := ss]. + de = 0 ifTrue: [de := ds]. + j add: (self newJoinSectionFrom: (ss to: se) to: (ds to: de)). + ds := de := ss := se := 0]. + ds = 0 ifTrue: [ds := dl]. + de := dl]]. + sl := sl + 1. + dl := dl + 1. + (ds > 0 or: [ss > 0]) ifTrue: [ + ss = 0 ifTrue: [ss := sl ]. + ds = 0 ifTrue: [ds := dl]. + se = 0 ifTrue: [se := ss - 1]. + de = 0 ifTrue: [de := ds - 1]. + j add: (self newJoinSectionFrom: (ss to: se) to: (ds to: de))]. + mss > 0 ifTrue: [ + j add: (self newMatchJoinSectionFrom: (mss to: sl - 1) to: (mds to: dl - 1))]. + ^j! Item was added: + ----- Method: JanusDiff>>difference (in category 'as yet unclassified') ----- + difference + "Answer the value of difference" + + ^ difference! Item was added: + ----- Method: JanusDiff>>difference: (in category 'as yet unclassified') ----- + difference: anObject + "Set the value of difference" + + difference := anObject! Item was added: + ----- Method: JanusDiff>>joinMappings (in category 'as yet unclassified') ----- + joinMappings + "Answer the join parameters between src and dst." + + ^joinMappings ifNil: [self calculateJoinMappings]! Item was added: + ----- Method: JanusDiff>>joinMappings: (in category 'as yet unclassified') ----- + joinMappings: aCollection + "Set the join parameters between src and dst." + + joinMappings := aCollection! Item was added: + ----- Method: JanusDiff>>newJoinSection (in category 'as yet unclassified') ----- + newJoinSection + "Answer a new join section." + + ^self joinSectionClass new + srcColor: self modificationColor; + dstColor: self modificationColor; + borderWidth: 1; + borderColor: self edgeColor; + addDependent: self; + yourself! Item was added: + ----- Method: JanusDiff>>newJoinSectionFrom:to: (in category 'as yet unclassified') ----- + newJoinSectionFrom: srcRange to: dstRange + "Answer a new join section." + + |spl dpl sy1 sy2 dy1 dy2 t c| + spl := self srcMorph textMorph paragraph lines. + dpl := self dstMorph textMorph paragraph lines. + t := #modification. + sy1 := srcRange first > spl size + ifTrue: [t := #addition. + spl last bottom truncated - 1] + ifFalse: [(spl at: srcRange first) top truncated - 1]. + sy2 := srcRange size < 1 + ifTrue: [t := #addition. + sy1 + 3] + ifFalse: [srcRange last > spl size + ifTrue: [spl last bottom truncated + 3] + ifFalse: [(spl at: srcRange last) bottom truncated - 1]]. + dy1 := dstRange first > dpl size + ifTrue: [t := #removal. + dpl last bottom truncated - 1] + ifFalse: [(dpl at: dstRange first) top truncated - 1]. + dy2 := dstRange size < 1 + ifTrue: [t := #removal. + dy1 + 3] + ifFalse: [dstRange last > dpl size + ifTrue: [dpl last bottom truncated + 3] + ifFalse: [(dpl at: dstRange last) bottom truncated - 1]]. + c := self colorForType: t. + ^self newJoinSection + type: t; + srcColor: c; + dstColor: c; + srcLineRange: srcRange; + dstLineRange: dstRange; + srcRange: (sy1 to: sy2); + dstRange: (dy1 to: dy2); + createHighlightsFrom: self srcMorph textMorph paragraph + to: self dstMorph textMorph paragraph! Item was added: + Object subclass: #JanusState + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Monticello-Extension'! + JanusState class + instanceVariableNames: 'enabled'! + + !JanusState commentStamp: 'mg 5/11/2013 11:16:15.814' prior: 0! + I represent options of the Monticello extension Janus, which can be altered using the Preferences Browser.! + JanusState class + instanceVariableNames: 'enabled'! Item was added: + ----- Method: JanusState class>>enabled (in category 'accessing') ----- + enabled + <preference: 'Use Janus (instead of Monticello)' + category: 'Monticello' + description: 'Use Janus, an extended version of Monticello.' + type: #Boolean> + ^enabled.! Item was added: + ----- Method: JanusState class>>enabled: (in category 'accessing') ----- + enabled: aBool + enabled := aBool.! Item was added: + ----- Method: JanusState class>>initialize (in category 'class initialization') ----- + initialize + enabled := false.! Item was added: + TestCase subclass: #JanusTestCase + instanceVariableNames: 'janusEnabled' + classVariableNames: '' + poolDictionaries: '' + category: 'Monticello-Extension'! + + !JanusTestCase commentStamp: 'mg 5/11/2013 11:15:14.127' prior: 0! + I represent a test case concerning the Monticello Extension Janus. I enable the extension when I set up and revert it to its original state when I tear down.! Item was added: + ----- Method: JanusTestCase>>janusEnabled (in category 'accessing') ----- + janusEnabled + ^ janusEnabled! Item was added: + ----- Method: JanusTestCase>>janusEnabled: (in category 'accessing') ----- + janusEnabled: anObject + janusEnabled := anObject! Item was added: + ----- Method: JanusTestCase>>setUp (in category 'running') ----- + setUp + janusEnabled := JanusState enabled. + self janusEnabled ifFalse: [JanusState enabled true].! Item was added: + ----- Method: JanusTestCase>>tearDown (in category 'running') ----- + tearDown + JanusState enabled: self janusEnabled.! Item was changed: ----- Method: MCConflict>>source (in category 'as yet unclassified') ----- source + Transcript show: self localChosen. ^ self localChosen ifTrue: [operation fromSource] + ifFalse: [ + JanusState enabled ifTrue: [operation toSource] ifFalse: [operation source]]! - ifFalse: [operation source]! Item was changed: ----- Method: MCMergeBrowser>>innerButtonSpecs (in category 'as yet unclassified') ----- innerButtonSpecs + JanusState enabled ifTrue: [ ^ + #(('Accept change' chooseRemote 'keep the selected change' ) + ('Reject change' chooseLocal 'reject the selected change' )) + + ] ifFalse: [ + ^ #((Keep chooseRemote 'keep the selected change' ) + (Reject chooseLocal 'reject the selected change' ))]! - (Reject chooseLocal 'reject the selected change' ))! Item was added: + ----- Method: MCMergeBrowser>>mergedText (in category 'as yet unclassified') ----- + mergedText + ^ selection ifNil: [''] ifNotNil: [ + self selectionIsConflicted ifTrue: [ + selection operation obsoletion source + ] ifFalse: [ + (selection isKindOf: MCAddition) ifTrue: [ + 'This method will be added.'] ifFalse: [ + selection definition source]]]! Item was added: + ----- Method: MCMergeBrowser>>mergedText: (in category 'as yet unclassified') ----- + mergedText: aTextOrString + self changed: #mergedText! Item was added: + ----- Method: MCMergeBrowser>>oldText (in category 'as yet unclassified') ----- + oldText + | modification | + modification := selection. + modification ifNil: [^ ''] ifNotNil: [ + self selectionIsConflicted ifTrue: [modification := modification operation.]. + (modification isKindOf: MCAddition) ifTrue: [ + ^ 'No implementation in the working copy.']. + (modification isKindOf: MCRemoval) ifTrue: [ + ^ selection definition source]. + (modification isKindOf: MCModification) ifTrue: [ + ^ selection obsoletion source]].! Item was added: + ----- Method: MCMergeBrowser>>oldText: (in category 'as yet unclassified') ----- + oldText: aTextOrString + self changed: #oldText! Item was added: + ----- Method: MCMergeBrowser>>selection: (in category 'as yet unclassified') ----- + selection: aNumber + selection := aNumber = 0 ifFalse: [self items at: aNumber]. + self changed: #selection; changed: #text; changed: #annotations; changed: #oldText"; changed: #mergedText"! Item was added: + ----- Method: MCMergeBrowser>>text (in category 'as yet unclassified') ----- + text + ^ selection ifNil: [''] ifNotNil: [ selection source ]! Item was changed: ----- Method: MCMergeBrowser>>widgetSpecs (in category 'as yet unclassified') ----- widgetSpecs + JanusState enabled ifTrue: [ ^ { + #((buttonRow) (0 0 1 0) (0 0 0 30)). + #((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 30 0 0)). + #((innerButtonRow) (0 0.4 1 0.4) (0 0 0 30)). + {#(textMorph: annotations). #(0 0.4 1 0.4). { 0. 30. 0. 30+self defaultAnnotationPaneHeight. }}. + {#(textMorph: oldText). #(0 0.4 0.5 0.75). { 0. 30+self defaultAnnotationPaneHeight. 0. 0.}}. + {#(textMorph: text). #(0.5 0.4 1 0.75). { 0. 30+self defaultAnnotationPaneHeight. 0. 0.}.}. + {#(textMorph: mergedText). #(0 0.75 1 1). { 0. 0. 0. 0.}.}. + }]. + Preferences annotationPanes ifFalse: [ ^#( ((buttonRow) (0 0 1 0) (0 0 0 30)) ((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 30 0 0)) ((innerButtonRow) (0 0.4 1 0.4) (0 0 0 30)) ((textMorph: text) (0 0.4 1 1) (0 30 0 0)) )]. ^ { #((buttonRow) (0 0 1 0) (0 0 0 30)). #((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 30 0 0)). #((innerButtonRow) (0 0.4 1 0.4) (0 0 0 30)). { #(textMorph: annotations). #(0 0.4 1 0.4). { 0. 30. 0. 30+self defaultAnnotationPaneHeight. }}. { #(textMorph: text). #(0 0.4 1 1). { 0. 30+self defaultAnnotationPaneHeight. 0. 0.}} }! Item was changed: ----- Method: MCPatchBrowser>>text (in category 'text') ----- text ^ selection ifNil: [''] ifNotNil: [selection source]! Item was changed: MCVersionInspector subclass: #MCRepositoryInspector + instanceVariableNames: 'repository packageNames versionNames selectedPackage selectedVersion order versionInfo loaded newer inherited selectedReferenceVersion' - instanceVariableNames: 'repository packageNames versionNames selectedPackage selectedVersion order versionInfo loaded newer inherited' classVariableNames: 'BrowseBranchedVersionsSeparately Order' poolDictionaries: '' category: 'Monticello-UI'! Item was added: + ----- Method: MCRepositoryInspector>>buttonSpecs (in category 'morphic ui') ----- + buttonSpecs + |buttons| + buttons := #(('Refresh' refresh 'refresh the version-list') + (Browse browse 'Browse this version' hasVersion) + (History history 'Browse the history of this version' hasVersion) + (Changes changes 'Browse the changes this version would make to the image' hasVersion) + (Load load 'Load this version into the image' hasVersion) + (Merge merge 'Merge this version into the image' hasVersion) + (Adopt adopt 'Adopt this version as an ancestor of your working copy' hasVersion) + (Copy save 'Copy this version to another repository' hasVersion) + (Diff diff 'Create an equivalent version based on an earlier release' hasVersion)). + JanusState enabled ifTrue: [buttons := buttons, JanusConstants compareButton]. + ^buttons! Item was added: + ----- Method: MCRepositoryInspector>>changesComparedTo: (in category 'XTENDED') ----- + changesComparedTo: aVersion + (MCPatchBrowser forPatch: (self version changesComparedTo: aVersion)) + showLabelled: 'Changes from ', aVersion info name ,' compared to ', self version info name! Item was added: + ----- Method: MCRepositoryInspector>>changesComparedToSecondVersion (in category 'XTENDED') ----- + changesComparedToSecondVersion + self changesComparedTo: (self repository versionNamed: selectedReferenceVersion).! Item was changed: ----- Method: MCRepositoryInspector>>defaultExtent (in category 'morphic ui') ----- defaultExtent + JanusState enabled ifTrue: [^(600 at 450)]. ^450 at 300! Item was added: + ----- Method: MCRepositoryInspector>>hasReferenceVersion (in category 'morphic ui') ----- + hasReferenceVersion + ^ selectedReferenceVersion notNil & selectedVersion notNil! Item was added: + ----- Method: MCRepositoryInspector>>referenceVersionList (in category 'morphic ui') ----- + referenceVersionList + ^ self versionList! Item was added: + ----- Method: MCRepositoryInspector>>referenceVersionListMenu: (in category 'morphic ui') ----- + referenceVersionListMenu: aMenu + ^ self versionListMenu: aMenu! Item was added: + ----- Method: MCRepositoryInspector>>referenceVersionSelection (in category 'morphic ui') ----- + referenceVersionSelection + ^self referenceVersionList indexOf: selectedReferenceVersion! Item was added: + ----- Method: MCRepositoryInspector>>referenceVersionSelection: (in category 'morphic ui') ----- + referenceVersionSelection: aNumber + selectedReferenceVersion := version := nil. + aNumber isZero ifFalse: [ selectedReferenceVersion := (self referenceVersionList at: aNumber) asString ]. + self changed: #referenceVersionSelection.! Item was changed: ----- Method: MCRepositoryInspector>>versionSelection: (in category 'morphic ui') ----- versionSelection: aNumber selectedVersion := version := nil. aNumber isZero ifFalse: [ selectedVersion := (self versionList at: aNumber) asString ]. self changed: #versionSelection ; changed: #summary ; + changed: #hasVersion.! - changed: #hasVersion! Item was changed: ----- Method: MCRepositoryInspector>>widgetSpecs (in category 'morphic ui') ----- widgetSpecs + | widgets | + widgets := #( + ((buttonRow) (0 0 1 0) (0 0 0 30)) + ((textMorph: summary) (0 0.6 1 1) (0 0 0 0)) ). + JanusState enabled ifTrue: [ + widgets := widgets, #( + ((listMorph: package) (0 0 0.4 0.6) (0 30 0 0)) + ((listMorph: referenceVersion) (0.7 0 1 0.6) (0 30 0 0)) + ((listMorph: version) (0.4 0 0.7 0.6) (0 30 0 0)))] + ifFalse: [ + widgets := widgets, #( + ((listMorph: version) (0.5 0 1 0.6) (0 30 0 0)) + ((listMorph: package) (0 0 0.5 0.6) (0 30 0 0)))]. + ^widgets! - ^#( ((buttonRow) (0 0 1 0) (0 0 0 30)) - ((listMorph: package) (0 0 0.5 0.6) (0 30 0 0)) - ((listMorph: version) (0.5 0 1 0.6) (0 30 0 0)) - ((textMorph: summary) (0 0.6 1 1) (0 0 0 0)) )! Item was added: + ----- Method: MCVersion>>changesComparedTo: (in category 'XTENDED') ----- + changesComparedTo: aVersion + ^ self snapshot patchRelativeToBase: aVersion snapshot.! Item was changed: ----- Method: MCVersionInspector>>buttonSpecs (in category 'morphic ui') ----- buttonSpecs ^ #(('Refresh' refresh 'refresh the version-list') (Browse browse 'Browse this version' hasVersion) (History history 'Browse the history of this version' hasVersion) (Changes changes 'Browse the changes this version would make to the image' hasVersion) (Load load 'Load this version into the image' hasVersion) (Merge merge 'Merge this version into the image' hasVersion) (Adopt adopt 'Adopt this version as an ancestor of your working copy' hasVersion) (Copy save 'Copy this version to another repository' hasVersion) (Diff diff 'Create an equivalent version based on an earlier release' hasVersion))! Item was changed: ----- Method: MCVersionInspector>>versionSummary (in category 'accessing') ----- versionSummary ^ self version summary! Item was added: + JanusTestCase subclass: #TestJanusRepositoryInspector + instanceVariableNames: 'inspector version1 version2' + classVariableNames: '' + poolDictionaries: '' + category: 'Monticello-Extension'! + + !TestJanusRepositoryInspector commentStamp: 'mg 5/18/2013 14:20:05.792' prior: 0! + I am a test for the extended functionality of the Repository Inspector.! Item was added: + ----- Method: TestJanusRepositoryInspector>>createDummyClass (in category 'tests') ----- + createDummyClass + Object subclass: JanusConstants mockClassName + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: self class category.! Item was added: + ----- Method: TestJanusRepositoryInspector>>createDummyVersionNamed: (in category 'tests') ----- + createDummyVersionNamed: identifier + | versionInfo | + versionInfo := MCVersionInfo name: 'janusTest', identifier asString + id: identifier message: '' date: 0 time: 0 author: '' ancestors: #(). + ^ MCVersion package: (MCPackage named: self class category) info: versionInfo.! Item was added: + ----- Method: TestJanusRepositoryInspector>>createDummyVersionsBeforeAndAfterAnAddition (in category 'tests') ----- + createDummyVersionsBeforeAndAfterAnAddition + version1 := self createDummyVersionNamed: 1. + self createDummyClass. + version2 := self createDummyVersionNamed: 2. + self deleteDummyClass.! Item was added: + ----- Method: TestJanusRepositoryInspector>>createRepositoryInspectorDummy (in category 'tests') ----- + createRepositoryInspectorDummy + | inspector repository workingCopy | + + repository := MCRepository location: FileDirectory default pathName. + workingCopy := MCWorkingCopy forPackage: MCTestCase new mockPackage. + + inspector := MCRepositoryInspector repository: repository workingCopy: workingCopy. + inspector window. "This creates a window which belongs to the inspector and can be evaluated." + + ^ inspector! Item was added: + ----- Method: TestJanusRepositoryInspector>>defaultTimeout (in category 'tests') ----- + defaultTimeout + ^50! Item was added: + ----- Method: TestJanusRepositoryInspector>>deleteDummyClass (in category 'tests') ----- + deleteDummyClass + Smalltalk allClassesDo: [:each | each name = JanusConstants mockClassName ifTrue: [each removeFromSystem]].! Item was added: + ----- Method: TestJanusRepositoryInspector>>inspector (in category 'accessing') ----- + inspector + ^ inspector! Item was added: + ----- Method: TestJanusRepositoryInspector>>inspector: (in category 'accessing') ----- + inspector: anObject + inspector := anObject! Item was added: + ----- Method: TestJanusRepositoryInspector>>setUp (in category 'tests') ----- + setUp + super setUp. + inspector := self createRepositoryInspectorDummy.! Item was added: + ----- Method: TestJanusRepositoryInspector>>tearDown (in category 'tests') ----- + tearDown + super tearDown.! Item was added: + ----- Method: TestJanusRepositoryInspector>>testChangesBetweenTwoArbitraryVersions (in category 'tests') ----- + testChangesBetweenTwoArbitraryVersions + self createDummyVersionsBeforeAndAfterAnAddition. + self assert: ((self version2 changesComparedTo: self version1) operations first class == MCAddition).! Item was added: + ----- Method: TestJanusRepositoryInspector>>testUIChangeIfJanusIsEnabled (in category 'tests') ----- + testUIChangeIfJanusIsEnabled + self assert: (self inspector buttonSpecs includes: JanusConstants compareButton first).! Item was added: + ----- Method: TestJanusRepositoryInspector>>testVersionListsContainSameVersions (in category 'tests') ----- + testVersionListsContainSameVersions + | list1 list2 | + + list1 := (self inspector dependents at: 14) getList. + list2 := (self inspector dependents at: 15) getList. + + self assert: list1 equals: list2.! Item was added: + ----- Method: TestJanusRepositoryInspector>>testWindowSize (in category 'tests') ----- + testWindowSize + self assert: (self inspector window extent > JanusConstants repositoryInspectorOriginalSize).! Item was added: + ----- Method: TestJanusRepositoryInspector>>version1 (in category 'accessing') ----- + version1 + ^ version1! Item was added: + ----- Method: TestJanusRepositoryInspector>>version1: (in category 'accessing') ----- + version1: anObject + version1 := anObject! Item was added: + ----- Method: TestJanusRepositoryInspector>>version2 (in category 'accessing') ----- + version2 + ^ version2! Item was added: + ----- Method: TestJanusRepositoryInspector>>version2: (in category 'accessing') ----- + version2: anObject + version2 := anObject!
More information about the Squeak-dev mailing list |