The Inbox: Morphic-ct.1553.mcz

A new version of Morphic was added to project The Inbox:
http://source.squeak.org/inbox/Morphic-ct.1553.mcz

==================== Summary ====================

Name: Morphic-ct.1553
Author: ct
Time: 1 October 2019, 2:21:48.702339 pm
UUID: da26f6fe-1189-0d4c-ac2c-82200146a448
Ancestors: Morphic-ul.1552

Another approach for remembering Morphic provenance

Use #rememberProvenanceDuring: for temporary provenance logging. Browse logged creator method using the debug menu. Does not affect performance if logging is disabled.

Depends on Tools-ct.893.

=============== Diff against Morphic-ul.1552 ===============

Item was changed:
  Object subclass: #Morph
+ instanceVariableNames: 'bounds owner submorphs fullBounds color extension creatorMethod'
+ classVariableNames: 'HaloForAll IndicateKeyboardFocus MetaMenuForAll PreferredCornerRadius RememberProvenance UseSoftDropShadow'
- instanceVariableNames: 'bounds owner submorphs fullBounds color extension'
- classVariableNames: 'HaloForAll IndicateKeyboardFocus MetaMenuForAll PreferredCornerRadius UseSoftDropShadow'
  poolDictionaries: ''
  category: 'Morphic-Kernel'!
 
  !Morph commentStamp: 'klc 3/14/2017 11:30' prior: 0!
  A Morph (from the Greek "shape" or "form") is an interactive graphical object. General information on the Morphic system can be found at http://wiki.squeak.org/squeak/30.
 
  Morphs exist in a tree, rooted at a World (generally a PasteUpMorph). The morphs owned by a morph are its submorphs. Morphs are drawn recursively; if a Morph has no owner it never gets drawn. To hide a Morph and its submorphs, set its #visible property to false using the #visible: method.
 
  The World (screen) coordinate system is used for most coordinates, but can be changed if there is a TransformMorph somewhere in the owner chain.
 
  My instance variables have accessor methods (e.g., #bounds, #bounds:). Most users should use the accessor methods instead of using the instance variables directly.
 
  Structure:
  instance var Type Description
  bounds Rectangle A Rectangle indicating my position and a size that will enclose me.
  owner Morph My parent Morph, or nil for the top-level Morph, which is a
    or nil world, typically a PasteUpMorph.
  submorphs Array My child Morphs.
  fullBounds Rectangle A Rectangle minimally enclosing me and my submorphs.
  color Color My primary color. Subclasses can use this in different ways.
  extension MorphExtension Allows extra properties to be stored without adding a
  or nil   storage burden to all morphs.
 
  By default, Morphs do not position their submorphs. Morphs may position their submorphs directly or use a LayoutPolicy to automatically control their submorph positioning.
 
  Although Morph has some support for BorderStyle, most users should use BorderedMorph if they want borders.!

Item was added:
+ ----- Method: Morph class>>rememberProvenance (in category 'misc') -----
+ rememberProvenance
+
+ ^ RememberProvenance ifNil: [false]!

Item was added:
+ ----- Method: Morph class>>rememberProvenanceDuring: (in category 'misc') -----
+ rememberProvenanceDuring: aBlock
+ "self rememberProvenanceDuring: [self notify: 'Have a look at my debug menu :-)']"
+
+ | wasRemembering |
+ wasRemembering := RememberProvenance.
+ [RememberProvenance := true.
+ ^ aBlock value]
+ ensure: [RememberProvenance := wasRemembering].!

Item was added:
+ ----- Method: Morph>>browseCreatorMethod (in category 'debug and other') -----
+ browseCreatorMethod
+
+ ^ creatorMethod browse!

Item was changed:
  ----- Method: Morph>>buildDebugMenu: (in category 'debug and other') -----
  buildDebugMenu: aHand
  "Answer a debugging menu for the receiver.  The hand argument is seemingly historical and plays no role presently"
 
  | aMenu aPlayer |
  aMenu := MenuMorph new defaultTarget: self.
  aMenu addStayUpItem.
  (self hasProperty: #errorOnDraw) ifTrue:
  [aMenu add: 'start drawing again' translated action: #resumeAfterDrawError.
  aMenu addLine].
  (self hasProperty: #errorOnStep) ifTrue:
  [aMenu add: 'start stepping again' translated action: #resumeAfterStepError.
  aMenu addLine].
 
  aMenu add: 'inspect morph' translated action: #inspectInMorphic:.
  aMenu add: 'inspect owner chain' translated action: #inspectOwnerChain.
  Smalltalk isMorphic ifFalse:
  [aMenu add: 'inspect morph (in MVC)' translated action: #inspect].
 
  self isMorphicModel ifTrue:
  [aMenu add: 'inspect model' translated target: self model action: #inspect;
  add: 'explore model' translated target: self model action: #explore].
  (aPlayer := self player) ifNotNil:
  [aMenu add: 'inspect player' translated target: aPlayer action: #inspect].
 
       aMenu add: 'explore morph' translated target: self selector: #exploreInMorphic:.
 
  aMenu addLine.
  aPlayer ifNotNil:
  [ aMenu add: 'viewer for Player' translated target: self player action: #beViewed.
  aMenu balloonTextForLastItem: 'Opens a viewer on my Player -- this is the same thing you get if you click on the cyan "View" halo handle' translated ].
 
  aMenu add: 'viewer for Morph' translated target: self action: #viewMorphDirectly.
  aMenu balloonTextForLastItem: 'Opens a Viewer on this Morph, rather than on its Player' translated.
  aMenu addLine.
 
  aPlayer ifNotNil:
  [aPlayer class isUniClass ifTrue: [
  aMenu add: 'browse player class' translated target: aPlayer selector: #haveFullProtocolBrowsedShowingSelector: argumentList: #(nil)]].
  aMenu add: 'browse morph class' translated target: self selector: #browseHierarchy.
+ self isMorphicModel
- (self isMorphicModel)
  ifTrue: [aMenu
  add: 'browse model class'
  target: self model
  selector: #browseHierarchy].
+ creatorMethod ifNotNil: [
+ aMenu add: 'browse creator method' action: #browseCreatorMethod].
  aMenu addLine.
 
  self addViewingItemsTo: aMenu.
  aMenu
  add: 'make own subclass' translated action: #subclassMorph;
  add: 'save morph in file' translated  action: #saveOnFile;
  addLine;
  add: 'call #tempCommand' translated action: #tempCommand;
  add: 'define #tempCommand' translated action: #defineTempCommand;
  addLine;
 
  add: 'control-menu...' translated target: self selector: #invokeMetaMenu:;
  add: 'edit balloon help' translated action: #editBalloonHelpText.
 
  ^ aMenu!

Item was changed:
  ----- Method: Morph>>initialize (in category 'initialization') -----
  initialize
- "initialize the state of the receiver"
  owner := nil.
  submorphs := Array empty.
  bounds := self defaultBounds.
+ color := self defaultColor.
+
+ self class rememberProvenance ifTrue: [
+ "Find first receiver in context stack below #new call"
+ | context creator nextContext |
+ context := thisContext home.
+ [context := context sender]
+ doWhileTrue: [context receiver = self].
+ creator := context receiver. "a class"
+ [(nextContext := context sender) receiver = creator]
+ whileTrue: [context := nextContext].
+ [context selector = #new]
+ whileTrue: [context := context sender].
+ creatorMethod := context method methodReference].!
- color := self defaultColor!