[squeak-dev] The Trunk: EToys-pre.353.mczcommits at source.squeak.org commits at source.squeak.orgTue Sep 3 15:14:30 UTC 2019
Patrick Rein uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-pre.353.mcz ==================== Summary ==================== Name: EToys-pre.353 Author: pre Time: 3 September 2019, 5:14:21.865361 pm UUID: 1e430e87-7b49-b042-8aea-67a37f83057f Ancestors: EToys-mt.352 Refactors some methods to not use ChangeSorter class anymore to access changes but ChangeSet class directly. =============== Diff against EToys-mt.352 =============== Item was changed: ----- Method: ChangeSetCategory>>changeSetList (in category 'queries') ----- changeSetList "Answer the list of change-set names in the category" | aChangeSet | self reconstituteList. keysInOrder size == 0 ifTrue: ["don't tolerate emptiness, because ChangeSorters gag when they have no change-set selected" + aChangeSet := ChangeSet assuredChangeSetNamed: 'New Changes'. - aChangeSet := ChangeSorter assuredChangeSetNamed: 'New Changes'. self elementAt: aChangeSet name put: aChangeSet]. ^ keysInOrder reversed! Item was changed: ----- Method: ChangeSetCategory>>fileOutAllChangeSets (in category 'services') ----- fileOutAllChangeSets "File out all the nonempty change sets in the current category, suppressing the checks for slips that might otherwise ensue. Obtain user confirmation before undertaking this possibly prodigious task." | aList | + aList := self elementsInOrder select: [:aChangeSet | aChangeSet notEmpty]. - aList := self elementsInOrder select: - [:aChangeSet | aChangeSet isEmpty not]. aList isEmpty ifTrue: [^ self inform: 'sorry, all the change sets in this category are empty']. (self confirm: 'This will result in filing out ', aList size printString, ' change set(s) Are you certain you want to do this?') ifFalse: [^ self]. Preferences setFlag: #checkForSlips toValue: false during: + [ChangeSet fileOutChangeSetsNamed: (aList collect: [:m | m name]) sort]! - [ChangeSorter fileOutChangeSetsNamed: (aList collect: [:m | m name]) sort]! Item was changed: ----- Method: ChangeSetCategory>>fillAggregateChangeSet (in category 'services') ----- fillAggregateChangeSet "Create a change-set named Aggregate and pour into it all the changes in all the change-sets of the currently-selected category" | aggChangeSet | + aggChangeSet := ChangeSet assuredChangeSetNamed: #Aggregate. - aggChangeSet := ChangeSorter assuredChangeSetNamed: #Aggregate. aggChangeSet clear. aggChangeSet setPreambleToSay: '"Change Set: Aggregate Created at ', Time now printString, ' on ', Date today printString, ' by combining all the changes in all the change sets in the category ', categoryName printString, '"'. (self elementsInOrder copyWithout: aggChangeSet) do: [:aChangeSet | aggChangeSet assimilateAllChangesFoundIn: aChangeSet]. Smalltalk isMorphic ifTrue: [SystemWindow wakeUpTopWindowUponStartup] ! Item was changed: ----- Method: ChangeSetCategory>>reconstituteList (in category 'miscellaneous') ----- reconstituteList "Clear out the receiver's elements and rebuild them" | newMembers | "First determine newMembers and check if they have not changed..." + newMembers := ChangeSet allChangeSets select: - newMembers := ChangeSorter allChangeSets select: [:aChangeSet | ChangeSorter perform: membershipSelector with: aChangeSet]. (newMembers collect: [:cs | cs name]) = keysInOrder ifTrue: [^ self "all current"]. "Things have changed. Need to recompute the whole category" self clear. newMembers do: [:aChangeSet | self fasterElementAt: aChangeSet name asSymbol put: aChangeSet] ! Item was changed: ----- Method: ChangeSetCategoryWithParameters>>reconstituteList (in category 'as yet unclassified') ----- reconstituteList "Clear out the receiver's elements and rebuild them" | newMembers | "First determine newMembers and check if they have not changed..." + newMembers := ChangeSet allChangeSets select: - newMembers := ChangeSorter allChangeSets select: [:aChangeSet | ChangeSorter perform: membershipSelector withArguments: { aChangeSet }, parameters]. (newMembers collect: [:cs | cs name]) = keysInOrder ifTrue: [^ self "all current"]. "Things have changed. Need to recompute the whole category" self clear. newMembers do: [:aChangeSet | self fasterElementAt: aChangeSet name asSymbol put: aChangeSet]! Item was changed: ----- Method: DocLibrary>>saveDocCheck: (in category 'doc pane') ----- saveDocCheck: aMorph "Make sure the document gets attached to the version of the code that the user was looking at. Is there a version of this method in a changeSet beyond the updates we know about? Works even when the user has internal update numbers and the documentation is for external updates (It always is)." | classAndMethod parts selector class lastUp beyond ours docFor unNum ok key verList ext response | classAndMethod := aMorph valueOfProperty: #classAndMethod. classAndMethod ifNil: [ ^ self error: 'need to know the class and method']. "later let user set it" parts := classAndMethod findTokens: ' .'. selector := parts last asSymbol. class := Smalltalk at: (parts first asSymbol) ifAbsent: [^ self saveDoc: aMorph]. parts size = 3 ifTrue: [class := class class]. "Four indexes we are looking for: docFor = highest numbered below lastUpdate that has method. unNum = a higher unnumbered set that has method. lastUp = lastUpdate we know about in methodVersions beyond = any set about lastUp that has the method." + ChangeSet allChangeSets doWithIndex: [:cs :ind | "youngest first" - ChangeSorter allChangeSets doWithIndex: [:cs :ind | "youngest first" (cs name includesSubString: lastUpdateName) ifTrue: [lastUp := ind]. (cs atSelector: selector class: class) ~~ #none ifTrue: [ lastUp ifNotNil: [beyond := ind. ours := cs name] ifNil: [cs name first isDigit ifTrue: [docFor := ind] ifFalse: [unNum := ind. ours := cs name]]]]. "See if version the user sees is the version he is documenting" ok := beyond == nil. unNum ifNotNil: [docFor ifNotNil: [ok := docFor > unNum] ifNil: [ok := false]]. "old changeSets gone" ok ifTrue: [^ self saveDoc: aMorph]. key := DocLibrary properStemFor: classAndMethod. verList := (methodVersions at: key ifAbsent: [#()]), #(0 0). ext := verList first. "external update number we will write to" response := (PopUpMenu labels: 'Cancel\Broadcast Page' withCRs) startUpWithCaption: 'You are documenting a method in External Update ', ext asString, '.\There is a more recent version of that method in ' withCRs, ours, '.\If you are explaining the newer version, please Cancel.\Wait until that version appears in an External Update.' withCRs. response = 2 ifTrue: [self saveDoc: aMorph]. ! Item was changed: ----- Method: ProjectLoading class>>loadImageSegment:fromDirectory:withProjectView:numberOfFontSubstitutes:substituteFont:mgr: (in category '*etoys') ----- loadImageSegment: morphOrList fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr | proj projectsToBeDeleted ef f | (f := (Flaps globalFlapTabWithID: 'Navigator' translated)) ifNotNil: [f hideFlap]. proj := morphOrList arrayOfRoots detect: [:mm | mm isKindOf: Project] ifNone: [^ nil]. numberOfFontSubstitutes > 0 ifTrue: [ proj projectParameterAt: #substitutedFont put: substituteFont]. ef := proj projectParameterAt: #eToysFont. (ef isNil or: [ef ~= substituteFont familySizeFace]) ifTrue: [ proj projectParameterAt: #substitutedFont put: substituteFont. ]. proj projectParameters at: #MultiSymbolInWrongPlace put: false. "Yoshiki did not put MultiSymbols into outPointers in older images!!" morphOrList arrayOfRoots do: [:obj | obj fixUponLoad: proj seg: morphOrList "imageSegment"]. (proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [ morphOrList arrayOfRoots do: [:obj | (obj isKindOf: Set) ifTrue: [obj rehash]]]. proj resourceManager: mgr. "proj versionFrom: preStream." proj lastDirectory: aDirectoryOrNil. proj setParent: Project current. projectsToBeDeleted := OrderedCollection new. existingView == #none ifFalse: [ self makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted]. + ChangeSet allChangeSets add: proj changeSet. - ChangeSorter allChangeSets add: proj changeSet. Project current projectParameters at: #deleteWhenEnteringNewProject ifPresent: [ :ignored | projectsToBeDeleted add: Project current. Project current removeParameter: #deleteWhenEnteringNewProject. ]. projectsToBeDeleted isEmpty ifFalse: [ proj projectParameters at: #projectsToBeDeleted put: projectsToBeDeleted. ]. proj removeParameter: #eToysFont. ^ proj! Item was changed: ----- Method: ProjectLoading class>>loadSexpProjectDict:stream:fromDirectory:withProjectView: (in category '*etoys') ----- loadSexpProjectDict: dict stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView | archive anObject newProj d member memberStream members newSet allNames realName oldSet s | (self checkStream: preStream) ifTrue: [^ nil]. ProgressNotification signal: '0.2'. preStream reset. archive := preStream isZipArchive ifTrue:[ZipArchive new readFrom: preStream] ifFalse:[nil]. members := archive membersMatching: '*.cs'. + members do: [:e | newSet := ChangeSet newChangesFromStream: e contentStream named: 'zzTemp', Time totalSeconds printString]. - members do: [:e | newSet := ChangeSorter newChangesFromStream: e contentStream named: 'zzTemp', Time totalSeconds printString]. member := (archive membersMatching: '*.sexp') first. memberStream := member contentStream. (self checkSecurity: member name preStream: preStream projStream: memberStream) ifFalse: [^nil]. self flag: #tfel. "load all projects and save them again in the new format, then get rid of the error block!!" s := memberStream basicUpToEnd. d := [(DataStream on: memberStream) next] on: Error do: [:e | (Smalltalk at: #MSExpParser) parse: s with: #ksexp]. anObject := d sissReadObjectsAsEtoysProject. preStream close. "anObject := (MSExpParser parse: (archive membersMatching: '*.sexp') first contents with: #ksexp) sissReadObjects." anObject ifNil: [^ nil]. (anObject isKindOf: PasteUpMorph) ifFalse: [^ Project current world addMorph: anObject]. ProgressNotification signal: '0.7'. newProj := MorphicProject new. newProj installPasteUpAsWorld: anObject. + newSet ifNotNil: [oldSet := newProj changeSet. newProj setChangeSet: newSet. ChangeSet removeChangeSet: oldSet]. - newSet ifNotNil: [oldSet := newProj changeSet. newProj setChangeSet: newSet. ChangeSorter removeChangeSet: oldSet]. dict at: 'projectname' ifPresent: [:n | allNames := Project allNames. realName := Utilities keyLike: n satisfying: [:nn | (allNames includes: nn) not]. newProj renameTo: realName. ]. anObject valueOfProperty: #projectVersion ifPresentDo: [:v | newProj version: v]. newProj noteManifestDetailsIn: dict. ProgressNotification signal: '0.8'. ^ newProj.! Item was changed: ----- Method: ProjectLoading class>>makeExistingView:project:projectsToBeDeleted: (in category '*etoys') ----- makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted existingView ifNil: [ Smalltalk isMorphic ifTrue: [ proj createViewIfAppropriate. ] ifFalse: [ + ChangeSet allChangeSets add: proj changeSet. - ChangeSorter allChangeSets add: proj changeSet. Project current openProject: proj. "Note: in MVC we get no further than the above" ]. ] ifNotNil: [ (existingView project isKindOf: DiskProxy) ifFalse: [ existingView project changeSet name: ChangeSet defaultName. projectsToBeDeleted add: existingView project. ]. (existingView owner isSystemWindow) ifTrue: [ existingView owner model: proj ]. existingView project: proj. ]. !
More information about the Squeak-dev mailing list |