[squeak-dev] The Trunk: Monticello-cmm.575.mczcommits at source.squeak.org commits at source.squeak.orgFri Nov 8 15:26:02 UTC 2013
Chris Muller uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-cmm.575.mcz ==================== Summary ==================== Name: Monticello-cmm.575 Author: cmm Time: 3 October 2013, 9:42:40.555 pm UUID: daeb51c6-0b6f-41db-883d-e9764e61d8c5 Ancestors: Monticello-cmm.573 - Integrate Berts suggestions. Refactored and renamed the API for the new history and origin browsing functions to avoid ambiguity with other MC domain elements. Went from "version" nomenclature to "history". - Related to those functions, browsing a list of patch operations is now abstracted from browsing a Patch. MCPatch is now a MCOperationsList and, likewise, a MCPatchBrowser inherits from a MCOperationsBrowser. - Added well-known repository accessors for #trunk and #packageCache, and #trunkUrlString avoids scattering the hard-coded url string literal in so many places. =============== Diff against Monticello-cmm.573 =============== Item was added: + ----- Method: BrowserRequestor>>browseMcClassHistory (in category '*monticello-history') ----- + browseMcClassHistory + "Open a browser on all versions of this class available in the MC repository for this package." + self getClass + ifNil: [ UIManager inform: 'No class selected' ] + ifNotNilDo: + [ : theClass | theClass mcModel + ifNil: [ UIManager inform: 'No Magma-based repository for ' , theClass packageInfo packageName ] + ifNotNilDo: + [ : mcModel | (MCOperationsList operations: theClass mcPatchOperations) browse ] ]! Item was added: + ----- Method: BrowserRequestor>>browseMcClassOrigin (in category '*monticello-history') ----- + browseMcClassOrigin + "Open a Monticello version browser on the earliest version available in the repository known to contain this version." + self getClass + ifNil: [ UIManager inform: 'No method selected' ] + ifNotNilDo: + [ : selectedClass | selectedClass mcModel + ifNil: [ UIManager inform: 'No Magma-based repository for ' , selectedClass packageInfo packageName ] + ifNotNilDo: + [ : mcModel | (mcModel originOf: selectedClass asClassDefinition) + ifNil: [ UIManager inform: selectedClass asString , ' was not found in any Magma-based MC repository.' ] + ifNotNilDo: + [ : version | version open ] ] ]! Item was added: + ----- Method: BrowserRequestor>>browseMcMethodHistory (in category '*monticello-history') ----- + browseMcMethodHistory + "Open a browser on all versions of this method available in the MC repository for this package." + self selectedMethodReference + ifNil: [ UIManager inform: 'No method selected' ] + ifNotNilDo: + [ : methodReference | methodReference mcModel + ifNil: [ UIManager inform: 'No Magma-based repository for ' , methodReference packageInfo packageName ] + ifNotNilDo: + [ : mcModel | (MCOperationsList operations: methodReference mcPatchOperations) browse ] ]! Item was added: + ----- Method: BrowserRequestor>>browseMcMethodOrigin (in category '*monticello-history') ----- + browseMcMethodOrigin + "Open a Monticello version browser on the earliest version available in the repository known to contain this version." + self selectedMethodReference + ifNil: [ UIManager inform: 'No method selected' ] + ifNotNilDo: + [ : methodReference | methodReference mcModel + ifNil: [ UIManager inform: 'No Magma-based repository for ' , methodReference packageInfo packageName ] + ifNotNilDo: + [ : mcModel | (mcModel originOf: methodReference asMethodDefinition) + ifNil: [ UIManager inform: methodReference asString , ' was not found in any Magma-based MC repository.' ] + ifNotNilDo: + [ : version | version open ] ] ]! Item was added: + ----- Method: BrowserRequestor>>canBrowseMcClassHistory (in category '*monticello-history') ----- + canBrowseMcClassHistory + ^ self getClass + ifNil: [ false ] + ifNotNilDo: + [ : class | class mcModel notNil ]! Item was added: + ----- Method: BrowserRequestor>>canBrowseMcMethodHistory (in category '*monticello-history') ----- + canBrowseMcMethodHistory + ^ self selectedMethodReference + ifNil: [ false ] + ifNotNilDo: + [ : methodReference | methodReference mcModel notNil ]! Item was added: + ----- Method: BrowserRequestor>>selectedMethodReference (in category '*monticello-history') ----- + selectedMethodReference + ^ MethodReference + class: self getClass + selector: self getSelector! Item was added: + ----- Method: Class>>mcHistory (in category '*monticello') ----- + mcHistory + "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 historyOf: self asClassDefinition ]! Item was added: + ----- Method: Class>>mcModel (in category '*monticello') ----- + mcModel + ^ self asClassDefinition mcModel! Item was added: + ----- Method: Class>>mcOrigin (in category '*monticello') ----- + mcOrigin + "Answer the MCVersion in which this definition of this class was originally committed." + ^ self mcModel ifNotNil: [ : mcmodel | mcmodel originOf: self ]! Item was added: + ----- 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 mcHistory 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 added: + ----- Method: Class>>packageInfo (in category '*monticello') ----- + packageInfo + ^ PackageInfo allPackages + detect: [ : each | each includesClass: self ] + ifNone: [ nil ]! Item was removed: - ----- Method: MCCacheRepository class>>reduceTo: (in category 'utilities') ----- - reduceTo: numberOfBytesToKeepOnDisk - | newestToOldest | - newestToOldest := self default directory entries sort: - [ : a : b | a modificationDateAndTime > b modificationDateAndTime ]. - newestToOldest - inject: 0 - into: - [ : sum : each | each isDirectory ifFalse: - [ sum > numberOfBytesToKeepOnDisk ifTrue: [ each delete ]. - sum + each fileSize ] ]! Item was removed: - ----- Method: MCCacheRepository>>packageForFileNamed: (in category 'as yet unclassified') ----- - packageForFileNamed: aString - ^ self packageCache at: aString ifAbsentPut: [self versionReaderForFileNamed: aString do: [:r | r package]]! Item was changed: ----- Method: MCChangeSelectionRequest>>defaultAction (in category 'as yet unclassified') ----- defaultAction + ^ (MCChangeSelector forPatch: patch) + label: label ; + showModally! - ^ (MCChangeSelector new patch: patch; label: label) showModally! Item was added: + ----- Method: MCCodeTool>>items (in category 'accessing') ----- + items + ^ items! Item was added: + ----- Method: MCCodeTool>>setItems: (in category 'initialize-release') ----- + setItems: aCollection + items := aCollection! Item was added: + ----- Method: MCDefinition>>findMcModel (in category 'private') ----- + findMcModel + "Find my WorkingCopy, use the first mcModel-capable repository in its reposigoryGroup." + self repositoryGroup repositoriesDo: + [ : each | each mcModel ifNotNilDo: + [ : mcModel | ^ mcModel ] ]. + ^ nil! Item was added: + ----- Method: MCDefinition>>mcModel (in category 'private') ----- + mcModel + ^ self findMcModel ifNil: [ super mcModel ]! Item was added: + ----- Method: MCDefinition>>origin (in category 'private') ----- + origin + "Answer the MCVersion in which the receiver was originally committed." + ^ self mcModel ifNotNil: [ : model | model originOf: self ]! Item was added: + ----- Method: MCDefinition>>sortHistory: (in category 'private') ----- + sortHistory: anOrderedCollection + ^ anOrderedCollection sort: [ : a : b | a dateAndTime > b dateAndTime ]! Item was changed: ----- 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 ]! - ^ aBlock ensure: [ self flushAllFilenames ]! Item was changed: ----- Method: MCFileBasedRepository>>cacheAllFilenames (in category 'private') ----- cacheAllFilenames + allFileNamesCache := self allFileNames. + allVersionNamesCache := self allVersionNames! - allFileNamesCache ifNil: - [ allFileNamesCache := self allFileNames. - allVersionNamesCache := self allVersionNames ]! Item was added: + ----- Method: MCHttpRepository class>>initialize (in category 'class initialization') ----- + initialize + self unload. + (ServiceRegistry current serviceWithId: #browserMethodMenu) services + add: self browseMcMethodHistoryService ; + add: self browseMcMethodOriginService. + (ServiceRegistry current serviceWithId: #browserClassMenu) services + add: self browseMcClassHistoryService ; + add: self browseMcClassOriginService! Item was added: + ----- 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 added: + ----- Method: MCHttpRepository class>>trunkUrlString (in category 'accessing') ----- + trunkUrlString + ^ 'http://source.squeak.org/trunk'! Item was changed: + ----- Method: MCHttpRepository>>allFileNames (in category 'overriding') ----- - ----- Method: MCHttpRepository>>allFileNames (in category 'required') ----- allFileNames | index | self displayProgress: 'Updating ', self description during:[ index := HTTPSocket httpGet: self locationWithTrailingSlash, '?C=M;O=D' args: nil user: self user passwd: self password. ]. index isString ifTrue: [NetworkError signal: 'Could not access ', location]. ^ self parseFileNamesFromStream: index ! Item was changed: + ----- Method: MCHttpRepository>>asCreationTemplate (in category 'overriding') ----- - ----- Method: MCHttpRepository>>asCreationTemplate (in category 'as yet unclassified') ----- asCreationTemplate ^self class creationTemplateLocation: location user: user password: password! Item was changed: + ----- Method: MCHttpRepository>>description (in category 'overriding') ----- - ----- Method: MCHttpRepository>>description (in category 'required') ----- description ^ location! Item was changed: + ----- Method: MCHttpRepository>>displayProgress:during: (in category 'private') ----- - ----- Method: MCHttpRepository>>displayProgress:during: (in category 'required') ----- 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 changed: + ----- Method: MCHttpRepository>>flushCache (in category 'overriding') ----- - ----- Method: MCHttpRepository>>flushCache (in category 'required') ----- flushCache super flushCache. readerCache := nil.! Item was added: + ----- Method: MCHttpRepository>>historyOf: (in category 'accessing') ----- + historyOf: aMCDefinition + ^ (ReferenceStream on: + (self + httpGet: 'history' + for: aMCDefinition)) next! Item was added: + ----- 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 added: + ----- Method: MCHttpRepository>>isTrunk (in category 'testing') ----- + isTrunk + ^ location = self class trunkUrlString! Item was changed: + ----- Method: MCHttpRepository>>location: (in category 'accessing') ----- - ----- Method: MCHttpRepository>>location: (in category 'as yet unclassified') ----- location: aUrlString location := aUrlString! Item was changed: + ----- Method: MCHttpRepository>>locationWithTrailingSlash (in category 'accessing') ----- - ----- Method: MCHttpRepository>>locationWithTrailingSlash (in category 'as yet unclassified') ----- locationWithTrailingSlash ^ (location endsWith: '/') ifTrue: [location] ifFalse: [location, '/']! Item was added: + ----- Method: MCHttpRepository>>mcModel (in category 'overriding') ----- + mcModel + "Answer the object which can respond to #historyOf: and #originOf:." + ^ (location = 'http://localhost:8888/trunk' or: [ location = 'http://box4.squeak.org:8888/trunk' ]) ifTrue: [ self ]! Item was added: + ----- Method: MCHttpRepository>>originOf: (in category 'accessing') ----- + originOf: aMCDefinition + ^ (ReferenceStream on: + (self + httpGet: 'origin' + for: aMCDefinition)) next! Item was changed: + ----- Method: MCHttpRepository>>parseFileNamesFromStream: (in category 'private') ----- - ----- Method: MCHttpRepository>>parseFileNamesFromStream: (in category 'as yet unclassified') ----- 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 changed: + ----- Method: MCHttpRepository>>password (in category 'accessing') ----- - ----- Method: MCHttpRepository>>password (in category 'as yet unclassified') ----- password self userAndPasswordFromSettingsDo: [:usr :pwd | ^pwd]. self user isEmpty ifTrue: [^password ifNil: ['']]. [password isEmptyOrNil] whileTrue: [ | 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 changed: + ----- Method: MCHttpRepository>>password: (in category 'accessing') ----- - ----- Method: MCHttpRepository>>password: (in category 'as yet unclassified') ----- password: passwordString password := passwordString! Item was changed: + ----- Method: MCHttpRepository>>readStreamForFileNamed:do: (in category 'private') ----- - ----- Method: MCHttpRepository>>readStreamForFileNamed:do: (in category 'required') ----- readStreamForFileNamed: aString do: aBlock | contents | self displayProgress: 'Downloading ', aString during:[ contents := HTTPSocket httpGet: (self urlForFileNamed: aString) args: nil user: self user passwd: self password. ]. ^ contents isString ifFalse: [aBlock value: contents]! Item was added: + ----- Method: MCHttpRepository>>serializeForRequest: (in category 'private') ----- + serializeForRequest: aMCDefinition + ^ ((ReferenceStream on: (RWBinaryOrTextStream on: ByteArray new)) + nextPut: aMCDefinition ; + yourself) contents asString encodeForHTTP! Item was changed: + ----- Method: MCHttpRepository>>urlForFileNamed: (in category 'accessing') ----- - ----- Method: MCHttpRepository>>urlForFileNamed: (in category 'as yet unclassified') ----- urlForFileNamed: aString ^ self locationWithTrailingSlash, aString encodeForHTTP! Item was changed: + ----- Method: MCHttpRepository>>user (in category 'accessing') ----- - ----- Method: MCHttpRepository>>user (in category 'as yet unclassified') ----- user self userAndPasswordFromSettingsDo: [:usr :pwd | ^usr]. "not in settings" ^user ifNil: ['']! Item was changed: + ----- Method: MCHttpRepository>>user: (in category 'accessing') ----- - ----- Method: MCHttpRepository>>user: (in category 'as yet unclassified') ----- user: userString user := userString! Item was changed: + ----- Method: MCHttpRepository>>userAndPasswordFromSettingsDo: (in category 'private') ----- - ----- Method: MCHttpRepository>>userAndPasswordFromSettingsDo: (in category 'as yet unclassified') ----- 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 changed: + ----- Method: MCHttpRepository>>versionReaderForFileNamed: (in category 'accessing') ----- - ----- Method: MCHttpRepository>>versionReaderForFileNamed: (in category 'as yet unclassified') ----- 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 changed: + ----- Method: MCHttpRepository>>versionReaderForFileNamed:do: (in category 'accessing') ----- - ----- Method: MCHttpRepository>>versionReaderForFileNamed:do: (in category 'as yet unclassified') ----- versionReaderForFileNamed: aString do: aBlock ^ (self versionReaderForFileNamed: aString) ifNotNil: aBlock! Item was changed: + ----- Method: MCHttpRepository>>writeStreamForFileNamed:replace:do: (in category 'private') ----- - ----- Method: MCHttpRepository>>writeStreamForFileNamed:replace:do: (in category 'required') ----- writeStreamForFileNamed: aString replace: ignoreBoolean do: aBlock | stream response statusLine code | stream := RWBinaryOrTextStream on: String new. aBlock value: stream. self displayProgress: 'Uploading ', aString during:[ response := HTTPSocket httpPut: stream contents to: (self urlForFileNamed: aString) user: self user passwd: self password. ]. "More robust handling of HTTP responses. Instead of enumerating all possible return codes and http versions, do a quick parse" (response beginsWith: 'HTTP/') ifTrue:[ "Looks like an HTTP header, not some error message" statusLine := response copyUpTo: Character cr. code := [(statusLine findTokens: ' ') second asInteger] on: Error do:[]. ]. (code isInteger and:[code between: 200 and: 299]) ifFalse:[self error: response].! Item was changed: + MCOperationsBrowser subclass: #MCMergeBrowser - MCPatchBrowser subclass: #MCMergeBrowser instanceVariableNames: 'conflicts merger ok' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! Item was changed: ----- Method: MCMergeBrowser>>items (in category 'as yet unclassified') ----- items + ^ conflicts, super items! - ^ conflicts, items! Item was added: + MCCodeTool subclass: #MCOperationsBrowser + instanceVariableNames: 'selection' + classVariableNames: '' + poolDictionaries: '' + category: 'Monticello-UI'! Item was added: + ----- Method: MCOperationsBrowser class>>items: (in category 'creation') ----- + items: aCollection + ^ self new + setItems: aCollection ; + yourself! Item was added: + ----- Method: MCOperationsBrowser>>annotations (in category 'accessing') ----- + annotations + ^selection ifNil: [ super annotations ] + ifNotNil: [ selection annotations ]! Item was added: + ----- Method: MCOperationsBrowser>>buttonSpecs (in category 'ui') ----- + buttonSpecs + ^ #((Invert invert 'Show the reverse set of changes') + (Export export 'Export the changes as a change set'))! Item was added: + ----- 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 added: + ----- Method: MCOperationsBrowser>>defaultLabel (in category 'ui') ----- + defaultLabel + ^ label ifNil: [ 'History Browser' ]! Item was added: + ----- Method: MCOperationsBrowser>>installSelection (in category 'actions') ----- + installSelection + | loader | + selection ifNotNil: + [loader := MCPackageLoader new. + selection applyTo: loader. + loader loadWithName: self changeSetNameForInstall ]! Item was added: + ----- Method: MCOperationsBrowser>>invert (in category 'selecting') ----- + invert + items := items collect: [:ea | ea inverse]. + self changed: #list; changed: #text; changed: #selection! Item was added: + ----- Method: MCOperationsBrowser>>list (in category 'accessing') ----- + list + ^ self items collect: [:ea | ea summary]! Item was added: + ----- Method: MCOperationsBrowser>>methodListMenu: (in category 'menus') ----- + methodListMenu: aMenu + selection ifNotNil: + [aMenu addList:#( + ('install' installSelection) + ('revert' revertSelection) + -)]. + self unchangedMethods ifNotEmpty: + [aMenu addList:#( + ('revert unchanged methods...' revertUnchangedMethods) + -)]. + super methodListMenu: aMenu. + ^ aMenu + ! Item was added: + ----- Method: MCOperationsBrowser>>perform:orSendTo: (in category 'ui') ----- + perform: selector orSendTo: otherTarget + "Selector was just chosen from a menu by a user. If can respond, then + perform it on myself. If not, send it to otherTarget, presumably the + editPane from which the menu was invoked." + + (self respondsTo: selector) + ifTrue: [^ self perform: selector] + ifFalse: [^ otherTarget perform: selector]! Item was added: + ----- Method: MCOperationsBrowser>>revertSelection (in category 'actions') ----- + revertSelection + | loader | + selection ifNotNil: + [loader := MCPackageLoader new. + selection inverse applyTo: loader. + loader loadWithName: self changeSetNameForInstall ]! Item was added: + ----- Method: MCOperationsBrowser>>revertUnchangedMethods (in category 'actions') ----- + revertUnchangedMethods + "revert methods that only have changed timestamps" + | loader unchangedMethods | + unchangedMethods := items select: [:op | op isUnchangedMethod]. + (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 added: + ----- Method: MCOperationsBrowser>>selectedClass (in category 'subclassResponsibility') ----- + selectedClass + | definition | + selection ifNil: [ ^nil ]. + (definition := selection definition) ifNil: [ ^nil ]. + definition isMethodDefinition ifFalse: [ ^nil ]. + ^Smalltalk at: definition className ifAbsent: [ ]! Item was added: + ----- Method: MCOperationsBrowser>>selectedClassOrMetaClass (in category 'subclassResponsibility') ----- + selectedClassOrMetaClass + | definition | + selection ifNil: [ ^nil ]. + (definition := selection definition) ifNil: [ ^nil ]. + (definition isMethodDefinition or: [definition isClassDefinition]) ifFalse: [ ^nil ]. + ^definition actualClass! Item was added: + ----- Method: MCOperationsBrowser>>selectedMessageCategoryName (in category 'subclassResponsibility') ----- + selectedMessageCategoryName + | definition | + selection ifNil: [ ^nil ]. + (definition := selection definition) ifNil: [ ^nil ]. + definition isMethodDefinition ifFalse: [ ^nil ]. + ^definition category! Item was added: + ----- Method: MCOperationsBrowser>>selectedMessageName (in category 'subclassResponsibility') ----- + selectedMessageName + | definition | + selection ifNil: [ ^nil ]. + (definition := selection definition) ifNil: [ ^nil ]. + definition isMethodDefinition ifFalse: [ ^nil ]. + ^definition selector! Item was added: + ----- Method: MCOperationsBrowser>>selection (in category 'selecting') ----- + selection + ^ selection + ifNil: [0] + ifNotNil: [self items indexOf: selection]! Item was added: + ----- Method: MCOperationsBrowser>>selection: (in category 'selecting') ----- + selection: aNumber + selection := aNumber = 0 ifFalse: [self items at: aNumber]. + self changed: #selection; changed: #text; changed: #annotations! Item was added: + ----- Method: MCOperationsBrowser>>text (in category 'text') ----- + text + ^ selection ifNil: [''] ifNotNil: [selection source]! Item was added: + ----- Method: MCOperationsBrowser>>text: (in category 'text') ----- + text: aTextOrString + self changed: #text! Item was added: + ----- Method: MCOperationsBrowser>>unchangedMethods (in category 'accessing') ----- + unchangedMethods + ^ items select: [:op | op isUnchangedMethod]! Item was added: + ----- 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)). + { #(textMorph: annotations). #(0 0.4 1 0.4). { 0. 0. 0. self defaultAnnotationPaneHeight. } }. + { #(textMorph: text). #(0 0.4 1 1). { 0. self defaultAnnotationPaneHeight. 0. 0. } }. + }! Item was added: + Object subclass: #MCOperationsList + instanceVariableNames: 'operations' + classVariableNames: '' + poolDictionaries: '' + category: 'Monticello-Patching'! Item was added: + ----- Method: MCOperationsList class>>operations: (in category 'create') ----- + operations: aCollection + ^ self basicNew initializeWithOperations: aCollection! Item was added: + ----- Method: MCOperationsList>>browse (in category 'ui') ----- + browse + (self browserClass items: operations) show! Item was added: + ----- Method: MCOperationsList>>browserClass (in category 'ui') ----- + browserClass + ^ MCOperationsBrowser! Item was added: + ----- Method: MCOperationsList>>initializeWithOperations: (in category 'intializing') ----- + initializeWithOperations: aCollection + operations := aCollection! Item was added: + ----- Method: MCOperationsList>>isEmpty (in category 'querying') ----- + isEmpty + ^ operations isEmpty! Item was added: + ----- Method: MCOperationsList>>operations (in category 'accessing') ----- + operations + ^ operations! Item was changed: ----- 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]! - ]] ensure: [self flushChangesFile] - ]! Item was changed: + MCOperationsList subclass: #MCPatch + instanceVariableNames: '' - Object subclass: #MCPatch - instanceVariableNames: 'operations' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Patching'! Item was changed: + ----- Method: MCPatch class>>fromBase:target: (in category 'create') ----- - ----- Method: MCPatch class>>fromBase:target: (in category 'as yet unclassified') ----- fromBase: baseSnapshot target: targetSnapshot ^ self new initializeWithBase: baseSnapshot target: targetSnapshot! Item was removed: - ----- Method: MCPatch class>>operations: (in category 'as yet unclassified') ----- - operations: aCollection - ^ self basicNew initializeWithOperations: aCollection! Item was changed: ----- Method: MCPatch>>browse (in category 'ui') ----- browse + (self browserClass forPatch: self) show! - ^ (MCPatchBrowser forPatch: self) show! Item was added: + ----- Method: MCPatch>>browserClass (in category 'ui') ----- + browserClass + ^ MCPatchBrowser! Item was changed: + ----- Method: MCPatch>>initializeWithBase:target: (in category 'initialize-release') ----- - ----- Method: MCPatch>>initializeWithBase:target: (in category 'intializing') ----- initializeWithBase: baseSnapshot target: targetSnapshot | base target | operations := OrderedCollection new. base := MCDefinitionIndex definitions: baseSnapshot definitions. target := MCDefinitionIndex definitions: targetSnapshot definitions. target definitions do: [:t | base definitionLike: t ifPresent: [:b | (b isSameRevisionAs: t) ifFalse: [operations add: (MCModification of: b to: t)]] ifAbsent: [operations add: (MCAddition of: t)]] displayingProgress: 'Diffing...'. base definitions do: [:b | target definitionLike: b ifPresent: [:t] ifAbsent: [operations add: (MCRemoval of: b)]] ! Item was removed: - ----- Method: MCPatch>>initializeWithOperations: (in category 'intializing') ----- - initializeWithOperations: aCollection - operations := aCollection! Item was removed: - ----- Method: MCPatch>>isEmpty (in category 'querying') ----- - isEmpty - ^ operations isEmpty! Item was removed: - ----- Method: MCPatch>>operations (in category 'accessing') ----- - operations - ^ operations! Item was changed: + MCOperationsBrowser subclass: #MCPatchBrowser + instanceVariableNames: '' - MCCodeTool subclass: #MCPatchBrowser - instanceVariableNames: 'selection' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! Item was changed: + ----- Method: MCPatchBrowser class>>forPatch: (in category 'instance creation') ----- - ----- Method: MCPatchBrowser class>>forPatch: (in category 'as yet unclassified') ----- forPatch: aPatch ^ self new patch: aPatch! Item was removed: - ----- Method: MCPatchBrowser>>annotations (in category 'as yet unclassified') ----- - annotations - ^selection ifNil: [ super annotations ] - ifNotNil: [ selection annotations ]! Item was removed: - ----- Method: MCPatchBrowser>>buttonSpecs (in category 'morphic ui') ----- - buttonSpecs - ^ #((Invert invert 'Show the reverse set of changes') - (Export export 'Export the changes as a change set'))! Item was removed: - ----- Method: MCPatchBrowser>>changeSetNameForInstall (in category 'as yet unclassified') ----- - 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 changed: + ----- Method: MCPatchBrowser>>defaultLabel (in category 'ui') ----- - ----- Method: MCPatchBrowser>>defaultLabel (in category 'morphic ui') ----- defaultLabel ^ 'Patch Browser'! Item was removed: - ----- Method: MCPatchBrowser>>installSelection (in category 'actions') ----- - installSelection - | loader | - selection ifNotNil: - [loader := MCPackageLoader new. - selection applyTo: loader. - loader loadWithName: self changeSetNameForInstall ]! Item was removed: - ----- Method: MCPatchBrowser>>invert (in category 'selecting') ----- - invert - items := items collect: [:ea | ea inverse]. - self changed: #list; changed: #text; changed: #selection! Item was removed: - ----- Method: MCPatchBrowser>>items (in category 'accessing') ----- - items - ^ items! Item was removed: - ----- Method: MCPatchBrowser>>list (in category 'accessing') ----- - list - ^ self items collect: [:ea | ea summary]! Item was removed: - ----- Method: MCPatchBrowser>>methodListMenu: (in category 'menus') ----- - methodListMenu: aMenu - selection ifNotNil: - [aMenu addList:#( - ('install' installSelection) - ('revert' revertSelection) - -)]. - self unchangedMethods ifNotEmpty: - [aMenu addList:#( - ('revert unchanged methods...' revertUnchangedMethods) - -)]. - super methodListMenu: aMenu. - ^ aMenu - ! Item was changed: + ----- Method: MCPatchBrowser>>patch: (in category 'initialize-release') ----- - ----- Method: MCPatchBrowser>>patch: (in category 'accessing') ----- patch: aPatch items := aPatch operations asSortedCollection! Item was removed: - ----- Method: MCPatchBrowser>>perform:orSendTo: (in category 'morphic ui') ----- - perform: selector orSendTo: otherTarget - "Selector was just chosen from a menu by a user. If can respond, then - perform it on myself. If not, send it to otherTarget, presumably the - editPane from which the menu was invoked." - - (self respondsTo: selector) - ifTrue: [^ self perform: selector] - ifFalse: [^ otherTarget perform: selector]! Item was removed: - ----- Method: MCPatchBrowser>>revertSelection (in category 'actions') ----- - revertSelection - | loader | - selection ifNotNil: - [loader := MCPackageLoader new. - selection inverse applyTo: loader. - loader loadWithName: self changeSetNameForInstall ]! Item was removed: - ----- Method: MCPatchBrowser>>revertUnchangedMethods (in category 'actions') ----- - revertUnchangedMethods - "revert methods that only have changed timestamps" - | loader unchangedMethods | - unchangedMethods := items select: [:op | op isUnchangedMethod]. - (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: MCPatchBrowser>>selectedClass (in category 'subclassResponsibility') ----- - selectedClass - | definition | - selection ifNil: [ ^nil ]. - (definition := selection definition) ifNil: [ ^nil ]. - definition isMethodDefinition ifFalse: [ ^nil ]. - ^Smalltalk at: definition className ifAbsent: [ ]! Item was removed: - ----- Method: MCPatchBrowser>>selectedClassOrMetaClass (in category 'subclassResponsibility') ----- - selectedClassOrMetaClass - | definition | - selection ifNil: [ ^nil ]. - (definition := selection definition) ifNil: [ ^nil ]. - (definition isMethodDefinition or: [definition isClassDefinition]) ifFalse: [ ^nil ]. - ^definition actualClass! Item was removed: - ----- Method: MCPatchBrowser>>selectedMessageCategoryName (in category 'subclassResponsibility') ----- - selectedMessageCategoryName - | definition | - selection ifNil: [ ^nil ]. - (definition := selection definition) ifNil: [ ^nil ]. - definition isMethodDefinition ifFalse: [ ^nil ]. - ^definition category! Item was removed: - ----- Method: MCPatchBrowser>>selectedMessageName (in category 'subclassResponsibility') ----- - selectedMessageName - | definition | - selection ifNil: [ ^nil ]. - (definition := selection definition) ifNil: [ ^nil ]. - definition isMethodDefinition ifFalse: [ ^nil ]. - ^definition selector! Item was removed: - ----- Method: MCPatchBrowser>>selection (in category 'selecting') ----- - selection - ^ selection - ifNil: [0] - ifNotNil: [self items indexOf: selection]! Item was removed: - ----- Method: MCPatchBrowser>>selection: (in category 'selecting') ----- - selection: aNumber - selection := aNumber = 0 ifFalse: [self items at: aNumber]. - self changed: #selection; changed: #text; changed: #annotations! Item was removed: - ----- Method: MCPatchBrowser>>text (in category 'text') ----- - text - ^ selection ifNil: [''] ifNotNil: [selection source]! Item was removed: - ----- Method: MCPatchBrowser>>text: (in category 'text') ----- - text: aTextOrString - self changed: #text! Item was removed: - ----- Method: MCPatchBrowser>>unchangedMethods (in category 'as yet unclassified') ----- - unchangedMethods - ^ items select: [:op | op isUnchangedMethod]! Item was removed: - ----- Method: MCPatchBrowser>>widgetSpecs (in category 'morphic 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)). - { #(textMorph: annotations). #(0 0.4 1 0.4). { 0. 0. 0. self defaultAnnotationPaneHeight. } }. - { #(textMorph: text). #(0 0.4 1 1). { 0. self defaultAnnotationPaneHeight. 0. 0. } }. - }! Item was added: + ----- Method: MCRepository class>>browseMcClassHistoryService (in category 'ui-support') ----- + browseMcClassHistoryService + ^ ServiceAction + id: #browseMcClassHistory + text: 'browse mc history' + button: 'mc' + description: 'Browse the Monticello history of this class from the code repository.' + action: + [ : aBrowserRequestor | aBrowserRequestor browseMcClassHistory ] + condition: + [ : aBrowserRequestor | aBrowserRequestor canBrowseMcClassHistory ]! Item was added: + ----- Method: MCRepository class>>browseMcClassOriginService (in category 'ui-support') ----- + browseMcClassOriginService + ^ ServiceAction + id: #browseMcClassOrigin + text: 'browse mc origin' + button: 'mc' + description: 'Browse the Monticello version comments in which this class definition was originally committed.' + action: + [ : aBrowserRequestor | aBrowserRequestor browseMcClassOrigin ] + condition: + [ : aBrowserRequestor | aBrowserRequestor canBrowseMcClassHistory ]! Item was added: + ----- Method: MCRepository class>>browseMcMethodHistoryService (in category 'ui-support') ----- + browseMcMethodHistoryService + ^ ServiceAction + id: #browseMcMethodHistory + text: 'browse mc history' + button: 'mc' + description: 'Browse the Monticello history of this method from the code repository.' + action: + [ : aBrowserRequestor | aBrowserRequestor browseMcMethodHistory ] + condition: + [ : aBrowserRequestor | aBrowserRequestor canBrowseMcMethodHistory ]! Item was added: + ----- Method: MCRepository class>>browseMcMethodOriginService (in category 'ui-support') ----- + browseMcMethodOriginService + ^ ServiceAction + id: #browseMcMethodOrigin + text: 'browse mc origin' + button: 'mc' + description: 'Browse the Monticello version comments in which this edition of this method was originally committed.' + action: + [ : aBrowserRequestor | aBrowserRequestor browseMcMethodOrigin ] + condition: + [ : aBrowserRequestor | aBrowserRequestor canBrowseMcMethodHistory ]! Item was added: + ----- Method: MCRepository class>>packageCache (in category 'well-known repositories') ----- + packageCache + ^ MCCacheRepository default! Item was added: + ----- Method: MCRepository class>>trunk (in category 'well-known repositories') ----- + trunk + ^ MCHttpRepository trunk! Item was added: + ----- Method: MCRepository class>>unload (in category 'ui-support') ----- + unload + | methodMenuServiceCategory classMenuServiceCategory | + methodMenuServiceCategory := ServiceRegistry current serviceWithId: #browserMethodMenu. + methodMenuServiceCategory services copy do: + [ : each | (#(#browseMcMethodHistory #browseMcMethodOrigin ) includes: each id) ifTrue: [ methodMenuServiceCategory services remove: each ] ]. + classMenuServiceCategory := ServiceRegistry current serviceWithId: #browserClassMenu. + classMenuServiceCategory services copy do: + [ : each | (#(#browseMcClassHistory #browseMcClassOrigin ) includes: each id) ifTrue: [ classMenuServiceCategory services remove: each ] ]! Item was removed: - ----- Method: MCRepository>>flushAllFilenames (in category 'private') ----- - flushAllFilenames - "No-op. Subclasses override if necessary."! Item was added: + ----- Method: MCRepository>>isTrunk (in category 'testing') ----- + isTrunk + ^ false! Item was added: + ----- Method: MCRepository>>mcModel (in category '*monticello') ----- + mcModel + "Only Magma-based repositories employ a McModel instance." + ^ nil! Item was added: + ----- Method: MCRepositoryGroup>>cacheAllFilenames (in category 'private') ----- + cacheAllFilenames + repositories do: [ : each | each cacheAllFilenames ]! Item was added: + ----- Method: MCRepositoryGroup>>flushAllFilenames (in category 'private') ----- + flushAllFilenames + repositories do: [ : each | each flushAllFilenames ]! Item was added: + ----- Method: MCRepositoryGroup>>isTrunk (in category 'testing') ----- + isTrunk + ^ false! Item was added: + ----- Method: MethodReference>>mcHistory (in category '*monticello') ----- + mcHistory + "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 historyOf: self asMethodDefinition ]! Item was added: + ----- Method: MethodReference>>mcModel (in category '*monticello') ----- + mcModel + "If my package is in a MCMagmaRepository, answer its mcModel." + ^ self asMethodDefinition mcModel! Item was added: + ----- Method: MethodReference>>mcOrigin (in category '*monticello') ----- + mcOrigin + "Answer the MCVersion in which this version of this method was originally committed." + ^ self mcModel ifNotNil: [ : mcmodel | mcmodel originOf: self ]! Item was added: + ----- 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 mcHistory 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 added: + ----- 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 ]!
More information about the Squeak-dev mailing list |