The Inbox: Monticello-cmm.565.mcz

A new version of Monticello was added to project The Inbox:
http://source.squeak.org/inbox/Monticello-cmm.565.mcz

==================== Summary ====================

Name: Monticello-cmm.565
Author: cmm
Time: 5 September 2013, 5:06:53.419 pm
UUID: fc949306-0630-4707-b94b-531e095ab637
Ancestors: Monticello-bf.564

HTTP Repositories can now access SqueakSource with a Magma back-end, to support the 'mc versions' and 'mc origin' operations on classes and methods.

=============== Diff against Monticello-bf.564 ===============

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 mcVersions 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>>mcVersions (in category '*monticello') -----
+ mcVersions
+ "Answer a collection of MCClassDefinitions for this Class, which are in the first Magma-repository in the list of repositories of my working-copy."
+ ^ self mcModel ifNotNil: [ : mcmodel | mcmodel historyOf: self asClassDefinition ]!

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 added:
+ ----- Method: MCHttpRepository class>>initialize (in category 'class initialization') -----
+ initialize
+ self unload.
+ (ServiceRegistry current serviceWithId: #browserMethodMenu) services
+ add: self browseMethodVersionsInMcService ;
+ add: self browseMcMethodOriginService.
+ (ServiceRegistry current serviceWithId: #browserClassMenu) services
+ add: self browseClassVersionsInMcService ;
+ add: self browseMcClassOriginService!

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
+ self halt.
+ ^ HTTPSocket
+ httpGet: self locationWithTrailingSlash
+ args:
+ { 'action'->{actionString}.
+ 'mc-definition'-> {self serializeForRequest: aMCDefinition}}
+ user: self user
+ passwd: self password!

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/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: (WriteStream 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 added:
+ ----- Method: MCRepository class>>browseClassVersionsInMcService (in category 'ui-support') -----
+ browseClassVersionsInMcService
+ ^ ServiceAction
+ id: #browseClassVersionsInMc
+ text: 'browse mc versions'
+ button: 'mc'
+ description: 'Browse the Monticello history of this class'' definitions from the code repository.'
+ action:
+ [ : aBrowserRequestor | aBrowserRequestor browseClassVersionsInMc ]
+ condition:
+ [ : aBrowserRequestor | aBrowserRequestor canBrowseMcClassVersions ]!

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 canBrowseMcClassVersions ]!

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 version of this method was originally committed.'
+ action:
+ [ : aBrowserRequestor | aBrowserRequestor browseMcMethodOrigin ]
+ condition:
+ [ : aBrowserRequestor | aBrowserRequestor canBrowseMcMethodVersions ]!

Item was added:
+ ----- Method: MCRepository class>>browseMethodVersionsInMcService (in category 'ui-support') -----
+ browseMethodVersionsInMcService
+ ^ ServiceAction
+ id: #browseMethodVersionsInMc
+ text: 'browse mc versions'
+ button: 'mc'
+ description: 'Browse the Monticello history of this method from the code repository.'
+ action:
+ [ : aBrowserRequestor | aBrowserRequestor browseMethodVersionsInMc ]
+ condition:
+ [ : aBrowserRequestor | aBrowserRequestor canBrowseMcMethodVersions ]!

Item was added:
+ ----- Method: MCRepository class>>unload (in category 'ui-support') -----
+ unload
+ | methodMenuServiceCategory classMenuServiceCategory |
+ methodMenuServiceCategory := ServiceRegistry current serviceWithId: #browserMethodMenu.
+ methodMenuServiceCategory services copy do:
+ [ : each | (#(#browseMethodVersionsInMc #browseMcMethodOrigin ) includes: each id) ifTrue: [ methodMenuServiceCategory services remove: each ] ].
+ classMenuServiceCategory := ServiceRegistry current serviceWithId: #browserClassMenu.
+ classMenuServiceCategory services copy do:
+ [ : each | (#(#browseClassVersionsInMc #browseMcClassOrigin ) includes: each id) ifTrue: [ classMenuServiceCategory services remove: each ] ]!

Item was added:
+ ----- Method: MCRepository>>mcModel (in category '*monticello') -----
+ mcModel
+ "Only Magma-based repositories employ a McModel instance."
+ ^ nil!

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 mcVersions 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>>mcVersions (in category '*monticello') -----
+ mcVersions
+ "Answer a collection of MCMethodDefinitions for this method, which are in the first Magma-repository in the list of repositories of my working-copy."
+ ^ self mcModel ifNotNil: [ : mcmodel | mcmodel historyOf: self asMethodDefinition ]!

(this is another instance of me trying to constructively criticize details when I'm not convinced of the whole yet - we do want a global history somehow but we're not sure yet exactly how it should be implemented)

> + ----- Method: Class>>mcVersions (in category '*monticello') -----
> + mcVersions
> + "Answer a collection of MCClassDefinitions for this Class, which are in the first Magma-repository in the list of repositories of my working-copy."
> + ^ self mcModel ifNotNil: [ : mcmodel | mcmodel historyOf: self asClassDefinition ]!

An "MCVersion" is a precisely defined entity (a package snapshot with associated meta data). This selector thus is misleading. MC has no concept yet of a series of definitions that describe multiple variants of the same class.

An MCPatchBrowser displays an MCPatch, which is a set of MCPatchOperations that can be applied to an MCSnapshot to make another MCSnapshot.

If you want to display the patches from multiple versions you would need something new, e.g. an MCPatchSeries which would have multiple patches. Otherwise we're watering down the very precise model of Monticello, making it much harder to understand and maintain.

- Bert -