[squeak-dev] The Trunk: Monticello-topa.599.mcz

Chris Muller asqueaker at gmail.com
Wed Sep 3 19:43:46 UTC 2014


A quick test and it seems to be working properly this time.  Thank you!

The purpose of *reviewing* is, you might need to make a *change*!
(otherwise, why bother reviewing?)  So if I need to make a change, I
need that change to be *saved*!   It hardly seems like something that
logical should need to be called "CM's workflow" but if that's what it
takes for it to behave this way, fine by me.   ;-)

BTW, what did you mean by:

  "Allow for proper comparison of MCPatchOperation?"

Is that just about this same feature -- the fact that the user is able
to select certain PatchOperations to be ignored or did you mean some
other, unrelated fix?

Thanks again!

On Wed, Sep 3, 2014 at 7:37 AM,  <commits at source.squeak.org> wrote:
> Tobias Pape uploaded a new version of Monticello to project The Trunk:
> http://source.squeak.org/trunk/Monticello-topa.599.mcz
>
> ==================== Summary ====================
>
> Name: Monticello-topa.599
> Author: topa
> Time: 3 September 2014, 2:36:05.016 pm
> UUID: 4b7e0536-55d7-4a52-91fe-82bb2d8a6531
> Ancestors: Monticello-bp.598, Monticello-bf.540
>
> * Merge bf.540: Save dialog now shows a list of changes to be submitted. Clicking a list item shows a diff in the lower pane. Advanced users can also make this save ignore individual changes using the item's context menu.
>    * On 'Accept' another snapshot is created to capture changes done while the dialog was open (to not break CM's workflow :).
>  * Allow for proper comparison of MCPatchOperation
>
> =============== Diff against Monticello-bp.598 ===============
>
> Item was added:
> + ----- Method: MCAddition>>= (in category 'as yet unclassified') -----
> + = other
> +       ^ other isAddition and: [definition = other definition]!
>
> Item was added:
> + ----- Method: MCAddition>>hash (in category 'as yet unclassified') -----
> + hash
> +       ^ definition hash!
>
> Item was added:
> + ----- Method: MCModification>>= (in category 'as yet unclassified') -----
> + = other
> +       ^ other isModification
> +       and: [obsoletion = other obsoletion
> +       and: [modification = other modification]]!
>
> Item was added:
> + ----- Method: MCModification>>hash (in category 'as yet unclassified') -----
> + hash
> +       ^ obsoletion hash bitXor: modification hash!
>
> Item was added:
> + ----- Method: MCPatch>>ignoring: (in category 'accessing') -----
> + ignoring: ignoredOperations
> +       ^ MCPatch operations: (operations difference: ignoredOperations)!
>
> Item was added:
> + ----- Method: MCRemoval>>= (in category 'as yet unclassified') -----
> + = other
> +       ^ other isRemoval and: [definition = other definition]!
>
> Item was added:
> + ----- Method: MCRemoval>>hash (in category 'as yet unclassified') -----
> + hash
> +       ^ definition hash!
>
> Item was added:
> + Notification subclass: #MCRepositoryRequest
> +       instanceVariableNames: ''
> +       classVariableNames: ''
> +       poolDictionaries: ''
> +       category: 'Monticello-UI'!
>
> Item was changed:
> + MCPatchBrowser subclass: #MCSaveVersionDialog
> +       instanceVariableNames: 'name message ignore patchBlock'
> - MCTool subclass: #MCSaveVersionDialog
> -       instanceVariableNames: 'name message'
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'Monticello-UI'!
>
> Item was changed:
>   ----- Method: MCSaveVersionDialog>>accept (in category 'as yet unclassified') -----
>   accept
> +       self updateItems.
>         self answer:
>                 (Array
>                         with: (self findTextMorph: #versionName) text asString
> +                       with: (self findTextMorph: #logMessage) text asString
> +                       with: ignore)
> + !
> -                       with: (self findTextMorph: #logMessage) text asString)
> -       !
>
> Item was changed:
>   ----- Method: MCSaveVersionDialog>>defaultExtent (in category 'as yet unclassified') -----
>   defaultExtent
> +       ^ 700 at 600!
> -       ^ 400 at 300!
>
> Item was added:
> + ----- Method: MCSaveVersionDialog>>ignore (in category 'as yet unclassified') -----
> + ignore
> +       ^ ignore ifNil: [ignore := Set new]!
>
> Item was added:
> + ----- Method: MCSaveVersionDialog>>ignoreSelection (in category 'as yet unclassified') -----
> + ignoreSelection
> +       selection
> +               ifNil: [ignore size = items size
> +                       ifFalse: [ignore addAll: items]
> +                       ifTrue: [ignore removeAll]]
> +               ifNotNil: [
> +                       ignore remove: selection ifAbsent: [
> +                               ignore add: selection].
> +                       self selection < items size
> +                               ifTrue: [self selection: self selection + 1]].
> +       self changed: #list
> + !
>
> Item was added:
> + ----- Method: MCSaveVersionDialog>>installSelection (in category 'as yet unclassified') -----
> + installSelection
> +       super installSelection.
> +       selection ifNotNil: [
> +               ignore remove: selection ifAbsent: [].
> +               self changed: #list].
> +
> + !
>
> Item was added:
> + ----- Method: MCSaveVersionDialog>>list (in category 'as yet unclassified') -----
> + list
> +       ^ self items collect: [:ea |
> +               (self ignore includes: ea)
> +                       ifFalse: [ea summary]
> +                       ifTrue: [Text string: '( ', ea summary, ' )' attribute: TextEmphasis struckOut ]]!
>
> Item was added:
> + ----- Method: MCSaveVersionDialog>>message (in category 'accessing') -----
> + message
> +
> +       ^ message!
>
> Item was added:
> + ----- Method: MCSaveVersionDialog>>message: (in category 'accessing') -----
> + message: anObject
> +
> +       message := anObject!
>
> Item was added:
> + ----- Method: MCSaveVersionDialog>>methodListKey:from: (in category 'as yet unclassified') -----
> + methodListKey: aKeystroke from: aListMorph
> +       aKeystroke caseOf: {
> +               [$I] -> [self ignoreSelection].
> +       } otherwise: [super methodListKey: aKeystroke from: aListMorph ]!
>
> Item was added:
> + ----- Method: MCSaveVersionDialog>>methodListMenu: (in category 'as yet unclassified') -----
> + methodListMenu: aMenu
> +       aMenu addList:#(
> +               ('ignore (I)'   ignoreSelection 'Do not include this change when saving')
> +               -).
> +       super methodListMenu: aMenu.
> +       ^aMenu!
>
> Item was added:
> + ----- Method: MCSaveVersionDialog>>name: (in category 'accessing') -----
> + name: anObject
> +
> +       name := anObject!
>
> Item was added:
> + ----- Method: MCSaveVersionDialog>>patchBlock (in category 'accessing') -----
> + patchBlock
> +
> +       ^ patchBlock!
>
> Item was added:
> + ----- Method: MCSaveVersionDialog>>patchBlock: (in category 'accessing') -----
> + patchBlock: anObject
> +
> +       patchBlock := anObject.
> +       self updateItems!
>
> Item was added:
> + ----- Method: MCSaveVersionDialog>>revertSelection (in category 'as yet unclassified') -----
> + revertSelection
> +       super revertSelection.
> +       selection ifNotNil: [
> +               ignore add: selection.
> +               self changed: #list].
> + !
>
> Item was added:
> + ----- Method: MCSaveVersionDialog>>updateItems (in category 'as yet unclassified') -----
> + updateItems
> +       " update our items using the patchBlock "
> +       self patch: patchBlock value!
>
> Item was changed:
>   ----- Method: MCSaveVersionDialog>>widgetSpecs (in category 'as yet unclassified') -----
>   widgetSpecs
>         ^ #(
> +               ((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 0.5 0.6) )
> +               ((textMorph: versionName) (0.5 0 1 0) (0 0 0 30))
> +               ((textMorph: logMessage) (0.5 0 1 0.6) (0 30 0 -30))
> +               ((buttonRow) (0.5 0.6 1 0.6) (0 -30 0 0))
> +               ((textMorph: text) (0 0.6 1 1) (0 0 0 0))
> -               ((textMorph: versionName) (0 0 1 0) (0 0 0 30))
> -               ((textMorph: logMessage) (0 0 1 1) (0 30 0 -30))
> -               ((buttonRow) (0 1 1 1) (0 -40 0 0))
>                 )!
>
> Item was changed:
>   ----- Method: MCTool>>showModally (in category 'morphic ui') -----
>   showModally
>         modalProcess := Processor activeProcess.
> +       self window openInWorldExtent: self defaultExtent.
> -       self window openInWorldExtent: (400 at 400).
>         [self window world notNil] whileTrue: [
>                 self window outermostWorldMorph doOneCycle.
>         ].
>         morph := nil.
>         ^ modalValue!
>
> Item was changed:
>   Notification subclass: #MCVersionNameAndMessageRequest
> +       instanceVariableNames: 'suggestion initialMessage patchBlock'
> -       instanceVariableNames: 'suggestion initialMessage'
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'Monticello-Versioning'!
>
> Item was changed:
>   ----- Method: MCVersionNameAndMessageRequest>>defaultAction (in category 'handling') -----
>   defaultAction
>         ^ MCSaveVersionDialog new
>                 versionName: suggestion;
>                 logMessage: initialMessage;
> +               patchBlock: patchBlock;
>                 showModally!
>
> Item was added:
> + ----- Method: MCVersionNameAndMessageRequest>>patchBlock (in category 'accessing') -----
> + patchBlock
> +       ^ patchBlock!
>
> Item was added:
> + ----- Method: MCVersionNameAndMessageRequest>>patchBlock: (in category 'accessing') -----
> + patchBlock: aBlock
> +       patchBlock := aBlock
> + !
>
> Item was changed:
>   ----- Method: MCWorkingCopy>>newVersion (in category 'operations') -----
>   newVersion
> +       | packageSnapshot parentSnapshot patch |
> +       parentSnapshot := self parentSnapshot.
>         ^ (self requestVersionNameAndMessageWithSuggestion: self uniqueVersionName
> +               initialMessage: self patchMessageSuggestion
> +               patchBlock: [patch := (packageSnapshot := package snapshot) patchRelativeToBase: parentSnapshot]
> +       ) ifNotNil: [:tuple |
> +               self newVersionWithName: tuple first withBlanksTrimmed
> +                       message: (self patchMessageStripped: tuple second)
> +                       snapshot: (tuple third
> +                               ifEmpty: [packageSnapshot]
> +                               ifNotEmpty: [
> +                                       MCPatcher apply: (patch ignoring: tuple third)
> +                                               to: parentSnapshot])]
> -               initialMessage: self patchMessageSuggestion) ifNotNil:
> -                       [:pair |
> -                       self newVersionWithName: pair first withBlanksTrimmed
> -                               message: (self patchMessageStripped: pair last)].
>   !
>
> Item was changed:
>   ----- Method: MCWorkingCopy>>newVersionWithName:message: (in category 'operations') -----
>   newVersionWithName: nameString message: messageString
> +       ^self newVersionWithName: nameString message: messageString snapshot: package snapshot!
> -       | info deps |
> -       info := ancestry infoWithName: nameString message: messageString.
> -       ancestry := MCWorkingAncestry new addAncestor: info.
> -       self modified: true; modified: false.
> -
> -       deps := self requiredPackages collect:
> -               [:ea |
> -               MCVersionDependency
> -                       package: ea
> -                       info: ea workingCopy currentVersionInfo].
> -
> -       ^ MCVersion
> -               package: package
> -               info: info
> -               snapshot: package snapshot
> -               dependencies: deps!
>
> Item was added:
> + ----- 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 added:
> + ----- 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 added:
> + ----- 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 changed:
>   ----- Method: MCWorkingCopy>>patchMessageChanges (in category 'operations') -----
>   patchMessageChanges
> +       | changes |
> +       changes := package snapshot patchRelativeToBase: self parentSnapshot.
> -       | changes parentInfo parentSnapshot |
> -       parentInfo := self ancestors
> -               ifEmpty: [nil]
> -               ifNotEmpty: [self ancestors first].
> -       parentSnapshot :=       self findSnapshotWithVersionInfo: parentInfo.
> -       changes := package snapshot patchRelativeToBase: parentSnapshot.
>         ^ (MCPatchMessage new patch: changes) message!
>
> Item was changed:
>   ----- Method: MCWorkingCopy>>patchMessageSuggestion (in category 'operations') -----
>   patchMessageSuggestion
> +       ^ String streamContents: [:strm | strm
> +               nextPutAll: self patchMessageDefault; cr;cr;
> +               nextPutAll: self patchMessageChangesDelimiter; cr;
> +               nextPutAll: self patchMessageAncestry]!
> -       ^       self patchMessageDefault, String cr, String cr,
> -               self patchMessageChangesDelimiter, String cr,
> -               self patchMessageChangesHeader, String cr,
> -               self patchMessageChanges!
>
> Item was removed:
> - ----- Method: MCWorkingCopy>>requestVersionNameAndMessageWithSuggestion:initialMessage: (in category 'private') -----
> - requestVersionNameAndMessageWithSuggestion: nameString initialMessage: msgString
> -       ^ (MCVersionNameAndMessageRequest new
> -               suggestedName: nameString;
> -               initialMessage: msgString
> -               ) signal!
>
> Item was added:
> + ----- 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 changed:
>   ----- Method: MCWorkingCopyBrowser>>saveVersion (in category 'actions') -----
>   saveVersion
>         | repo |
>         self canSave ifFalse: [^self].
>         self checkForNewerVersions ifFalse: [^self].
>         repo := self repository.
> +       (self withRepository: repo do: [workingCopy newVersion]) ifNotNil:
> -       workingCopy newVersion ifNotNil:
>                 [:v |
>                 (MCVersionInspector new version: v) show.
>                 Cursor wait showWhile: [repo storeVersion: v].
>                 MCCacheRepository default cacheAllFileNamesDuring:
>                         [repo cacheAllFileNamesDuring:
>                                 [v allAvailableDependenciesDo:
>                                         [:dep |
>                                         (repo includesVersionNamed: dep info name)
>                                                 ifFalse: [repo storeVersion: dep]]]]]!
>
> Item was added:
> + ----- Method: MCWorkingCopyBrowser>>withRepository:do: (in category 'actions') -----
> + withRepository: aRepository do: aBlock
> +       ^aBlock
> +               on: MCRepositoryRequest
> +               do: [:req | req resume: aRepository]!
>
>


More information about the Squeak-dev mailing list