[squeak-dev] The Inbox: Monticello-cmm.565.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Sep 6 21:43:47 UTC 2013


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



More information about the Squeak-dev mailing list