The Trunk: Morphic-pre.1469.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

The Trunk: Morphic-pre.1469.mcz

commits-2
Patrick Rein uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-pre.1469.mcz

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

Name: Morphic-pre.1469
Author: pre
Time: 14 December 2018, 9:25:41.432569 am
UUID: 10a97c85-8e46-4725-b82f-189e766baa96
Ancestors: Morphic-mt.1468

Categorizes uncategorized methods in Morphic (but not all yet as some are difficult or seem deprecated).

=============== Diff against Morphic-mt.1468 ===============

Item was changed:
+ ----- Method: AColorSelectorMorph>>defaultFillStyle (in category 'accessing - ui') -----
- ----- Method: AColorSelectorMorph>>defaultFillStyle (in category 'as yet unclassified') -----
  defaultFillStyle
  "Answer the hue gradient."
 
  ^(GradientFillStyle colors: {self color alpha: 0. self color})
  origin: self topLeft;
  direction: (self orientation == #horizontal
  ifTrue: [self width@0]
  ifFalse: [0@self height])!

Item was changed:
+ ----- Method: AbstractHierarchicalList>>genericMenu: (in category 'menus') -----
- ----- Method: AbstractHierarchicalList>>genericMenu: (in category 'as yet unclassified') -----
  genericMenu: aMenu
 
  aMenu add: 'no menu yet' target: self selector: #yourself.
  ^aMenu!

Item was changed:
+ ----- Method: AbstractHierarchicalList>>getCurrentSelection (in category 'selection') -----
- ----- Method: AbstractHierarchicalList>>getCurrentSelection (in category 'as yet unclassified') -----
  getCurrentSelection
 
  ^currentSelection!

Item was changed:
+ ----- Method: AbstractHierarchicalList>>noteNewSelection: (in category 'selection') -----
- ----- Method: AbstractHierarchicalList>>noteNewSelection: (in category 'as yet unclassified') -----
  noteNewSelection: x
 
  currentSelection := x.
  self changed: #getCurrentSelection.
  currentSelection ifNil: [^self].
  currentSelection sendSettingMessageTo: self.
  !

Item was changed:
+ ----- Method: AbstractHierarchicalList>>perform:orSendTo: (in category 'message handling') -----
- ----- Method: AbstractHierarchicalList>>perform:orSendTo: (in category 'as yet unclassified') -----
  perform: selector orSendTo: otherTarget
  "Selector was just chosen from a menu by a user.  If can respond, then
  perform it on myself. If not, send it to otherTarget, presumably the
  editPane from which the menu was invoked."
 
  (self respondsTo: selector)
  ifTrue: [^ self perform: selector]
  ifFalse: [^ otherTarget perform: selector]!

Item was changed:
+ ----- Method: AbstractHierarchicalList>>update: (in category 'updating') -----
- ----- Method: AbstractHierarchicalList>>update: (in category 'as yet unclassified') -----
  update: aSymbol
 
  aSymbol == #hierarchicalList ifTrue: [
  ^self changed: #getList
  ].
  super update: aSymbol!

Item was changed:
+ ----- Method: AbstractResizerMorph class>>gripThickness (in category 'constants') -----
- ----- Method: AbstractResizerMorph class>>gripThickness (in category 'as yet unclassified') -----
  gripThickness
  "A number in pixels that encodes the area were the user can target splitters or edge grips."
 
  ^ 4!

Item was changed:
+ ----- Method: AbstractResizerMorph>>handleColor (in category 'accessing') -----
- ----- Method: AbstractResizerMorph>>handleColor (in category 'as yet unclassified') -----
  handleColor
 
  ^ handleColor ifNil: [self setDefaultColors. handleColor]!

Item was changed:
+ ----- Method: AbstractResizerMorph>>handlesMouseDown: (in category 'event handling') -----
- ----- Method: AbstractResizerMorph>>handlesMouseDown: (in category 'as yet unclassified') -----
  handlesMouseDown: anEvent
 
  ^ true!

Item was changed:
+ ----- Method: AbstractResizerMorph>>handlesMouseOver: (in category 'event handling') -----
- ----- Method: AbstractResizerMorph>>handlesMouseOver: (in category 'as yet unclassified') -----
  handlesMouseOver: anEvent
 
  ^ true
  !

Item was changed:
+ ----- Method: AbstractResizerMorph>>initialize (in category 'initialization') -----
- ----- Method: AbstractResizerMorph>>initialize (in category 'as yet unclassified') -----
  initialize
 
  super initialize.
  self color: Color transparent!

Item was changed:
+ ----- Method: AbstractResizerMorph>>isCursorOverHandle (in category 'testing') -----
- ----- Method: AbstractResizerMorph>>isCursorOverHandle (in category 'as yet unclassified') -----
  isCursorOverHandle
 
  ^ true!

Item was changed:
+ ----- Method: AbstractResizerMorph>>mouseDown: (in category 'event handling') -----
- ----- Method: AbstractResizerMorph>>mouseDown: (in category 'as yet unclassified') -----
  mouseDown: anEvent
 
  lastMouse := anEvent cursorPoint!

Item was changed:
+ ----- Method: AbstractResizerMorph>>mouseEnter: (in category 'event handling') -----
- ----- Method: AbstractResizerMorph>>mouseEnter: (in category 'as yet unclassified') -----
  mouseEnter: anEvent
 
  self isCursorOverHandle ifTrue:
  [self setInverseColors.
  self changed.
  anEvent hand showTemporaryCursor: self resizeCursor]!

Item was changed:
+ ----- Method: AbstractResizerMorph>>mouseLeave: (in category 'event handling') -----
- ----- Method: AbstractResizerMorph>>mouseLeave: (in category 'as yet unclassified') -----
  mouseLeave: anEvent
 
  anEvent hand showTemporaryCursor: nil.
  self setDefaultColors.
  self changed!

Item was changed:
+ ----- Method: AbstractResizerMorph>>referencePoint: (in category 'accessing') -----
- ----- Method: AbstractResizerMorph>>referencePoint: (in category 'as yet unclassified') -----
  referencePoint: aPoint
 
  lastMouse := aPoint.!

Item was changed:
+ ----- Method: AbstractResizerMorph>>resizeCursor (in category 'accessing') -----
- ----- Method: AbstractResizerMorph>>resizeCursor (in category 'as yet unclassified') -----
  resizeCursor
 
  self subclassResponsibility!

Item was changed:
+ ----- Method: AbstractResizerMorph>>setDefaultColors (in category 'private') -----
- ----- Method: AbstractResizerMorph>>setDefaultColors (in category 'as yet unclassified') -----
  setDefaultColors
 
  handleColor := Color lightGray lighter lighter.
  dotColor := Color gray lighter!

Item was changed:
+ ----- Method: AbstractResizerMorph>>setInverseColors (in category 'private') -----
- ----- Method: AbstractResizerMorph>>setInverseColors (in category 'as yet unclassified') -----
  setInverseColors
 
  handleColor := Color lightGray.
  dotColor := Color white!

Item was changed:
+ ----- Method: BorderGripMorph>>drawOn: (in category 'drawing') -----
- ----- Method: BorderGripMorph>>drawOn: (in category 'as yet unclassified') -----
  drawOn: aCanvas
 
  "aCanvas fillRectangle: self bounds color: Color red" "for debugging"
  !

Item was changed:
+ ----- Method: BorderGripMorph>>setDefaultColors (in category 'private') -----
- ----- Method: BorderGripMorph>>setDefaultColors (in category 'as yet unclassified') -----
  setDefaultColors!

Item was changed:
+ ----- Method: BorderGripMorph>>setInverseColors (in category 'private') -----
- ----- Method: BorderGripMorph>>setInverseColors (in category 'as yet unclassified') -----
  setInverseColors!

Item was changed:
+ ----- Method: BorderedSubpaneDividerMorph class>>forBottomEdge (in category 'instance creation') -----
- ----- Method: BorderedSubpaneDividerMorph class>>forBottomEdge (in category 'as yet unclassified') -----
  forBottomEdge
  ^self new horizontal resizingEdge: #bottom!

Item was changed:
+ ----- Method: BorderedSubpaneDividerMorph class>>forTopEdge (in category 'instance creation') -----
- ----- Method: BorderedSubpaneDividerMorph class>>forTopEdge (in category 'as yet unclassified') -----
  forTopEdge
  ^self new horizontal resizingEdge: #top!

Item was changed:
+ ----- Method: BorderedSubpaneDividerMorph class>>horizontal (in category 'instance creation') -----
- ----- Method: BorderedSubpaneDividerMorph class>>horizontal (in category 'as yet unclassified') -----
  horizontal
  ^self new horizontal!

Item was changed:
+ ----- Method: BorderedSubpaneDividerMorph class>>vertical (in category 'instance creation') -----
- ----- Method: BorderedSubpaneDividerMorph class>>vertical (in category 'as yet unclassified') -----
  vertical
  ^self new vertical!

