[etoys-dev] Etoys: Monticello-bf.398.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Aug 18 10:36:47 EDT 2010
Bert Freudenberg uploaded a new version of Monticello to project Etoys:
http://source.squeak.org/etoys/Monticello-bf.398.mcz
==================== Summary ====================
Name: Monticello-bf.398
Author: bf
Time: 18 August 2010, 4:36:35 pm
UUID: b6ad0f25-8cf3-4040-a176-0651acfff26d
Ancestors: Monticello-bf.392, Monticello-ar.397
Merge latest from trunk:
- display class comment changes
- file-out-all for PatchBrowser (to package changes)
- more robust HTTP upload
=============== Diff against Monticello-bf.392 ===============
Item was changed:
----- Method: MCWorkingCopy class>>initialize (in category 'as yet unclassified') -----
initialize
Smalltalk
at: #MczInstaller
ifPresent: [:installer | self adoptVersionInfoFrom: installer].
self updateInstVars.
"Temporary conversion code -- remove later"
registry ifNotNil:[registry rehash]. "changed #="
self allInstancesDo:[:each| "moved notifications"
Smalltalk at: #SystemChangeNotifier ifPresent:[:cls|
cls uniqueInstance noMoreNotificationsFor: each.
].
].
+ self registerForNotifications.
+ Smalltalk addToStartUpList: self!
- self registerForNotifications.!
Item was added:
+ ----- Method: MCPackageManager class>>reregisterForNotificationsWith: (in category 'system changes') -----
+ reregisterForNotificationsWith: aSystemChangeNotifier
+ aSystemChangeNotifier
+ notify: self ofSystemChangesOfItem: #class change: #Added using: #classModified:;
+ notify: self ofSystemChangesOfItem: #class change: #Modified using: #classModified:;
+ notify: self ofSystemChangesOfItem: #class change: #Renamed using: #classModified:;
+ notify: self ofSystemChangesOfItem: #class change: #Commented using: #classModified:;
+ notify: self ofSystemChangesOfItem: #class change: #Recategorized using: #classMoved:;
+ notify: self ofSystemChangesOfItem: #class change: #Removed using: #classRemoved:;
+ notify: self ofSystemChangesOfItem: #method change: #Added using: #methodModified:;
+ notify: self ofSystemChangesOfItem: #method change: #Modified using: #methodModified:;
+ notify: self ofSystemChangesOfItem: #method change: #Recategorized using: #methodMoved:;
+ notify: self ofSystemChangesOfItem: #method change: #Removed using: #methodRemoved:!
Item was changed:
----- Method: MCFileRepositoryInspector>>refresh (in category 'as yet unclassified') -----
refresh
| packageNames |
packageNames := Set new.
packageList := nil.
versions := repository readableFileNames collect: [ :each | | name |
name := (each copyUpToLast: $.) copyUpTo: $(.
name last isDigit ifFalse: [Array with: name with: '' with: '' with: each]
ifTrue:
[Array
with: (packageNames add: (name copyUpToLast: $-)) "pkg name"
with: ((name copyAfterLast: $-) copyUpTo: $.) "user"
with: ((name copyAfterLast: $-) copyAfter: $.) asInteger "version"
with: each]].
- versions := versions select: [:each | (each at: 3) isNumber].
newer := Set new.
inherited := Set new.
loaded := Set new.
(MCWorkingCopy allManagers
" select: [ :each | packageNames includes: each packageName]")
do: [:each | | latest |
each ancestors do: [ :ancestor |
loaded add: ancestor name.
ancestor ancestorsDoWhileTrue: [:heir |
(inherited includes: heir name)
ifTrue: [false]
ifFalse: [inherited add: heir name. true]]].
latest := (versions select: [:v | v first = each package name])
detectMax: [:v | v third].
(latest notNil and: [
each ancestors allSatisfy: [:ancestor | | av |
av := ((ancestor name copyAfterLast: $-) copyAfter: $.) asInteger.
av < latest third or: [
av = latest third and: [((ancestor name copyAfterLast: $-) copyUpTo: $.) ~= latest second]]]])
ifTrue: [newer add: each package name ]].
self changed: #packageList; changed: #versionList!
Item was changed:
----- Method: MCCodeTool>>methodListMenu: (in category 'menus') -----
methodListMenu: aMenu
"Build the menu for the selected method, if any."
+ self selectedMessageName
+ ifNil: [items notEmpty ifTrue:
+ [aMenu addList:#(('fileOut (o)' fileOutMessage))]]
+ ifNotNil: [
- self selectedMessageName ifNotNil: [
aMenu addList:#(
('browse full (b)' browseMethodFull)
('browse hierarchy (h)' classHierarchy)
('browse method (O)' openSingleMessageBrowser)
('browse protocol (p)' browseFullProtocol)
-
('fileOut (o)' fileOutMessage)
('printOut' printOutMessage)
('copy selector (c)' copySelector)).
aMenu addList: #(
-
('browse senders (n)' browseSendersOfMessages)
('browse implementors (m)' browseMessages)
('inheritance (i)' methodHierarchy)
('versions (v)' browseVersions)
('change sets with this method' findMethodInChangeSets)
" ('x revert to previous version' revertToPreviousVersion)"
('remove from current change set' removeFromCurrentChanges)
" ('x revert & remove from changes' revertAndForget)"
('add to current change set' adoptMessageInCurrentChangeset)
" ('x copy up or copy down...' copyUpOrCopyDown)"
" ('x remove method (x)' removeMessage)"
"-"
).
].
" aMenu addList: #(
('x inst var refs...' browseInstVarRefs)
('x inst var defs...' browseInstVarDefs)
('x class var refs...' browseClassVarRefs)
('x class variables' browseClassVariables)
('x class refs (N)' browseClassRefs)
).
"
^ aMenu
!
Item was changed:
----- Method: MCFileBasedRepository>>notifyList (in category 'as yet unclassified') -----
notifyList
- | list |
(self allFileNames includes: 'notify') ifFalse: [^ #()].
^ self readStreamForFileNamed: 'notify' do:
[:s |
+ s upToEnd lines]!
- s upToEnd withSqueakLineEndings findTokens: (String with: Character cr)]!
Item was added:
+ ----- Method: MCClassDefinition>>printCommentOn: (in category 'printing') -----
+ printCommentOn: stream
+ stream
+ nextPut: $";
+ nextPutAll: self comment asString;
+ nextPut: $"
+ !
Item was changed:
----- Method: MCSnapshotBrowser>>allClassNames (in category 'accessing') -----
allClassNames
^ (items
+ select: [:ea | (ea isOrganizationDefinition | ea isScriptDefinition) not]
- select: [:ea | ea isOrganizationDefinition not]
thenCollect: [:ea | ea className]) asSet.
!
Item was changed:
----- Method: MCPackageManager class>>registerForNotifications (in category 'system changes') -----
registerForNotifications
+ Smalltalk
+ at: #SystemChangeNotifier
+ ifPresent:
+ [:cls|
+ cls uniqueInstance noMoreNotificationsFor: self.
+ self reregisterForNotificationsWith: cls uniqueInstance]!
- Smalltalk at: #SystemChangeNotifier ifPresent:[:cls|
- (cls uniqueInstance)
- noMoreNotificationsFor: self;
- notify: self ofSystemChangesOfItem: #class change: #Added using: #classModified:;
- notify: self ofSystemChangesOfItem: #class change: #Modified using: #classModified:;
- notify: self ofSystemChangesOfItem: #class change: #Renamed using: #classModified:;
- notify: self ofSystemChangesOfItem: #class change: #Commented using: #classModified:;
- notify: self ofSystemChangesOfItem: #class change: #Recategorized using: #classMoved:;
- notify: self ofSystemChangesOfItem: #class change: #Removed using: #classRemoved:;
- notify: self ofSystemChangesOfItem: #method change: #Added using: #methodModified:;
- notify: self ofSystemChangesOfItem: #method change: #Modified using: #methodModified:;
- notify: self ofSystemChangesOfItem: #method change: #Recategorized using: #methodMoved:;
- notify: self ofSystemChangesOfItem: #method change: #Removed using: #methodRemoved:
- ].!
Item was added:
+ ----- Method: MCPackageManager class>>flushObsoletePackageInfos (in category 'cleanup') -----
+ flushObsoletePackageInfos
+ "Flush any and all PackageInfos that are not associated with an MCPackageManager."
+
+ | pkgNames |
+ pkgNames := self allManagers collect:[:wcs| wcs packageName] as: Set.
+ PackageOrganizer default flushObsoletePackages:[:p|
+ p class isObsolete or:[(pkgNames includes: p packageName) not].
+ ].!
Item was changed:
----- Method: MCClassDefinition>>source (in category 'printing') -----
source
+ ^ self definitionAndCommentString!
- ^ self definitionString!
Item was added:
+ ----- Method: MCWorkingCopy class>>startUp: (in category 'system startup') -----
+ startUp: resuming
+ "Ensure Monticello is receiving system change notifications."
+
+ resuming ifTrue:
+ [Smalltalk
+ at: #SystemChangeNotifier
+ ifPresent: [:scn| self reregisterForNotificationsWith: scn uniqueInstance]]
+ !
Item was changed:
+ ----- Method: MCPackage>>packageInfo (in category 'accessing') -----
- ----- Method: MCPackage>>packageInfo (in category 'as yet unclassified') -----
packageInfo
^ PackageInfo named: name!
Item was added:
+ ----- Method: MCClassDefinition>>definitionAndCommentString (in category 'printing') -----
+ definitionAndCommentString
+ ^ String streamContents: [:stream |
+ self printDefinitionOn: stream.
+ stream cr; cr.
+ self printCommentOn: stream]!
Item was changed:
----- Method: MCHttpRepository>>writeStreamForFileNamed:replace:do: (in category 'required') -----
writeStreamForFileNamed: aString replace: ignoreBoolean do: aBlock
+ | stream response statusLine code |
- | stream response |
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].!
- (#( 'HTTP/1.1 201 ' 'HTTP/1.1 200 ' 'HTTP/1.0 201 ' 'HTTP/1.0 200 ')
- anySatisfy: [:code | response beginsWith: code ])
- ifFalse: [self error: response].!
Item was changed:
----- Method: MCCodeTool>>fileOutMessage (in category 'menus') -----
fileOutMessage
"Put a description of the selected message on a file"
+ | fileName |
self selectedMessageName ifNotNil:
[Cursor write showWhile:
+ [self selectedClassOrMetaClass fileOutMethod: self selectedMessageName].
+ ^self].
+ items isEmpty ifTrue:
+ [^self].
+ fileName := UIManager default request: 'File out on which file?' initialAnswer: 'methods'.
+ Cursor write showWhile:
+ [| internalStream |
+ internalStream := WriteStream on: (String new: 1000).
+ internalStream header; timeStamp.
+ items do:
+ [:patchOp|
+ patchOp definition isMethodDefinition ifTrue:
+ [(patchOp definition actualClass notNil
+ and: [patchOp definition actualClass includesSelector: patchOp definition selector])
+ ifTrue:
+ [patchOp definition actualClass
+ printMethodChunk: patchOp definition selector
+ withPreamble: true
+ on: internalStream
+ moveSource: false
+ toFile: nil]
+ ifFalse:
+ [internalStream nextChunkPut: patchOp definition className, ' removeSelector: ', patchOp definition selector printString]].
+ patchOp definition isClassDefinition ifTrue:
+ [patchOp definition actualClass
+ ifNotNil:
+ [internalStream nextChunkPut: patchOp definition actualClass definition.
+ patchOp definition comment ifNotNil:
+ [patchOp definition actualClass organization
+ putCommentOnFile: internalStream
+ numbered: 1
+ moveSource: false
+ forClass: patchOp definition actualClass]]
+ ifNil:
+ [internalStream nextChunkPut: patchOp definition className, ' removeFromSystem']]].
+ FileStream writeSourceCodeFrom: internalStream baseName: fileName isSt: true useHtml: false]!
- [self selectedClassOrMetaClass fileOutMethod: self selectedMessageName]]!
More information about the etoys-dev
mailing list