[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
|