Item was changed:
+ ----- Method: BorderedSubpaneDividerMorph>>firstEnter: (in category 'private') -----
- ----- Method: BorderedSubpaneDividerMorph>>firstEnter: (in category 'as yet unclassified') -----
  firstEnter: evt
  "The first time this divider is activated, find its window and redirect further interaction there."
  | window |
 
  window := self firstOwnerSuchThat: [:m | m respondsTo: #secondaryPaneTransition:divider:].
  window ifNil: [ self suspendEventHandler. ^ self ]. "not working out"
  window secondaryPaneTransition: evt divider: self.
  self on: #mouseEnter send: #secondaryPaneTransition:divider: to: window.
  !

Item was changed:
+ ----- Method: BorderedSubpaneDividerMorph>>horizontal (in category 'layout') -----
- ----- Method: BorderedSubpaneDividerMorph>>horizontal (in category 'as yet unclassified') -----
  horizontal
 
  self hResizing: #spaceFill.!

Item was changed:
+ ----- Method: BorderedSubpaneDividerMorph>>resizingEdge (in category 'accessing') -----
- ----- Method: BorderedSubpaneDividerMorph>>resizingEdge (in category 'as yet unclassified') -----
  resizingEdge
 
  ^resizingEdge
  !

Item was changed:
+ ----- Method: BorderedSubpaneDividerMorph>>resizingEdge: (in category 'accessing') -----
- ----- Method: BorderedSubpaneDividerMorph>>resizingEdge: (in category 'as yet unclassified') -----
  resizingEdge: edgeSymbol
 
  (#(top bottom) includes: edgeSymbol) ifFalse:
  [ self error: 'resizingEdge must be #top or #bottom' ].
  resizingEdge := edgeSymbol.
  self on: #mouseEnter send: #firstEnter: to: self.
  !

Item was changed:
+ ----- Method: BorderedSubpaneDividerMorph>>vertical (in category 'layout') -----
- ----- Method: BorderedSubpaneDividerMorph>>vertical (in category 'as yet unclassified') -----
  vertical
 
  self vResizing: #spaceFill.!

Item was changed:
+ ----- Method: BracketSliderMorph>>disable (in category 'accessing') -----
- ----- Method: BracketSliderMorph>>disable (in category 'as yet unclassified') -----
  disable
  "Disable the receiver."
 
  self enabled: false!

Item was changed:
+ ----- Method: BracketSliderMorph>>enable (in category 'accessing') -----
- ----- Method: BracketSliderMorph>>enable (in category 'as yet unclassified') -----
  enable
  "Enable the receiver."
 
  self enabled: true!

Item was changed:
+ ----- Method: CircleMorph class>>newPin (in category 'instance creation') -----
- ----- Method: CircleMorph class>>newPin (in category 'as yet unclassified') -----
  newPin
  "Construct a pin for embedded attachment"
  "CircleMorph newPin openInHand"
  ^self new
  removeAllMorphs;
  extent: 18@18;
  hResizing: #rigid;
  vResizing: #rigid;
  layoutPolicy: nil;
  color: Color orange lighter;
  borderColor: Color orange darker;
  borderWidth: 2;
- wantsConnectionWhenEmbedded: true;
  name: 'Pin'!

Item was changed:
+ ----- Method: CircleMorph class>>supplementaryPartsDescriptions (in category 'parts bin') -----
- ----- Method: CircleMorph class>>supplementaryPartsDescriptions (in category 'as yet unclassified') -----
  supplementaryPartsDescriptions
  "Extra items for parts bins"
 
  ^ {DescriptionForPartsBin
  formalName: 'Circle' translatedNoop
  categoryList: {'Graphics' translatedNoop}
  documentation: 'A circular shape' translatedNoop
  globalReceiverSymbol: #CircleMorph
  nativitySelector: #newStandAlone.
 
  DescriptionForPartsBin
  formalName: 'Pin' translatedNoop
  categoryList: {'Connectors' translatedNoop}
  documentation: 'An attachment point for Connectors that you can embed in another Morph.' translatedNoop
  globalReceiverSymbol: #NCPinMorph
  nativitySelector: #newPin.
  }!

Item was changed:
+ ----- Method: ColorPickerMorph class>>perniciousBorderColor (in category 'constants') -----
- ----- Method: ColorPickerMorph class>>perniciousBorderColor (in category 'as yet unclassified') -----
  perniciousBorderColor
  "Answer the color of the border lines of a color picker; this color gets reported as you drag the mouse through from the translucent box to the true color area, for example, and can cause some difficulties in some special cases, so it is faithfully reported here in this hard-coded fashion in order that energetic clients wishing to handle it as special-case it can do so."
 
  ^ Color r: 0.0 g: 0.0 b: 0.032!

Item was changed:
+ ----- Method: ComplexProgressIndicator class>>historyReport (in category 'reports') -----
- ----- Method: ComplexProgressIndicator class>>historyReport (in category 'as yet unclassified') -----
  historyReport
  "
  ComplexProgressIndicator historyReport
  "
  | answer |
  History ifNil: [^Beeper beep].
  answer := String streamContents: [ :strm |
  (History keys asArray sort: [ :a :b | a asString <= b asString]) do: [ :k |
  | data |
  strm nextPutAll: k printString; cr.
  data := History at: k.
  (data keys asArray sort: [ :a :b | a asString <= b asString]) do: [ :dataKey |
  strm tab; nextPutAll: dataKey printString,'  ',
  (data at: dataKey) asArray printString; cr.
  ].
  strm cr.
  ].
  ].
  StringHolder new
  contents: answer contents;
  openLabel: 'Progress History'!

Item was changed:
+ ----- Method: CornerGripMorph>>handlesMouseDown: (in category 'event handling') -----
- ----- Method: CornerGripMorph>>handlesMouseDown: (in category 'as yet unclassified') -----
  handlesMouseDown: anEvent
  ^ true!

Item was changed:
+ ----- Method: CornerGripMorph>>handlesMouseOver: (in category 'event handling') -----
- ----- Method: CornerGripMorph>>handlesMouseOver: (in category 'as yet unclassified') -----
  handlesMouseOver: anEvent
  ^true!

Item was changed:
+ ----- Method: CornerGripMorph>>initialize (in category 'initialization') -----
- ----- Method: CornerGripMorph>>initialize (in category 'as yet unclassified') -----
  initialize
  super initialize.
  self extent: self defaultWidth+2 @ (self defaultHeight+2).
  self layoutFrame: self gripLayoutFrame!

Item was changed:
+ ----- Method: CornerGripMorph>>mouseDown: (in category 'event handling') -----
- ----- Method: CornerGripMorph>>mouseDown: (in category 'as yet unclassified') -----
  mouseDown: anEvent
  "Disable drop shadow to improve performance."
 
  super mouseDown: anEvent.
 
  target ifNil: [^ self].
  target fastFramingOn ifFalse: [
  self setProperty: #targetHadDropShadow toValue: target hasDropShadow.
  target hasDropShadow: false].!

Item was changed:
+ ----- Method: CornerGripMorph>>mouseMove: (in category 'event handling') -----
- ----- Method: CornerGripMorph>>mouseMove: (in category 'as yet unclassified') -----
  mouseMove: anEvent
  | delta |
  target ifNil: [^ self].
  target fastFramingOn
  ifTrue: [delta := target doFastWindowReframe: self ptName]
  ifFalse: [
  delta := lastMouse ifNil: [0@0] ifNotNil: [anEvent cursorPoint - lastMouse].
  lastMouse := anEvent cursorPoint.
  self apply: delta.
  self bounds: (self bounds origin + delta extent: self bounds extent)].!

Item was changed:
+ ----- Method: CornerGripMorph>>mouseUp: (in category 'event handling') -----
- ----- Method: CornerGripMorph>>mouseUp: (in category 'as yet unclassified') -----
  mouseUp: anEvent
 
  target ifNil: [^ self].
  target fastFramingOn ifFalse: [
  (self valueOfProperty: #targetHadDropShadow ifAbsent: [false]) ifTrue: [target hasDropShadow: true].
  self removeProperty: #targetHadDropShadow].!

Item was changed:
+ ----- Method: CornerGripMorph>>target: (in category 'accessing-backstop') -----
- ----- Method: CornerGripMorph>>target: (in category 'as yet unclassified') -----
  target: aMorph
 
  target := aMorph!

Item was changed:
  Array variableSubclass: #Cubic
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Morphic-Collections-Arrayed'!
 
+ !Cubic commentStamp: 'pre 12/13/2018 20:14' prior: 0!
+ I am a segment between two points. In the form of a cubic polynomial that can be evaluated between 0..1 to obtain the end points and intermediate values.
- !Cubic commentStamp: 'wiz 6/17/2004 20:31' prior: 0!
- I am a segment between to points. In the form of a cubic polynomial that can be evaluated between 0..1 to obtain the end points and intermediate values.
  !

Item was changed:
+ ----- Method: DoCommandOnceMorph>>actionBlock: (in category 'accessing') -----
- ----- Method: DoCommandOnceMorph>>actionBlock: (in category 'as yet unclassified') -----
  actionBlock: aBlock
 
  actionBlock := aBlock!

Item was changed:
+ ----- Method: DoCommandOnceMorph>>addText: (in category 'ui') -----
- ----- Method: DoCommandOnceMorph>>addText: (in category 'as yet unclassified') -----
  addText: aString
 
  | t |
  t := TextMorph new
  beAllFont: (TextStyle default fontOfSize: 26);
  contents: aString.
  self extent: t extent * 3.
  innerArea := Morph new
  color: Color white;
  extent: self extent - (16@16);
  position: self position + (8@8);
  lock.
  self addMorph: innerArea.
  self addMorph: (t position: self position + t extent; lock).!

Item was changed:
+ ----- Method: DoCommandOnceMorph>>stepTime (in category 'stepping and presenter') -----
- ----- Method: DoCommandOnceMorph>>stepTime (in category 'testing') -----
  stepTime
 
  ^1
  !

Item was changed:
+ ----- Method: DockingBarItemMorph>>iconForm (in category 'private') -----
- ----- Method: DockingBarItemMorph>>iconForm (in category 'as yet unclassified') -----
  iconForm
  "private - answer the form to be used as the icon"
  ^isEnabled
  ifTrue: [
  (isSelected and: [ selectedIcon notNil ])
  ifTrue: [ selectedIcon ]
  ifFalse: [ icon ] ]
  ifFalse: [
  icon asGrayScale ]!

Item was changed:
+ ----- Method: DockingBarItemMorph>>selectedIcon: (in category 'accessing') -----
- ----- Method: DockingBarItemMorph>>selectedIcon: (in category 'as yet unclassified') -----
  selectedIcon: aForm
 
  selectedIcon := aForm!

Item was changed:
+ ----- Method: DockingBarMenuMorph>>activatedFromDockingBar: (in category 'accessing') -----
- ----- Method: DockingBarMenuMorph>>activatedFromDockingBar: (in category 'as yet unclassified') -----
  activatedFromDockingBar: aDockingBar
 
  activatorDockingBar := aDockingBar!

Item was changed:
+ ----- Method: DockingBarUpdatingMenuMorph>>delete (in category 'initialization') -----
- ----- Method: DockingBarUpdatingMenuMorph>>delete (in category 'as yet unclassified') -----
  delete
 
  owner ifNotNil: [
  " When deleted remove my menu items, so I can avoid holding unwanted references to other objects. They will be updated anyway when I become visible again. "
  " The owner notNil condition is necessary because MenuItemMorph >> select: sends delete before I become visible, but after the menu items are updated. "
  self removeAllMorphs ].
  super delete!

Item was changed:
+ ----- Method: DockingBarUpdatingMenuMorph>>initialize (in category 'initialization') -----
- ----- Method: DockingBarUpdatingMenuMorph>>initialize (in category 'as yet unclassified') -----
  initialize
 
  super initialize.
  menuUpdater := MenuUpdater new!

Item was changed:
+ ----- Method: DockingBarUpdatingMenuMorph>>updateMenu (in category 'update') -----
- ----- Method: DockingBarUpdatingMenuMorph>>updateMenu (in category 'as yet unclassified') -----
  updateMenu
 
  menuUpdater update: self!

Item was changed:
+ ----- Method: DockingBarUpdatingMenuMorph>>updater:updateSelector: (in category 'initialization') -----
- ----- Method: DockingBarUpdatingMenuMorph>>updater:updateSelector: (in category 'as yet unclassified') -----
  updater: anObject updateSelector: aSelector
 
  menuUpdater updater: anObject updateSelector: aSelector!

Item was changed:
+ ----- Method: DockingBarUpdatingMenuMorph>>updater:updateSelector:arguments: (in category 'initialization') -----
- ----- Method: DockingBarUpdatingMenuMorph>>updater:updateSelector:arguments: (in category 'as yet unclassified') -----
  updater: anObject updateSelector: aSelector arguments: anArray
 
  menuUpdater updater: anObject updateSelector: aSelector arguments: anArray!

Item was changed:
+ ----- Method: FileDirectoryWrapper class>>with:name:model: (in category 'instance creation') -----
- ----- Method: FileDirectoryWrapper class>>with:name:model: (in category 'as yet unclassified') -----
  with: anObject name: aString model: aModel
 
  ^self new
  setItem: anObject name: aString model: aModel!

Item was changed:
+ ----- Method: FileDirectoryWrapper>>balloonText: (in category 'accessing') -----
- ----- Method: FileDirectoryWrapper>>balloonText: (in category 'as yet unclassified') -----
  balloonText: aStringOrNil
 
  balloonText := aStringOrNil!

Item was changed:
+ ----- Method: FileDirectoryWrapper>>directoryNamesFor: (in category 'private') -----
- ----- Method: FileDirectoryWrapper>>directoryNamesFor: (in category 'as yet unclassified') -----
  directoryNamesFor: anItem
  ^model directoryNamesFor: anItem!

Item was changed:
+ ----- Method: FileDirectoryWrapper>>setItem:name:model: (in category 'initialization') -----
- ----- Method: FileDirectoryWrapper>>setItem:name:model: (in category 'as yet unclassified') -----
  setItem: anObject name: aString model: aModel
 
  item := anObject.
  model := aModel.
  itemName := aString.
  hasContents := nil.
  !

Item was changed:
+ ----- Method: FileDirectoryWrapper>>settingSelector (in category 'private') -----
- ----- Method: FileDirectoryWrapper>>settingSelector (in category 'as yet unclassified') -----
  settingSelector
 
  ^#setSelectedDirectoryTo:!

Item was changed:
+ ----- Method: GradientDisplayMorph>>colorRamp (in category 'accessing') -----
- ----- Method: GradientDisplayMorph>>colorRamp (in category 'as yet unclassified') -----
  colorRamp
  ^self fillStyle colorRamp!

Item was changed:
+ ----- Method: GradientDisplayMorph>>colorRamp: (in category 'accessing') -----
- ----- Method: GradientDisplayMorph>>colorRamp: (in category 'as yet unclassified') -----
  colorRamp: aColorRamp
  self fillStyle colorRamp: aColorRamp!

Item was changed:
+ ----- Method: GradientDisplayMorph>>drawOn: (in category 'drawing') -----
- ----- Method: GradientDisplayMorph>>drawOn: (in category 'as yet unclassified') -----
  drawOn: aCanvas
  "Draw a hatch pattern first."
  aCanvas
  fillRectangle: self innerBounds
  fillStyle: (InfiniteForm with: ColorPresenterMorph hatchForm).
  super drawOn: aCanvas!

Item was changed:
+ ----- Method: GradientDisplayMorph>>initialize (in category 'initialization') -----
- ----- Method: GradientDisplayMorph>>initialize (in category 'as yet unclassified') -----
  initialize
  | fill colorRamp |
  super initialize.
  "self hResizing: #spaceFill. "
  colorRamp := {0.0 -> Color green. 0.3 -> Color red. 0.7 -> Color black. 1.0 -> Color blue}.
  fill := GradientFillStyle ramp: colorRamp.
  fill origin: 0@0.
  fill direction: self bounds extent x @ 0.
  fill radial: false.
  self fillStyle: fill!

Item was changed:
+ ----- Method: GradientEditor class>>on:selector:forMorph:colorRamp: (in category 'instance creation') -----
- ----- Method: GradientEditor class>>on:selector:forMorph:colorRamp: (in category 'as yet unclassified') -----
  on: aTarget selector: aSelector forMorph: aMorph colorRamp: aColorRamp
  ^self new
  setTarget: aTarget
  selector: aSelector
  forMorph: aMorph
  colorRamp: aColorRamp.
 
  !

Item was changed:
+ ----- Method: HColorSelectorMorph>>color: (in category 'accessing') -----
- ----- Method: HColorSelectorMorph>>color: (in category 'as yet unclassified') -----
  color: aColor
  "Ignore to preserve fill style."
  !

Item was changed:
+ ----- Method: HColorSelectorMorph>>defaultFillStyle (in category 'accessing - ui') -----
- ----- Method: HColorSelectorMorph>>defaultFillStyle (in category 'as yet unclassified') -----
  defaultFillStyle
  "Answer the hue gradient."
 
  ^(GradientFillStyle colors: ((0.0 to: 359.9 by: 0.1) collect: [:a | Color h: a s: 1.0 v: 1.0]))
  origin: self topLeft;
  direction: (self orientation == #horizontal
  ifTrue: [self width@0]
  ifFalse: [0@self height])!

Item was changed:
+ ----- Method: HSVAColorSelectorMorph>>alphaSelected: (in category 'accessing') -----
- ----- Method: HSVAColorSelectorMorph>>alphaSelected: (in category 'as yet unclassified') -----
  alphaSelected: aFloat
  "The alpha has changed."
 
  self triggerSelectedColor!

Item was changed:
+ ----- Method: HSVAColorSelectorMorph>>colorSelected: (in category 'accessing') -----
- ----- Method: HSVAColorSelectorMorph>>colorSelected: (in category 'as yet unclassified') -----
  colorSelected: aColor
  "A color has been selected. Set the base color for the alpha channel."
 
  self aMorph color: aColor.
  self triggerSelectedColor!

Item was changed:
+ ----- Method: HSVAColorSelectorMorph>>defaultColor (in category 'initialization') -----
- ----- Method: HSVAColorSelectorMorph>>defaultColor (in category 'as yet unclassified') -----
  defaultColor
  "Answer the default color/fill style for the receiver."
 
  ^Color transparent
  !

Item was changed:
+ ----- Method: HSVAColorSelectorMorph>>initialize (in category 'initialization') -----
- ----- Method: HSVAColorSelectorMorph>>initialize (in category 'as yet unclassified') -----
  initialize
  "Initialize the receiver."
 
  super initialize.
  self
  extent: 180@168;
  changeTableLayout;
  cellInset: 4;
  aMorph: self newAColorMorph;
  hsvMorph: self newHSVColorMorph;
  addMorphBack: self hsvMorph;
  addMorphBack: self aMorph.
  self aMorph color: self hsvMorph selectedColor!

Item was changed:
+ ----- Method: HSVAColorSelectorMorph>>newAColorMorph (in category 'private - initialization') -----
- ----- Method: HSVAColorSelectorMorph>>newAColorMorph (in category 'as yet unclassified') -----
  newAColorMorph
  "Answer a new alpha color morph."
 
  ^AColorSelectorMorph new
  model: self;
  hResizing: #spaceFill;
  vResizing: #rigid;
  setValueSelector: #alphaSelected:;
  extent: 50@24!

Item was changed:
+ ----- Method: HSVAColorSelectorMorph>>newHSVColorMorph (in category 'private - initialization') -----
- ----- Method: HSVAColorSelectorMorph>>newHSVColorMorph (in category 'as yet unclassified') -----
  newHSVColorMorph
  "Answer a new hue/saturation/volume color morph."
 
  ^HSVColorSelectorMorph new
  hResizing: #spaceFill;
  vResizing: #spaceFill;
  when: #colorSelected send: #colorSelected: to: self!

Item was changed:
+ ----- Method: HSVAColorSelectorMorph>>selectedColor (in category 'accessing') -----
- ----- Method: HSVAColorSelectorMorph>>selectedColor (in category 'as yet unclassified') -----
  selectedColor
  "Answer the selected color."
 
  ^self hsvMorph selectedColor alpha: self aMorph value!

Item was changed:
+ ----- Method: HSVAColorSelectorMorph>>selectedColor: (in category 'accessing') -----
- ----- Method: HSVAColorSelectorMorph>>selectedColor: (in category 'as yet unclassified') -----
  selectedColor: aColor
  "Set the hue and sv components."
 
  self aMorph value: aColor alpha.
  self hsvMorph selectedColor: aColor asNontranslucentColor!

Item was changed:
+ ----- Method: HSVAColorSelectorMorph>>triggerSelectedColor (in category 'events') -----
- ----- Method: HSVAColorSelectorMorph>>triggerSelectedColor (in category 'as yet unclassified') -----
  triggerSelectedColor
  "Trigger the event for the selected colour"
  self
  triggerEvent: #selectedColor
  with: self selectedColor.
  self changed: #selectedColor!

Item was changed:
+ ----- Method: HSVColorSelectorMorph>>colorSelected: (in category 'accessing') -----
- ----- Method: HSVColorSelectorMorph>>colorSelected: (in category 'as yet unclassified') -----
  colorSelected: aColor
  "A color has been selected. Make the hue match."
 
  "self hMorph value: aColor hue / 360.
  self svMorph basicColor: (Color h: aColor hue s: 1.0 v: 1.0)."
  self triggerEvent: #colorSelected with: aColor!

Item was changed:
+ ----- Method: HSVColorSelectorMorph>>defaultColor (in category 'initialization') -----
- ----- Method: HSVColorSelectorMorph>>defaultColor (in category 'as yet unclassified') -----
  defaultColor
  "Answer the default color/fill style for the receiver."
 
  ^Color transparent
  !

Item was changed:
+ ----- Method: HSVColorSelectorMorph>>hue: (in category 'accessing') -----
- ----- Method: HSVColorSelectorMorph>>hue: (in category 'as yet unclassified') -----
  hue: aFloat
  "Set the hue in the range 0.0 - 1.0. Update the SV morph and hMorph."
 
  self hMorph value: aFloat.
  self svMorph color: (Color h: aFloat * 359.9 s: 1.0 v: 1.0)!

Item was changed:
+ ----- Method: HSVColorSelectorMorph>>initialize (in category 'initialization') -----
- ----- Method: HSVColorSelectorMorph>>initialize (in category 'as yet unclassified') -----
  initialize
  "Initialize the receiver."
 
  super initialize.
  self
  borderWidth: 0;
  changeTableLayout;
  cellInset: 4;
  listDirection: #leftToRight;
  cellPositioning: #topLeft;
  svMorph: self newSVColorMorph;
  hMorph: self newHColorMorph;
  addMorphBack: self svMorph;
  addMorphBack: self hMorph;
  extent: 192@152;
  hue: 0.5!

Item was changed:
+ ----- Method: HSVColorSelectorMorph>>newHColorMorph (in category 'private - initialization') -----
- ----- Method: HSVColorSelectorMorph>>newHColorMorph (in category 'as yet unclassified') -----
  newHColorMorph
  "Answer a new hue color morph."
 
  ^HColorSelectorMorph new
  model: self;
  setValueSelector: #hue:;
  hResizing: #rigid;
  vResizing: #spaceFill;
  extent: 36@36!

Item was changed:
+ ----- Method: HSVColorSelectorMorph>>newSVColorMorph (in category 'private - initialization') -----
- ----- Method: HSVColorSelectorMorph>>newSVColorMorph (in category 'as yet unclassified') -----
  newSVColorMorph
  "Answer a new saturation/volume color morph."
 
  ^SVColorSelectorMorph new
  extent: 152@152;
  hResizing: #spaceFill;
  vResizing: #spaceFill;
  when: #colorSelected send: #colorSelected: to: self!

Item was changed:
+ ----- Method: HSVColorSelectorMorph>>selectedColor (in category 'accessing') -----
- ----- Method: HSVColorSelectorMorph>>selectedColor (in category 'as yet unclassified') -----
  selectedColor
  "Answer the selected color."
 
  ^self svMorph selectedColor!

Item was changed:
+ ----- Method: HSVColorSelectorMorph>>selectedColor: (in category 'accessing') -----
- ----- Method: HSVColorSelectorMorph>>selectedColor: (in category 'as yet unclassified') -----
  selectedColor: aColor
  "Set the hue and sv components."
 
  self hue: aColor hue / 360.
  self svMorph selectedColor: aColor!

Item was changed:
+ ----- Method: HaloSpec>>addHandleSelector (in category 'accessing') -----
- ----- Method: HaloSpec>>addHandleSelector (in category 'as yet unclassified') -----
  addHandleSelector
  ^ addHandleSelector!

Item was changed:
+ ----- Method: HaloSpec>>color (in category 'accessing') -----
- ----- Method: HaloSpec>>color (in category 'as yet unclassified') -----
  color
  ^ color!

Item was changed:
+ ----- Method: HaloSpec>>horizontalPlacement (in category 'accessing') -----
- ----- Method: HaloSpec>>horizontalPlacement (in category 'as yet unclassified') -----
  horizontalPlacement
  ^ horizontalPlacement!

Item was changed:
+ ----- Method: HaloSpec>>horizontalPlacement:verticalPlacement:color:iconSymbol:addHandleSelector: (in category 'initialization') -----
- ----- Method: HaloSpec>>horizontalPlacement:verticalPlacement:color:iconSymbol:addHandleSelector: (in category 'as yet unclassified') -----
  horizontalPlacement: hp verticalPlacement: vp color: col iconSymbol: is addHandleSelector: sel
  horizontalPlacement := hp.
  verticalPlacement := vp.
  color:= col.
  iconSymbol := is asSymbol.
  addHandleSelector := sel!

Item was changed:
+ ----- Method: HaloSpec>>iconSymbol (in category 'accessing') -----
- ----- Method: HaloSpec>>iconSymbol (in category 'as yet unclassified') -----
  iconSymbol
  ^ iconSymbol!

Item was changed:
+ ----- Method: HaloSpec>>verticalPlacement (in category 'accessing') -----
- ----- Method: HaloSpec>>verticalPlacement (in category 'as yet unclassified') -----
  verticalPlacement
  ^ verticalPlacement!

Item was changed:
  ----- Method: HandMorph class>>doubleClickTime: (in category 'accessing') -----
  doubleClickTime: milliseconds
 
  DoubleClickTime := milliseconds.
  !

Item was changed:
  ----- Method: HandMorph>>processEvents (in category 'event handling') -----
  processEvents
  "Process user input events from the local input devices."
 
  | evt evtBuf type hadAny |
  ActiveEvent ifNotNil:
  ["Meaning that we were invoked from within an event response.
  Make sure z-order is up to date"
 
  self mouseOverHandler processMouseOver: lastMouseEvent].
  hadAny := false.
  [(evtBuf := Sensor nextEvent) isNil] whileFalse:
  [evt := nil. "for unknown event types"
  type := evtBuf first.
  type = EventTypeMouse
  ifTrue: [evt := self generateMouseEvent: evtBuf].
  type = EventTypeMouseWheel
  ifTrue: [evt := self generateMouseWheelEvent: evtBuf].
  type = EventTypeKeyboard
  ifTrue: [evt := self generateKeyboardEvent: evtBuf].
  type = EventTypeDragDropFiles
  ifTrue: [evt := self generateDropFilesEvent: evtBuf].
  type = EventTypeWindow
  ifTrue:[evt := self generateWindowEvent: evtBuf].
  "All other events are ignored"
  (type ~= EventTypeDragDropFiles and: [evt isNil]) ifTrue: [^self].
  evt isNil
  ifFalse:
  ["Finally, handle it"
 
  self handleEvent: evt.
  hadAny := true.
 
  "For better user feedback, return immediately after a mouse event has been processed."
  evt isMouse ifTrue: [^self]]].
  "note: if we come here we didn't have any mouse events"
  mouseClickState notNil
  ifTrue:
  ["No mouse events during this cycle. Make sure click states time out accordingly"
 
  mouseClickState handleEvent: lastMouseEvent asMouseMove from: self].
  hadAny
  ifFalse:
  ["No pending events. Make sure z-order is up to date"
 
  self mouseOverHandler processMouseOver: lastMouseEvent]!

Item was changed:
  ----- Method: HandMorph>>waitForClicksOrDrag:event: (in category 'double click support') -----
  waitForClicksOrDrag: aMorph event: evt
  "Wait for mouse button and movement events, informing aMorph about events interesting to it via callbacks.
  This message is typically sent to the Hand by aMorph when it first receives a mouse-down event.
  The callback methods invoked on aMorph (which are passed a copy of evt) are:
  #click: sent when the mouse button goes up within doubleClickTime.
  #doubleClick: sent when the mouse goes up, down, and up again all within DoubleClickTime.
  #doubleClickTimeout:  sent when the mouse does not have a doubleClick within DoubleClickTime.
  #startDrag: sent when the mouse moves more than 10 pixels from evt's position within DoubleClickTime.
  Note that mouseMove: and mouseUp: events are not sent to aMorph until it becomes the mouse focus,
  which is typically done by aMorph in its click:, doubleClick:, or drag: methods."
 
  ^self waitForClicksOrDrag: aMorph event: evt selectors: #( #click: #doubleClick: #doubleClickTimeout: #startDrag:) threshold: HandMorph dragThreshold!

Item was changed:
+ ----- Method: IconicButton>>darkenedForm (in category 'ui') -----
- ----- Method: IconicButton>>darkenedForm (in category 'as yet unclassified') -----
  darkenedForm
  ^ darkenedForm ifNil: [ darkenedForm := self firstSubmorph baseGraphic darker ]!

Item was changed:
+ ----- Method: IconicButton>>labelFromString: (in category 'label') -----
- ----- Method: IconicButton>>labelFromString: (in category 'as yet unclassified') -----
  labelFromString: aString
  "Make an iconic label from aString"
 
  self labelGraphic: (StringMorph contents: aString) imageForm
  !

Item was changed:
+ ----- Method: IconicButton>>labelGraphic: (in category 'label') -----
- ----- Method: IconicButton>>labelGraphic: (in category 'as yet unclassified') -----
  labelGraphic: aForm
  | oldLabel graphicalMorph |
  (oldLabel := self findA: SketchMorph)
  ifNotNil: [oldLabel delete].
  graphicalMorph := SketchMorph withForm: aForm.
  self extent: graphicalMorph extent + (self borderWidth + 6).
  graphicalMorph position: self center - (graphicalMorph extent // 2).
  self addMorph: graphicalMorph.
  graphicalMorph
  baseGraphic;
  lock.
  !

Item was changed:
+ ----- Method: IconicButton>>restoreImage (in category 'ui') -----
- ----- Method: IconicButton>>restoreImage (in category 'as yet unclassified') -----
  restoreImage
 
  self firstSubmorph restoreBaseGraphic.!

Item was changed:
+ ----- Method: IconicButton>>shedSelvedge (in category 'ui') -----
- ----- Method: IconicButton>>shedSelvedge (in category 'as yet unclassified') -----
  shedSelvedge
  self extent: (self extent - (6@6))!

Item was changed:
+ ----- Method: KeyboardBuffer>>commandKeyPressed (in category 'testing') -----
- ----- Method: KeyboardBuffer>>commandKeyPressed (in category 'as yet unclassified') -----
  commandKeyPressed
  ^ event commandKeyPressed!

Item was changed:
+ ----- Method: KeyboardBuffer>>controlKeyPressed (in category 'testing') -----
- ----- Method: KeyboardBuffer>>controlKeyPressed (in category 'as yet unclassified') -----
  controlKeyPressed
  ^ event controlKeyPressed!

Item was changed:
+ ----- Method: KeyboardBuffer>>keyboardPressed (in category 'testing') -----
- ----- Method: KeyboardBuffer>>keyboardPressed (in category 'as yet unclassified') -----
  keyboardPressed
  ^eventUsed not!

Item was changed:
+ ----- Method: KeyboardBuffer>>leftShiftDown (in category 'testing') -----
- ----- Method: KeyboardBuffer>>leftShiftDown (in category 'as yet unclassified') -----
  leftShiftDown
  ^ event shiftPressed!

Item was changed:
+ ----- Method: ListItemWrapper class>>with: (in category 'instance creation') -----
- ----- Method: ListItemWrapper class>>with: (in category 'as yet unclassified') -----
  with: anObject
 
  ^self new setItem: anObject!

Item was changed:
+ ----- Method: ListItemWrapper class>>with:model: (in category 'instance creation') -----
- ----- Method: ListItemWrapper class>>with:model: (in category 'as yet unclassified') -----
  with: anObject model: aModel
 
  ^self new setItem: anObject model: aModel!

Item was changed:
+ ----- Method: ListItemWrapper>>acceptDroppingObject: (in category 'drag and drop') -----
- ----- Method: ListItemWrapper>>acceptDroppingObject: (in category 'as yet unclassified') -----
  acceptDroppingObject: anotherItem
 
  ^item acceptDroppingObject: anotherItem!

Item was changed:
+ ----- Method: ListItemWrapper>>canBeDragged (in category 'drag and drop') -----
- ----- Method: ListItemWrapper>>canBeDragged (in category 'as yet unclassified') -----
  canBeDragged
 
  ^true!

Item was changed:
+ ----- Method: ListItemWrapper>>handlesMouseOver: (in category 'event handling') -----
- ----- Method: ListItemWrapper>>handlesMouseOver: (in category 'as yet unclassified') -----
  handlesMouseOver: evt
 
  ^false!

Item was changed:
+ ----- Method: ListItemWrapper>>hasContents (in category 'testing') -----
- ----- Method: ListItemWrapper>>hasContents (in category 'accessing') -----
  hasContents
 
  ^self contents isEmpty not!

Item was changed:
+ ----- Method: ListItemWrapper>>hasEquivalentIn: (in category 'testing') -----
- ----- Method: ListItemWrapper>>hasEquivalentIn: (in category 'as yet unclassified') -----
  hasEquivalentIn: aCollection
 
  ^aCollection anySatisfy: [ :each |
  each withoutListWrapper = item withoutListWrapper]!

Item was changed:
+ ----- Method: ListItemWrapper>>sendSettingMessageTo: (in category 'setting') -----
- ----- Method: ListItemWrapper>>sendSettingMessageTo: (in category 'as yet unclassified') -----
  sendSettingMessageTo: aModel
 
  aModel
  perform: (self settingSelector ifNil: [^self])
  with: self withoutListWrapper
  !

Item was changed:
+ ----- Method: ListItemWrapper>>settingSelector (in category 'private') -----
- ----- Method: ListItemWrapper>>settingSelector (in category 'as yet unclassified') -----
  settingSelector
 
  ^nil!

Item was changed:
+ ----- Method: ListItemWrapper>>wantsDroppedObject: (in category 'drag and drop') -----
- ----- Method: ListItemWrapper>>wantsDroppedObject: (in category 'as yet unclassified') -----
  wantsDroppedObject: anotherItem
 
  ^false!

Item was changed:
+ ----- Method: MenuUpdater>>update: (in category 'updating') -----
- ----- Method: MenuUpdater>>update: (in category 'as yet unclassified') -----
  update: aMenuMorph
  "Reconstitute the menu by first removing the contents and then building it afresh"
 
  aMenuMorph removeAllMorphs.
  arguments
  ifNil: [ updater perform: updateSelector with: aMenuMorph ]
  ifNotNil: [
  updater
  perform: updateSelector
  withArguments: (arguments copyWith: aMenuMorph) ].
  aMenuMorph changed!

Item was changed:
+ ----- Method: MenuUpdater>>updater:updateSelector: (in category 'initialization') -----
- ----- Method: MenuUpdater>>updater:updateSelector: (in category 'as yet unclassified') -----
  updater: anObject updateSelector: aSelector
 
  self updater: anObject updateSelector: aSelector arguments: nil!

Item was changed:
+ ----- Method: MenuUpdater>>updater:updateSelector:arguments: (in category 'initialization') -----
- ----- Method: MenuUpdater>>updater:updateSelector:arguments: (in category 'as yet unclassified') -----
  updater: anObject updateSelector: aSelector arguments: anArray
 
  updater := anObject.
  updateSelector := aSelector.
  arguments := anArray!

Item was changed:
+ ----- Method: MixedCurveMorph class>>descriptionForPartsBin (in category 'parts bin') -----
- ----- Method: MixedCurveMorph class>>descriptionForPartsBin (in category 'as yet unclassified') -----
  descriptionForPartsBin
  ^ self partName: 'Mixed'
  categories: #('Graphics' 'Basic')
  documentation: 'A Curve with optional bends and segments. Shift click to get handles.
  Click handles to change bends. Move handles to move the points.'!

Item was changed:
  ----- Method: MouseClickState>>handleEvent:from: (in category 'event handling') -----
  handleEvent: evt from: aHand
  "Process the given mouse event to detect a click, double-click, or drag.
  Return true if the event should be processed by the sender, false if it shouldn't.
  NOTE: This method heavily relies on getting *all* mouse button events."
  | localEvt timedOut isDrag |
  timedOut := (evt timeStamp - firstClickTime) > dblClickTime.
  localEvt := evt transformedBy: (clickClient transformedFrom: aHand owner).
  isDrag := (localEvt position - firstClickDown position) r > dragThreshold.
  clickState == #firstClickDown ifTrue: [
  "Careful here - if we had a slow cycle we may have a timedOut mouseUp event"
  (timedOut and:[localEvt isMouseUp not]) ifTrue:[
  "timeout before #mouseUp -> keep waiting for drag if requested"
  clickState := #firstClickTimedOut.
  dragSelector ifNil:[
  aHand resetClickState.
  self doubleClickTimeout; click "***"].
  ^true].
  localEvt isMouseUp ifTrue:[
 
  (timedOut or:[dblClickSelector isNil]) ifTrue:[
  self click.
  aHand resetClickState.
  ^true].
  "Otherwise transfer to #firstClickUp"
  firstClickUp := evt copy.
  clickState := #firstClickUp.
  "If timedOut or the client's not interested in dbl clicks get outta here"
  self click.
  aHand handleEvent: firstClickUp.
  ^false].
  isDrag ifTrue:["drag start"
  self doubleClickTimeout. "***"
  aHand resetClickState.
  dragSelector "If no drag selector send #click instead"
  ifNil: [self click]
  ifNotNil: [self drag: firstClickDown].
  ^true].
  ^false].
 
  clickState == #firstClickTimedOut ifTrue:[
  localEvt isMouseUp ifTrue:["neither drag nor double click"
  aHand resetClickState.
  self doubleClickTimeout; click. "***"
  ^true].
  isDrag ifTrue:["drag start"
  aHand resetClickState.
  self doubleClickTimeout; drag: firstClickDown. "***"
  ^true].
  ^false].
 
  clickState = #firstClickUp ifTrue:[
  (timedOut) ifTrue:[
  "timed out after mouseUp - signal timeout and pass the event"
  aHand resetClickState.
  self doubleClickTimeout. "***"
  ^true].
  localEvt isMouseDown ifTrue:["double click"
  clickState := #secondClickDown.
  ^false]].
 
  clickState == #secondClickDown ifTrue: [
  timedOut ifTrue:[
  "timed out after second mouseDown - pass event after signaling timeout"
  aHand resetClickState.
  self doubleClickTimeout. "***"
  ^true].
  isDrag ifTrue: ["drag start"
  self doubleClickTimeout. "***"
  aHand resetClickState.
  dragSelector "If no drag selector send #click instead"
  ifNil: [self click]
  ifNotNil: [self drag: firstClickDown].
  ^true].
  localEvt isMouseUp ifTrue: ["double click"
  aHand resetClickState.
  self doubleClick.
  ^false]
  ].
 
  ^true
  !

Item was changed:
+ ----- Method: MouseClickState>>printOn: (in category 'printing') -----
- ----- Method: MouseClickState>>printOn: (in category 'as yet unclassified') -----
  printOn: aStream
  super printOn: aStream.
  aStream nextPut: $[; print: clickState; nextPut: $]
  !

Item was changed:
+ ----- Method: MulticolumnLazyListMorph>>getListItem: (in category 'list access') -----
- ----- Method: MulticolumnLazyListMorph>>getListItem: (in category 'as yet unclassified') -----
  getListItem: index
  ^listSource getListRow: index!

Item was changed:
+ ----- Method: MulticolumnLazyListMorph>>listChanged (in category 'list management') -----
- ----- Method: MulticolumnLazyListMorph>>listChanged (in category 'as yet unclassified') -----
  listChanged
  columnWidths := nil.
  super listChanged!

Item was changed:
+ ----- Method: NameStringInHalo>>placeContents (in category 'private') -----
- ----- Method: NameStringInHalo>>placeContents (in category 'as yet unclassified') -----
  placeContents
  | namePosition |
  (owner notNil and: [owner isInWorld]) ifTrue:
  [namePosition := owner basicBox bottomCenter -
  ((self width // 2) @ (owner handleSize negated // 2 - 1)).
  namePosition := namePosition min: self world viewBox bottomRight - self extent y + 2.
  self bounds: (namePosition extent: self extent)]!

Item was changed:
+ ----- Method: NewHandleMorph>>followHand:forEachPointDo:lastPointDo: (in category 'resize/collapse') -----
- ----- Method: NewHandleMorph>>followHand:forEachPointDo:lastPointDo: (in category 'all') -----
  followHand: aHand forEachPointDo: block1 lastPointDo: block2
  hand := aHand.
  pointBlock := block1.
  lastPointBlock := block2.
  self position: hand lastEvent cursorPoint - (self extent // 2)!

Item was changed:
+ ----- Method: NewHandleMorph>>followHand:forEachPointDo:lastPointDo:withCursor: (in category 'resize/collapse') -----
- ----- Method: NewHandleMorph>>followHand:forEachPointDo:lastPointDo:withCursor: (in category 'all') -----
  followHand: aHand forEachPointDo: block1 lastPointDo: block2 withCursor: aCursor
 
  hand := aHand.
  hand showTemporaryCursor: aCursor "hotSpotOffset: aCursor offset negated".
 
  color := Color transparent.
  pointBlock := block1.
  lastPointBlock := block2.
 
  self borderWidth: 0.
  self position: hand lastEvent cursorPoint - (self extent // 2)!

Item was changed:
+ ----- Method: NewHandleMorph>>sensorMode (in category 'accessing') -----
- ----- Method: NewHandleMorph>>sensorMode (in category 'all') -----
  sensorMode
 
  "If our client is still addressing the Sensor directly, we need to do so as well"
  ^self valueOfProperty: #sensorMode ifAbsent: [false].
  !

Item was changed:
+ ----- Method: NewHandleMorph>>sensorMode: (in category 'accessing') -----
- ----- Method: NewHandleMorph>>sensorMode: (in category 'all') -----
  sensorMode: aBoolean
 
  "If our client is still addressing the Sensor directly, we need to do so as well"
  self setProperty: #sensorMode toValue: aBoolean.
  !

Item was changed:
+ ----- Method: ObjectExplorerWrapper class>>with:name:model: (in category 'instance creation') -----
- ----- Method: ObjectExplorerWrapper class>>with:name:model: (in category 'as yet unclassified') -----
  with: anObject name: aString model: aModel
 
  ^self new
  setItem: anObject name: aString model: aModel!

Item was changed:
+ ----- Method: ObjectExplorerWrapper class>>with:name:model:parent: (in category 'instance creation') -----
- ----- Method: ObjectExplorerWrapper class>>with:name:model:parent: (in category 'as yet unclassified') -----
  with: anObject name: aString model: aModel parent: aParent
 
  ^self new
  setItem: anObject name: aString model: aModel parent: aParent
  !

Item was changed:
  ----- Method: PasteUpMorph>>deleteAllHalos (in category 'world state') -----
  deleteAllHalos
  self haloMorphs do:
  [ : m | m target isSelectionMorph ifTrue: [ m target delete ] ].
  self hands do:
  [ : each | each removeHalo ]!

Item was changed:
+ ----- Method: PluggableListMorph>>listMorph (in category 'accessing') -----
- ----- Method: PluggableListMorph>>listMorph (in category 'as yet unclassified') -----
  listMorph
  listMorph ifNil: [
+ "create this lazily, in case the morph is legacy"
- "crate this lazily, in case the morph is legacy"
  listMorph := self listMorphClass new.
  listMorph listSource: self.
  listMorph width: self scroller width.
  listMorph color: self textColor ].
 
  listMorph owner ~~ self scroller ifTrue: [
  "list morph needs to be installed.  Again, it's done this way to accomodate legacy PluggableListMorphs"
  self scroller removeAllMorphs.
  self scroller addMorph: listMorph ].
 
  ^listMorph!

Item was changed:
+ ----- Method: PluggableListMorph>>listMorphClass (in category 'private') -----
- ----- Method: PluggableListMorph>>listMorphClass (in category 'as yet unclassified') -----
  listMorphClass
  ^LazyListMorph!

Item was changed:
+ ----- Method: PluggableListMorphByItem>>getList (in category 'model access') -----
- ----- Method: PluggableListMorphByItem>>getList (in category 'as yet unclassified') -----
  getList
  "cache the raw items in itemList"
  itemList := getListSelector ifNil: [ #() ] ifNotNil: [ model perform: getListSelector ].
  ^super getList!

Item was changed:
+ ----- Method: PluggableMultiColumnListMorph>>listMorphClass (in category 'private') -----
- ----- Method: PluggableMultiColumnListMorph>>listMorphClass (in category 'accessing') -----
  listMorphClass
  ^MulticolumnLazyListMorph!

Item was changed:
+ ----- Method: PluggableTextMorph class>>cleanUp: (in category 'initialize-release') -----
- ----- Method: PluggableTextMorph class>>cleanUp: (in category 'as yet unclassified') -----
  cleanUp: aggressive
 
  aggressive ifTrue: [self flushAdornmentCache].!

Item was changed:
+ ----- Method: PluggableTextMorph class>>on:text:accept: (in category 'instance creation') -----
- ----- Method: PluggableTextMorph class>>on:text:accept: (in category 'as yet unclassified') -----
  on: anObject text: getTextSel accept: setTextSel
 
  ^ self on: anObject
  text: getTextSel
  accept: setTextSel
  readSelection: nil
  menu: nil!

Item was changed:
+ ----- Method: PluggableTextMorph class>>on:text:accept:readSelection:menu: (in category 'instance creation') -----
- ----- Method: PluggableTextMorph class>>on:text:accept:readSelection:menu: (in category 'as yet unclassified') -----
  on: anObject text: getTextSel accept: setTextSel readSelection: getSelectionSel menu: getMenuSel
 
  ^ self new on: anObject
  text: getTextSel
  accept: setTextSel
  readSelection: getSelectionSel
  menu: getMenuSel!

Item was changed:
+ ----- Method: PopUpChoiceMorph>>actionSelector (in category 'accessing') -----
- ----- Method: PopUpChoiceMorph>>actionSelector (in category 'as yet unclassified') -----
  actionSelector
 
  ^ actionSelector
  !

Item was changed:
+ ----- Method: PopUpChoiceMorph>>actionSelector: (in category 'accessing') -----
- ----- Method: PopUpChoiceMorph>>actionSelector: (in category 'as yet unclassified') -----
  actionSelector: aSymbolOrString
 
  (nil = aSymbolOrString or:
  ['nil' = aSymbolOrString or:
  [aSymbolOrString isEmpty]])
  ifTrue: [^ actionSelector := nil].
 
  actionSelector := aSymbolOrString asSymbol.
  !

Item was changed:
+ ----- Method: PopUpChoiceMorph>>arguments (in category 'accessing') -----
- ----- Method: PopUpChoiceMorph>>arguments (in category 'as yet unclassified') -----
  arguments
 
  ^ arguments
  !

Item was changed:
+ ----- Method: PopUpChoiceMorph>>arguments: (in category 'accessing') -----
- ----- Method: PopUpChoiceMorph>>arguments: (in category 'as yet unclassified') -----
  arguments: aCollection
 
  arguments := aCollection asArray copy.
  !

Item was changed:
+ ----- Method: PopUpChoiceMorph>>getItemsArgs (in category 'accessing') -----
- ----- Method: PopUpChoiceMorph>>getItemsArgs (in category 'as yet unclassified') -----
  getItemsArgs
 
  ^ getItemsArgs
  !

Item was changed:
+ ----- Method: PopUpChoiceMorph>>getItemsArgs: (in category 'accessing') -----
- ----- Method: PopUpChoiceMorph>>getItemsArgs: (in category 'as yet unclassified') -----
  getItemsArgs: aCollection
 
  getItemsArgs := aCollection asArray copy.
  !

Item was changed:
+ ----- Method: PopUpChoiceMorph>>getItemsSelector (in category 'accessing') -----
- ----- Method: PopUpChoiceMorph>>getItemsSelector (in category 'as yet unclassified') -----
  getItemsSelector
 
  ^ getItemsSelector
  !

Item was changed:
+ ----- Method: PopUpChoiceMorph>>getItemsSelector: (in category 'accessing') -----
- ----- Method: PopUpChoiceMorph>>getItemsSelector: (in category 'as yet unclassified') -----
  getItemsSelector: aSymbolOrString
 
  (nil = aSymbolOrString or:
  ['nil' = aSymbolOrString or:
  [aSymbolOrString isEmpty]])
  ifTrue: [^ getItemsSelector := nil].
 
  getItemsSelector := aSymbolOrString asSymbol.
  !

Item was changed:
+ ----- Method: PopUpChoiceMorph>>target (in category 'accessing') -----
- ----- Method: PopUpChoiceMorph>>target (in category 'as yet unclassified') -----
  target
 
  ^ target
  !

Item was changed:
+ ----- Method: PopUpChoiceMorph>>target: (in category 'accessing-backstop') -----
- ----- Method: PopUpChoiceMorph>>target: (in category 'as yet unclassified') -----
  target: anObject
 
  target := anObject
  !

Item was changed:
+ ----- Method: Presenter>>associatedMorph: (in category 'accessing') -----
- ----- Method: Presenter>>associatedMorph: (in category 'access') -----
  associatedMorph: m!

Item was changed:
+ ----- Method: ProjectViewMorph>>addProjectNameMorph (in category 'private') -----
- ----- Method: ProjectViewMorph>>addProjectNameMorph (in category 'as yet unclassified') -----
  addProjectNameMorph
 
  | m |
 
  self removeAllMorphs.
  m := UpdatingStringMorph contents: self safeProjectName font: self fontForName.
  m target: self; getSelector: #safeProjectName; putSelector: #safeProjectName:.
  m useStringFormat; fitContents.
  self addMorphBack: m.
  self updateNamePosition.
  ^m
 
  !

Item was changed:
+ ----- Method: ProjectViewMorph>>addProjectNameMorphFiller (in category 'private') -----
- ----- Method: ProjectViewMorph>>addProjectNameMorphFiller (in category 'as yet unclassified') -----
  addProjectNameMorphFiller
 
  | m |
 
  self removeAllMorphs.
  m := AlignmentMorph newRow color: Color transparent.
  self addMorphBack: m.
  m
  on: #mouseDown send: #editTheName: to: self;
  on: #mouseUp send: #yourself to: self.
  self updateNamePosition.
 
  !

Item was changed:
+ ----- Method: ProjectViewMorph>>editTheName: (in category 'events') -----
- ----- Method: ProjectViewMorph>>editTheName: (in category 'as yet unclassified') -----
  editTheName: evt
 
  self isTheRealProjectPresent ifFalse: [
  ^self inform: 'The project is not present and may not be renamed now' translated
  ].
  self addProjectNameMorph launchMiniEditor: evt.!

Item was changed:
+ ----- Method: ProjectViewMorph>>expungeProject (in category 'events') -----
- ----- Method: ProjectViewMorph>>expungeProject (in category 'as yet unclassified') -----
  expungeProject
 
  (self confirm: ('Do you really want to delete {1}
  and all its content?' translated format: {project name}))
  ifFalse: [^ self].
  owner isSystemWindow
  ifTrue: [owner model: nil;
  delete].
 
  project delete.
  self delete.!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>isCursorOverHandle (in category 'testing') -----
- ----- Method: ProportionalSplitterMorph>>isCursorOverHandle (in category 'displaying') -----
  isCursorOverHandle
  ^ self class showSplitterHandles not or: [self handleRect containsPoint: ActiveHand cursorPoint]!

Item was changed:
+ ----- Method: RectangleMorph class>>roundRectPrototype (in category 'parts bin') -----
- ----- Method: RectangleMorph class>>roundRectPrototype (in category 'as yet unclassified') -----
  roundRectPrototype
  "Answer a prototypical RoundRect object for a parts bin."
 
  ^ self authoringPrototype useRoundedCorners
  color: (Color r: 1.0 g: 0.3 b: 0.6);
  borderWidth: 1;
  setNameTo: 'RoundRect'!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>adoptPaneColor: (in category 'accessing') -----
- ----- Method: SVColorSelectorMorph>>adoptPaneColor: (in category 'as yet unclassified') -----
  adoptPaneColor: paneColor
  "Pass on to the border too."
 
  super adoptPaneColor: paneColor.
  self borderStyle baseColor: paneColor twiceDarker!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>basicColor: (in category 'visual properties') -----
- ----- Method: SVColorSelectorMorph>>basicColor: (in category 'as yet unclassified') -----
  basicColor: aColor
  "Set the gradient colors."
 
  super color: aColor asNontranslucentColor.
  self
  fillStyle: self gradient!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>blackGradient (in category 'private') -----
- ----- Method: SVColorSelectorMorph>>blackGradient (in category 'as yet unclassified') -----
  blackGradient
  "Answer the black gradient. Top to bottom, transparent to black."
 
  ^(InterpolatedGradientFillStyle colors: {Color black alpha: 0. Color black})
  origin: self innerBounds topLeft;
  direction: 0@self innerBounds height!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>blackGradientMorph (in category 'private') -----
- ----- Method: SVColorSelectorMorph>>blackGradientMorph (in category 'as yet unclassified') -----
  blackGradientMorph
  "Answer the black gradient morph."
 
  ^Morph new
  hResizing: #spaceFill;
  vResizing: #spaceFill;
  fillStyle: self blackGradient!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>borderWidth: (in category 'accessing') -----
- ----- Method: SVColorSelectorMorph>>borderWidth: (in category 'as yet unclassified') -----
  borderWidth: anInteger
  "Update the gradients after setting."
 
  super borderWidth: anInteger.
  self updateGradients!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>color: (in category 'accessing') -----
- ----- Method: SVColorSelectorMorph>>color: (in category 'as yet unclassified') -----
  color: aColor
  "Set the gradient colors."
 
  self
  basicColor: aColor;
  selectedColor: (Color h: aColor hue s: self selectedColor saturation v: self selectedColor brightness)!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>colorAt: (in category 'color selecting') -----
- ----- Method: SVColorSelectorMorph>>colorAt: (in category 'as yet unclassified') -----
  colorAt: aPoint
  "Answer the color in the world at the given point."
 
  ^self isInWorld
  ifTrue: [(Display colorAt: aPoint) asNontranslucentColor ]
  ifFalse: [Color black]!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>fillStyle: (in category 'visual properties') -----
- ----- Method: SVColorSelectorMorph>>fillStyle: (in category 'as yet unclassified') -----
  fillStyle: fillStyle
  "If it is a color then override with gradient."
 
  fillStyle isColor
  ifTrue: [self color: fillStyle]
  ifFalse: [super fillStyle: fillStyle]!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>gradient (in category 'visual properties') -----
- ----- Method: SVColorSelectorMorph>>gradient (in category 'as yet unclassified') -----
  gradient
  "Answer the base gradient."
 
  |b|
  b := self innerBounds.
  ^(GradientFillStyle colors: {Color white. self color})
  origin: b topLeft;
  direction: (b width@0)!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>handlesMouseDown: (in category 'event handling') -----
- ----- Method: SVColorSelectorMorph>>handlesMouseDown: (in category 'as yet unclassified') -----
  handlesMouseDown: evt
  "Yes for down and move.."
 
  ^true!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>handlesMouseOverDragging: (in category 'event handling') -----
- ----- Method: SVColorSelectorMorph>>handlesMouseOverDragging: (in category 'as yet unclassified') -----
  handlesMouseOverDragging: evt
  "Yes, make the location morph visible when leaving."
 
  ^true!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>hideLocation (in category 'private') -----
- ----- Method: SVColorSelectorMorph>>hideLocation (in category 'as yet unclassified') -----
  hideLocation
  "Hide the location morph and update the display."
 
  self locationMorph visible: false.
  self refreshWorld.!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>initialize (in category 'initialization') -----
- ----- Method: SVColorSelectorMorph>>initialize (in category 'as yet unclassified') -----
  initialize
  "Initialize the receiver."
 
  super initialize.
  self locationMorph: self newLocationMorph.
  self
  clipSubmorphs: true;
  color: Color blue;
  borderStyle: (BorderStyle inset width: 1);
  addMorphBack: self locationMorph;
  addMorphBack: self blackGradientMorph!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>mouseDown: (in category 'event handling') -----
- ----- Method: SVColorSelectorMorph>>mouseDown: (in category 'as yet unclassified') -----
  mouseDown: evt
  "Handle a mouse down event. Select the color at the mouse position."
 
  evt redButtonPressed
  ifFalse: [^super mouseDown: evt].
  evt hand showTemporaryCursor: (Cursor crossHair copy offset: -9 @ -9).
  self hideLocation.
  self selectColorAt: evt position.
  ^super mouseDown: evt!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>mouseEnterDragging: (in category 'event handling') -----
- ----- Method: SVColorSelectorMorph>>mouseEnterDragging: (in category 'as yet unclassified') -----
  mouseEnterDragging: evt
  "Make the location morph invisible when entering."
 
  self hideLocation.
  evt hand showTemporaryCursor: (Cursor crossHair copy offset: -9 @ -9).!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>mouseLeaveDragging: (in category 'event handling') -----
- ----- Method: SVColorSelectorMorph>>mouseLeaveDragging: (in category 'as yet unclassified') -----
  mouseLeaveDragging: evt
  "Make the location morph visible when leaving."
 
  evt hand showTemporaryCursor: nil.
  self showLocation!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>mouseMove: (in category 'event handling') -----
- ----- Method: SVColorSelectorMorph>>mouseMove: (in category 'as yet unclassified') -----
  mouseMove: evt
  "Handle a mouse move event. Select the color at the mouse position."
 
  evt redButtonPressed
  ifFalse: [^super mouseMove: evt].
  self selectColorAt: evt position.
  ^super mouseMove: evt!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>mouseUp: (in category 'event handling') -----
- ----- Method: SVColorSelectorMorph>>mouseUp: (in category 'as yet unclassified') -----
  mouseUp: evt
  "Handle a up event. Show the location morph again."
 
  evt hand showTemporaryCursor: nil.
  self updateSelectedLocation.
  self locationMorph visible: true!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>newLocationMorph (in category 'private') -----
- ----- Method: SVColorSelectorMorph>>newLocationMorph (in category 'as yet unclassified') -----
  newLocationMorph
  "Answer a new morph indicating the location of the selected color."
 
  ^ImageMorph new
  image: Cursor crossHair withMask asCursorForm!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>selectColorAt: (in category 'color selecting') -----
- ----- Method: SVColorSelectorMorph>>selectColorAt: (in category 'as yet unclassified') -----
  selectColorAt: aPoint
  "Set the color at the given position."
 
  |b p|
  b := self innerBounds.
  p := (b containsPoint: aPoint)
  ifTrue: [aPoint]
  ifFalse: [b pointNearestTo: aPoint].
  p := p - b topLeft / b extent.
  self selectedColor: (Color
  h: self color hue
  s: p x
  v: 1.0 - p y)!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>selectedLocation (in category 'color selecting') -----
- ----- Method: SVColorSelectorMorph>>selectedLocation (in category 'as yet unclassified') -----
  selectedLocation
  "Answer the location within the receiver of the selected colour
  relative to the receiver's top left."
 
  |b c x y|
  b := self innerBounds.
  c := self selectedColor.
  x := c saturation * (b width - 1).
  y := 1 - c brightness * (b height - 1).
  ^(x truncated @ y truncated) + b topLeft!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>showLocation (in category 'private') -----
- ----- Method: SVColorSelectorMorph>>showLocation (in category 'as yet unclassified') -----
  showLocation
  "Show the location morph and update the display."
 
  self locationMorph visible: true.
  self refreshWorld.!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>updateGradients (in category 'private') -----
- ----- Method: SVColorSelectorMorph>>updateGradients (in category 'as yet unclassified') -----
  updateGradients
  "Update the gradient directions."
 
  |bgm b|
  b := self innerBounds.
  bgm := self submorphs last.
  bgm bounds: b.
  bgm fillStyle
  origin: b topLeft;
  direction: 0@b height.
  self fillStyle
  origin: b topLeft;
  direction: (b width@0).
  self updateSelectedLocation!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>updateSelectedLocation (in category 'private') -----
- ----- Method: SVColorSelectorMorph>>updateSelectedLocation (in category 'as yet unclassified') -----
  updateSelectedLocation
  "Position the location morph to indicate the selected colour."
 
  self locationMorph
  position: (self selectedLocation - (self locationMorph extent // 2 + (self locationMorph extent \\ 2)))!

Item was changed:
+ ----- Method: SearchBar class>>build (in category 'building') -----
- ----- Method: SearchBar class>>build (in category 'as yet unclassified') -----
  build
 
  ^ ToolBuilder build: self new!

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>handleMouseMove: (in category 'events-processing') -----
  handleMouseMove: anEvent
  "Reimplemented because we really want #mouseMove when a morph is dragged around"
  anEvent wasHandled ifTrue:[^self]. "not interested"
  self hoveredMorph: (self itemFromPoint: anEvent position).
  (anEvent anyButtonPressed and:[anEvent hand mouseFocus == self]) ifFalse:[^self].
  anEvent wasHandled: true.
  self mouseMove: anEvent.
  (self handlesMouseStillDown: anEvent) ifTrue:[
  "Step at the new location"
  self startStepping: #handleMouseStillDown:
  at: Time millisecondClockValue
  arguments: {anEvent copy resetHandlerFields}
  stepTime: 1].
  !

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>mouseEnterDragging: (in category 'event handling') -----
  mouseEnterDragging: evt
  | aMorph |
  (evt hand hasSubmorphs and:[self dropEnabled]) ifFalse: ["no d&d"
  ^super mouseEnterDragging: evt].
  (self wantsDroppedMorph: evt hand firstSubmorph event: evt )
  ifTrue:[
  aMorph := self itemFromPoint: evt position.
  aMorph ifNotNil:[self potentialDropMorph: aMorph].
  evt hand newMouseFocus: self.
  "above is ugly but necessary for now"
  ].!

Item was changed:
+ ----- Method: Slider>>hResizing (in category 'layout-properties') -----
- ----- Method: Slider>>hResizing (in category 'as yet unclassified') -----
  hResizing
  "Due to possible automatic orientation change on extent changes, we have to calculate the resizing property based on the current orientation. Otherwise, layout will break.There is, however, support for using the resizing property in layout properties if set."
 
  self layoutProperties ifNotNil: [:props |
  ^ props hResizing].
 
  ^ self orientation == #horizontal
  ifTrue: [#spaceFill]
  ifFalse: [#rigid]!

Item was changed:
+ ----- Method: Slider>>vResizing (in category 'layout-properties') -----
- ----- Method: Slider>>vResizing (in category 'as yet unclassified') -----
  vResizing
  "Due to possible automatic orientation change on extent changes, we have to calculate the resizing property based on the current orientation. Otherwise, layout will break. There is, however, support for using the resizing property in layout properties if set."
 
  self layoutProperties ifNotNil: [:props |
  ^ props vResizing].
 
  ^ self orientation == #vertical
  ifTrue: [#spaceFill]
  ifFalse: [#rigid]!

Item was changed:
+ ----- Method: SuperSwikiDirectoryWrapper>>contents (in category 'accessing') -----
- ----- Method: SuperSwikiDirectoryWrapper>>contents (in category 'as yet unclassified') -----
  contents
 
  ^#() "we have no sundirectories"!

Item was changed:
+ ----- Method: SuperSwikiDirectoryWrapper>>hasContents (in category 'testing') -----
- ----- Method: SuperSwikiDirectoryWrapper>>hasContents (in category 'as yet unclassified') -----
  hasContents
 
  ^false "we have no sundirectories"!

Item was changed:
  ----- Method: SystemWindow>>addCloseBox (in category 'initialization') -----
  addCloseBox
  "If I have a labelArea, add a close box to it"
 
  labelArea ifNil: [^ self].
  mustNotClose == true ifTrue: [^ self].
  closeBox ifNotNil: [closeBox delete].
  closeBox := self createCloseBox.
  closeBox layoutFrame: self class closeBoxFrame.
  labelArea addMorphFront: closeBox!

Item was changed:
+ ----- Method: TranslucentProgessMorph>>opaqueBackgroundColor: (in category 'accessing') -----
- ----- Method: TranslucentProgessMorph>>opaqueBackgroundColor: (in category 'as yet unclassified') -----
  opaqueBackgroundColor: aColor
 
  opaqueBackgroundColor := aColor!

Item was changed:
+ ----- Method: TranslucentProgessMorph>>revealingStyle (in category 'accessing') -----
- ----- Method: TranslucentProgessMorph>>revealingStyle (in category 'as yet unclassified') -----
  revealingStyle
 
  ">>>>
  1 = original, no change after 100%
  2 = hold at last 25% and blink until done
  3 = wrap around from 100% back to 0 and go again. change color after first
  <<<<"
  ^3
  !

Item was changed:
+ ----- Method: UpdatingMenuMorph>>activate: (in category 'events') -----
- ----- Method: UpdatingMenuMorph>>activate: (in category 'as yet unclassified') -----
  activate: evt
  "Receiver should be activated; e.g., so that control passes correctly."
 
  self updateMenu.
  super activate: evt!

Item was changed:
+ ----- Method: UpdatingSimpleButtonMorph>>wordingSelector: (in category 'accessing') -----
- ----- Method: UpdatingSimpleButtonMorph>>wordingSelector: (in category 'as yet unclassified') -----
  wordingSelector: aSelector
  wordingSelector := aSelector.
  wordingProvider ifNil: [wordingProvider := target]!

Item was changed:
+ ----- Method: UpdatingThreePhaseButtonMorph>>getSelector: (in category 'accessing') -----
- ----- Method: UpdatingThreePhaseButtonMorph>>getSelector: (in category 'as yet unclassified') -----
  getSelector: sel
  getSelector := sel!

Item was changed:
+ ----- Method: WorldState class>>canSurrenderToOS: (in category 'accessing') -----
- ----- Method: WorldState class>>canSurrenderToOS: (in category 'as yet unclassified') -----
  canSurrenderToOS: aBoolean
 
  CanSurrenderToOS := aBoolean!

Item was changed:
+ ----- Method: WorldState class>>lastCycleTime (in category 'accessing') -----
- ----- Method: WorldState class>>lastCycleTime (in category 'as yet unclassified') -----
  lastCycleTime
 
  ^LastCycleTime!