The Trunk: EToys-pre.353.mcz

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