Packages December 2018

packages@lists.squeakfoundation.org

1 participants
51 discussions

The Trunk: Kernel-eem.1207.mcz
by commits＠source.squeak.org 17 Dec '18

17 Dec '18

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.1207.mcz ==================== Summary ==================== Name: Kernel-eem.1207 Author: eem Time: 17 December 2018, 11:23:23.752801 am UUID: 9a61ba37-2e76-44c3-b674-64788cc1a004 Ancestors: Kernel-pre.1206 Fix a regression introduced in Kernel-eem.1205. doPrimitive:method:receiver:args: must simulate the three argument form of primitive 188 for the system to be able to do Debug It. =============== Diff against Kernel-pre.1206 =============== Item was changed: ----- Method: Context>>doPrimitive:method:receiver:args: (in category 'private') ----- doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. If successful, push result and return resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes execution needs to be intercepted and simulated to avoid execution running away." | value | "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents the debugger from entering various run-away activities such as spawning a new process, etc. Injudicious use results in the debugger not being able to debug interesting code, such as the debugger itself. Hence use primitive 19 with care :-)" "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" primitiveIndex = 19 ifTrue: [ToolSet debugContext: self label:'Code simulation error' contents: nil]. ((primitiveIndex between: 201 and: 222) and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: [(primitiveIndex = 206 or: [primitiveIndex = 208]) ifTrue: "[Full]BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]. ((primitiveIndex between: 201 and: 209) "[Full]BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]]. primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" [^self send: arguments first to: receiver with: arguments allButFirst]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)]. "Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: [| effective | effective := Processor activeProcess effectiveProcess. "active == effective" value := primitiveIndex = 186 ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]]. + primitiveIndex = 188 ifTrue: "Object>>withArgs:executeMethod: + CompiledMethod class>>receiver:withArguments:executeMethod: + VMMirror>>ifFail:object:with:executeMethod: et al" + [| n args methodArg | + ((n := arguments size) between: 2 and: 4) ifFalse: + [^self class primitiveFailTokenFor: #'unsupported operation']. + ((self objectClass: (args := arguments at: n - 1)) == Array + and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse: - primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:" - [| args methodArg | - ((self objectClass: (args := arguments at: 1)) == Array - and: [(self objectClass: (methodArg := arguments at: 2)) includesBehavior: CompiledMethod]) ifFalse: [^self class primitiveFailTokenFor: #'bad argument']. methodArg numArgs = args size ifFalse: [^self class primitiveFailTokenFor: #'bad number of arguments']. methodArg primitive > 0 ifTrue: [methodArg isQuick ifTrue: [^self push: (methodArg valueWithReceiver: receiver arguments: args)]. ^self doPrimitive: methodArg primitive method: meth receiver: receiver args: args]. ^Context sender: self receiver: receiver method: methodArg arguments: args]. primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 3 and: [(self objectClass: arguments second) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifTrue: [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. (arguments size = 2 and: [(self objectClass: arguments first) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^self class primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last]. value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)" [receiver tryPrimitive: primitiveIndex withArgs: arguments]]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]!

1 0

The Trunk: Kernel-pre.1206.mcz
by commits＠source.squeak.org 17 Dec '18

17 Dec '18

Patrick Rein uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-pre.1206.mcz ==================== Summary ==================== Name: Kernel-pre.1206 Author: pre Time: 17 December 2018, 5:45:54.821471 pm UUID: f3ada3b6-9403-49d0-accc-48b9bdc364f5 Ancestors: Kernel-eem.1205 Adds the resolve and reject utility methods to Promise for use cases in which Promises are used as a synchronization means between computations whose side effects we are interested in. (reject was added as another utility method to keep the protocol symmetric to the resolveWith: rejectWith: protocol). =============== Diff against Kernel-eem.1205 =============== Item was added: + ----- Method: Promise>>reject (in category 'resolving') ----- + reject + + self rejectWith: nil! Item was added: + ----- Method: Promise>>resolve (in category 'resolving') ----- + resolve + + self resolveWith: nil!

1 0

The Trunk: MorphicExtras-pre.248.mcz
by commits＠source.squeak.org 17 Dec '18

17 Dec '18

Patrick Rein uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-pre.248.mcz ==================== Summary ==================== Name: MorphicExtras-pre.248 Author: pre Time: 17 December 2018, 5:39:38.046471 pm UUID: 917e33d3-82e3-47b3-9c57-1389697d90d3 Ancestors: MorphicExtras-pre.247 Recategorizes stepTime and wantsSteps to the stepping category. =============== Diff against MorphicExtras-pre.247 =============== Item was changed: + ----- Method: BackgroundMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: BackgroundMorph>>stepTime (in category 'testing') ----- stepTime "Answer the desired time between steps in milliseconds." ^ 20! Item was changed: + ----- Method: BouncingAtomsMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: BouncingAtomsMorph>>stepTime (in category 'testing') ----- stepTime "As fast as possible." ^ 0 ! Item was changed: + ----- Method: ClockMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: ClockMorph>>stepTime (in category 'testing') ----- stepTime "Answer the desired time between steps in milliseconds." ^999! Item was changed: + ----- Method: EnvelopeEditorMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: EnvelopeEditorMorph>>stepTime (in category 'testing') ----- stepTime ^ 100! Item was changed: + ----- Method: EventRecorderMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: EventRecorderMorph>>stepTime (in category 'testing') ----- stepTime ^500 ! Item was changed: + ----- Method: EventRecorderMorph>>wantsSteps (in category 'stepping and presenter') ----- - ----- Method: EventRecorderMorph>>wantsSteps (in category 'testing') ----- wantsSteps ^true ! Item was changed: + ----- Method: Flasher>>stepTime (in category 'stepping and presenter') ----- - ----- Method: Flasher>>stepTime (in category 'testing') ----- stepTime "Answer the desired time between steps, in milliseconds." ^ 500! Item was changed: + ----- Method: FloatingBookControlsMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: FloatingBookControlsMorph>>stepTime (in category 'testing') ----- stepTime ^1000! Item was changed: + ----- Method: FloatingBookControlsMorph>>wantsSteps (in category 'stepping and presenter') ----- - ----- Method: FloatingBookControlsMorph>>wantsSteps (in category 'testing') ----- wantsSteps ^true! Item was changed: + ----- Method: FrameRateMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: FrameRateMorph>>stepTime (in category 'testing') ----- stepTime "Answer the desired time between steps in milliseconds." ^ 0 ! Item was changed: + ----- Method: LedMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: LedMorph>>stepTime (in category 'testing') ----- stepTime ^ 500! Item was changed: + ----- Method: LedTimerMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: LedTimerMorph>>stepTime (in category 'testing') ----- stepTime ^ 1000! Item was changed: + ----- Method: MagnifierMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: MagnifierMorph>>stepTime (in category 'testing') ----- stepTime ^ 100! Item was changed: + ----- Method: MarqueeMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: MarqueeMorph>>stepTime (in category 'testing') ----- stepTime "Answer the desired time between steps in milliseconds." ^ 200! Item was changed: + ----- Method: MarqueeMorph>>wantsSteps (in category 'stepping and presenter') ----- - ----- Method: MarqueeMorph>>wantsSteps (in category 'testing') ----- wantsSteps ^ true! Item was changed: + ----- Method: PianoRollScoreMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: PianoRollScoreMorph>>stepTime (in category 'testing') ----- stepTime ^ 0 ! Item was changed: + ----- Method: ProjectNavigationMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: ProjectNavigationMorph>>stepTime (in category 'testing') ----- stepTime ^1000! Item was changed: + ----- Method: ProjectNavigationMorph>>wantsSteps (in category 'stepping and presenter') ----- - ----- Method: ProjectNavigationMorph>>wantsSteps (in category 'testing') ----- wantsSteps ^true! Item was changed: + ----- Method: RecordingControlsMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: RecordingControlsMorph>>stepTime (in category 'testing') ----- stepTime ^ 50 ! Item was changed: + ----- Method: SoundLoopMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: SoundLoopMorph>>stepTime (in category 'testing') ----- stepTime ^ 50 ! Item was changed: + ----- Method: ThumbnailMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: ThumbnailMorph>>stepTime (in category 'testing') ----- stepTime "Adjust my step time to the time it takes drawing my referent" drawTime ifNil:[^ 250]. ^(objectToView updateThresholdForGraphicInViewerTab * drawTime) max: 250.! Item was changed: + ----- Method: TickIndicatorMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: TickIndicatorMorph>>stepTime (in category 'testing') ----- stepTime ^(stepTime ifNil:[125]) max: 50! Item was changed: + ----- Method: TickIndicatorMorph>>wantsSteps (in category 'stepping and presenter') ----- - ----- Method: TickIndicatorMorph>>wantsSteps (in category 'testing') ----- wantsSteps ^true! Item was changed: + ----- Method: TransitionMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: TransitionMorph>>stepTime (in category 'testing') ----- stepTime ^ stepTime! Item was changed: + ----- Method: UpdatingRectangleMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: UpdatingRectangleMorph>>stepTime (in category 'testing') ----- stepTime ^ 50! Item was changed: + ----- Method: ZASMScriptMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: ZASMScriptMorph>>stepTime (in category 'testing') ----- stepTime ^500! Item was changed: + ----- Method: ZASMScriptMorph>>wantsSteps (in category 'stepping and presenter') ----- - ----- Method: ZASMScriptMorph>>wantsSteps (in category 'testing') ----- wantsSteps ^true! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: ZoomAndScrollControllerMorph>>stepTime (in category 'testing') ----- stepTime ^10 ! Item was changed: + ----- Method: ZoomAndScrollMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: ZoomAndScrollMorph>>stepTime (in category 'testing') ----- stepTime ^10 "ms"!

1 0

The Trunk: Morphic-pre.1470.mcz
by commits＠source.squeak.org 17 Dec '18

17 Dec '18

Patrick Rein uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-pre.1470.mcz ==================== Summary ==================== Name: Morphic-pre.1470 Author: pre Time: 17 December 2018, 5:38:05.024471 pm UUID: a199ad27-6759-4bb9-a744-a6fca5ae30b4 Ancestors: Morphic-pre.1469 Recategorizes stepTime and wantsSteps back to the stepping category. Also changes the category for all subclasses which had it in the testing category. =============== Diff against Morphic-pre.1469 =============== Item was changed: + ----- Method: BalloonMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: BalloonMorph>>stepTime (in category 'testing') ----- stepTime ^ 0 "every cycle"! Item was changed: + ----- Method: ColorPickerMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: ColorPickerMorph>>stepTime (in category 'testing') ----- stepTime ^ 50 ! Item was changed: + ----- Method: DoCommandOnceMorph>>wantsSteps (in category 'stepping and presenter') ----- - ----- Method: DoCommandOnceMorph>>wantsSteps (in category 'testing') ----- wantsSteps ^actionBlock notNil ! Item was changed: + ----- Method: HandleMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: HandleMorph>>stepTime (in category 'testing') ----- stepTime "Update every hundredth of a second." ^ 10 ! Item was changed: + ----- Method: Morph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: Morph>>stepTime (in category 'testing') ----- stepTime "Answer the desired time between steps in milliseconds. This default implementation requests that the 'step' method be called once every second." ^ self topRendererOrSelf player ifNotNil: [10] ifNil: [1000]! Item was changed: + ----- Method: Morph>>wantsSteps (in category 'stepping and presenter') ----- - ----- Method: Morph>>wantsSteps (in category 'testing') ----- wantsSteps "Return true if the receiver overrides the default Morph step method." "Details: Find first class in superclass chain that implements #step and return true if it isn't class Morph." | c | self isPartsDonor ifTrue: [^ false]. (self == self topRendererOrSelf) ifTrue: [self player wantsSteps ifTrue: [^ true]]. c := self class. [c includesSelector: #step] whileFalse: [c := c superclass]. ^ c ~= Morph! Item was changed: + ----- Method: MovieMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: MovieMorph>>stepTime (in category 'testing') ----- stepTime ^ msecsPerFrame ! Item was changed: + ----- Method: PasteUpMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: PasteUpMorph>>stepTime (in category 'testing') ----- stepTime (self isWorldMorph and: [owner notNil]) ifTrue: [ ^1 ]. ^super stepTime! Item was changed: + ----- Method: PolygonMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: PolygonMorph>>stepTime (in category 'testing') ----- stepTime "Answer the desired time between steps in milliseconds." ^ self topRendererOrSelf player ifNotNil: [10] ifNil: [100] "NB: in all currently known cases, polygons are not actually wrapped in TransformationMorphs, so the #topRendererOrSelf call above is probably redundant, but is retained for safety."! Item was changed: + ----- Method: PolygonMorph>>wantsSteps (in category 'stepping and presenter') ----- - ----- Method: PolygonMorph>>wantsSteps (in category 'testing') ----- wantsSteps super wantsSteps ifTrue: [^true]. "For crawling ants effect of dashed line." borderDashSpec ifNil: [^false]. ^borderDashSpec size = 5 and: [(borderDashSpec fifth) > 0]! Item was changed: + ----- Method: ProjectViewMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: ProjectViewMorph>>stepTime (in category 'testing') ----- stepTime ^1000! Item was changed: + ----- Method: ScrollBar>>stepTime (in category 'stepping and presenter') ----- - ----- Method: ScrollBar>>stepTime (in category 'testing') ----- stepTime ^ currentScrollDelay ifNil: [300]! Item was changed: + ----- Method: ScrollBar>>wantsSteps (in category 'stepping and presenter') ----- - ----- Method: ScrollBar>>wantsSteps (in category 'testing') ----- wantsSteps ^self scrollBarAction notNil! Item was changed: + ----- Method: StepMessage>>stepTime (in category 'stepping and presenter') ----- - ----- Method: StepMessage>>stepTime (in category 'testing') ----- stepTime "Return the step time for this message. If nil, the receiver of the message will be asked for its #stepTime." ^stepTime! Item was changed: + ----- Method: ThreePhaseButtonMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: ThreePhaseButtonMorph>>stepTime (in category 'testing') ----- stepTime (self hasProperty: #doesButtonAction) ifTrue:[^1]. ^super stepTime! Item was changed: + ----- Method: ThreePhaseButtonMorph>>wantsSteps (in category 'stepping and presenter') ----- - ----- Method: ThreePhaseButtonMorph>>wantsSteps (in category 'testing') ----- wantsSteps ^(self hasProperty: #doesButtonAction) or:[super wantsSteps]! Item was changed: + ----- Method: TransformationMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: TransformationMorph>>stepTime (in category 'testing') ----- stepTime "Answer the stepTime of my rendered morph if posible" | rendered | rendered := self renderedMorph. rendered = self ifTrue: [^super stepTime]. "Hack to avoid infinite recursion" ^rendered stepTime. ! Item was changed: + ----- Method: UpdatingMenuItemMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: UpdatingMenuItemMorph>>stepTime (in category 'testing') ----- stepTime ^ 1200! Item was changed: + ----- Method: UpdatingSimpleButtonMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: UpdatingSimpleButtonMorph>>stepTime (in category 'testing') ----- stepTime "Answer the desired time between steps in milliseconds. If the receiver has a wordingProvider that may dynamically provide changed wording for the label, step once every 1.5 seconds" ^ wordingProvider ifNotNil: [1500] ifNil: [super stepTime]! Item was changed: + ----- Method: UpdatingSimpleButtonMorph>>wantsSteps (in category 'stepping and presenter') ----- - ----- Method: UpdatingSimpleButtonMorph>>wantsSteps (in category 'testing') ----- wantsSteps "Answer whether the receiver wishes to be sent the #step message. In the current case, this decision depends on whether there is a wordingProvider which can dynamically provide fresh wording for the button's label" ^ wordingProvider notNil! Item was changed: + ----- Method: UpdatingStringMorph>>stepTime (in category 'stepping and presenter') ----- - ----- Method: UpdatingStringMorph>>stepTime (in category 'testing') ----- stepTime ^ stepTime ifNil: [200] ! Item was changed: + ----- Method: UpdatingThreePhaseButtonMorph>>wantsSteps (in category 'stepping and presenter') ----- - ----- Method: UpdatingThreePhaseButtonMorph>>wantsSteps (in category 'testing') ----- wantsSteps ^ true!

1 0

The Trunk: Morphic-pre.1469.mcz
by commits＠source.squeak.org 14 Dec '18

14 Dec '18

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!

1 0

The Trunk: ST80-pre.236.mcz
by commits＠source.squeak.org 13 Dec '18

13 Dec '18

Patrick Rein uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-pre.236.mcz ==================== Summary ==================== Name: ST80-pre.236 Author: pre Time: 13 December 2018, 2:04:37.757468 pm UUID: b4f1dbb4-b2bf-4a03-9929-60c0521e5ef1 Ancestors: ST80-mt.217, ST80-dtl.235 Categorized uncategorized messages in ST80 and moved test methods to tests. =============== Diff against ST80-mt.217 =============== Item was changed: ----- Method: BitEditor>>fileOut (in category 'menu messages') ----- fileOut | fileName | fileName := UIManager default + saveFilenameRequest: 'Save this Form to' translated - request: 'File name?' translated initialAnswer: 'Filename.form'. + fileName ifNil: [^ self]. - fileName isEmpty ifTrue: [^ self]. Cursor normal showWhile: [model writeOnFileNamed: fileName]. ! Item was changed: ----- Method: CharacterBlockScannerForMVC>>crossedX (in category 'stop conditions') ----- crossedX characterIndex == nil ifFalse: [ "If the last character of the last line is a space, and it crosses the right margin, then locating the character block after it is impossible without this hack." + characterIndex > text size ifTrue: [ - characterIndex > text size ifTrue: [Transcript cr; show:'here'. lastIndex := characterIndex. characterPoint := (nextLeftMargin ifNil: [leftMargin]) @ (destY + line lineHeight). ^true]]. ^super crossedX! Item was changed: + ----- Method: ColorSystemView>>displayDeEmphasized (in category 'displaying') ----- - ----- Method: ColorSystemView>>displayDeEmphasized (in category 'as yet unclassified') ----- displayDeEmphasized "Display this view with emphasis off. If windowBits is not nil, then simply BLT if possible." bitsValid ifTrue: [self lock. windowBits displayAt: self windowOrigin] ifFalse: [super displayDeEmphasized] ! Item was changed: ----- Method: ControlManager>>findWindowSatisfying: (in category 'scheduling') ----- findWindowSatisfying: aBlock "Present a menu of window titles, and activate the one that gets chosen" + | sortAlphabetically controllers labels index | - | sortAlphabetically controllers listToUse labels index | sortAlphabetically := Sensor shiftPressed. controllers := OrderedCollection new. scheduledControllers do: [:controller | controller == screenController ifFalse: [(aBlock value: controller) ifTrue: [controllers addLast: controller]]]. controllers size = 0 ifTrue: [^ self]. + sortAlphabetically ifTrue: [controllers sort: [:a :b | a view label < b view label]]. - listToUse := sortAlphabetically - ifTrue: [controllers asSortedCollection: [:a :b | a view label < b view label]] - ifFalse: [controllers]. labels := String streamContents: [:strm | + controllers do: [:controller | strm nextPutAll: (controller view label contractTo: 40); cr]. - listToUse do: [:controller | strm nextPutAll: (controller view label contractTo: 40); cr]. strm skip: -1 "drop last cr"]. index := (UIManager default chooseFrom: labels lines). index > 0 ifTrue: + [self activateController: (controllers at: index)]. - [self activateController: (listToUse at: index)]. ! Item was added: + ----- Method: Debugger class>>context: (in category '*ST80-instance creation') ----- + context: aContext + "Answer an instance of me for debugging the active process starting with the given context." + ^ self new + process: Processor activeProcess + controller: (ScheduledControllers + ifNotNil: [:sc | + "this means we are in an MVC project" + sc inActiveControllerProcess + ifTrue: [ScheduledControllers activeController]]) + context: aContext! Item was removed: - ----- Method: Debugger class>>mvcContext: (in category '*ST80-instance creation') ----- - mvcContext: aContext - "Answer an instance of me for debugging the active process starting with the given context." - - ^ self new - process: Processor activeProcess - controller: (ScheduledControllers inActiveControllerProcess - ifTrue: [ScheduledControllers activeController] - ifFalse: [nil]) - context: aContext! Item was removed: - ----- Method: Debugger class>>mvcOpenContext:label:contents: (in category '*ST80-opening') ----- - mvcOpenContext: aContext label: aString contents: contentsStringOrNil - "Open a notifier in response to an error, halt, or notify. A notifier view just shows a short view of the sender stack and provides a menu that lets the user open a full debugger." - <primitive: 19> "Simulation guard" - ErrorRecursion not & Preferences logDebuggerStackToFile ifTrue: - [Smalltalk logSqueakError: aString inContext: aContext]. - ErrorRecursion ifTrue:[ - ErrorRecursion := false. - self primitiveError: aString]. - ErrorRecursion := true. - self informExistingDebugger: aContext label: aString. - (Debugger mvcContext: aContext) - openNotifierContents: contentsStringOrNil - label: aString. - ErrorRecursion := false. - Processor activeProcess suspend.! Item was removed: - ----- Method: Debugger class>>mvcOpenInterrupt:onProcess: (in category '*ST80-opening') ----- - mvcOpenInterrupt: aString onProcess: interruptedProcess - "Open a notifier in response to an interrupt. An interrupt occurs when the user types the interrupt key (cmd-. on Macs, ctrl-c or alt-. on other systems) or when the low-space watcher detects that memory is low." - | debugger | - <primitive: 19> "Simulation guard" - debugger := self new. - debugger - process: interruptedProcess - controller: (ScheduledControllers activeControllerProcess == interruptedProcess - ifTrue: [ScheduledControllers activeController] - ifFalse: [nil]) - context: interruptedProcess suspendedContext. - debugger externalInterrupt: true. - - Preferences logDebuggerStackToFile ifTrue: - [(aString includesSubstring: 'Space') & (aString includesSubstring: 'low') - ifTrue: [Smalltalk logError: aString inContext: debugger interruptedContext to: 'LowSpaceDebug.log'] - "logging disabled for 4.3 release, see - http://lists.squeak.org/pipermail/squeak-dev/2011-December/162503.html" - "ifFalse: [Smalltalk logSqueakError: aString inContext: debugger interruptedContext]"]. - - ^debugger - openNotifierContents: nil label: aString; - yourself - ! Item was changed: ----- Method: FormEditor>>fileInForm (in category 'editing tools') ----- fileInForm "Ask the user for a file name and then recalls the Form in that file as the current source Form (form). Does not change the tool." | fileName | fileName := UIManager default + chooseFileMatchingSuffixes: #('form') + label: 'File name?' translated. + fileName ifNil: [^ self]. - request: 'File name?' translated - initialAnswer: 'Filename.form'. - fileName isEmpty ifTrue: [^ self]. form := Form fromFileNamed: fileName. tool := previousTool. ! Item was changed: ----- Method: FormEditor>>fileOut (in category 'menu messages') ----- fileOut | fileName | fileName := UIManager default + saveFilenameRequest: 'File name?' translated - request: 'File name?' translated initialAnswer: 'Filename.form'. + fileName ifNil: [^ self]. - fileName isEmpty ifTrue: [^ self]. Cursor normal showWhile: [model writeOnFileNamed: fileName]. ! Item was changed: ----- Method: FormEditor>>fileOutForm (in category 'editing tools') ----- fileOutForm "Ask the user for a file name and save the current source form under that name. Does not change the tool." | fileName | fileName := UIManager default + saveFilenameRequest: 'File name?' translated - request: 'File name?' translated initialAnswer: 'Filename.form'. + fileName ifNil: [^ self]. - fileName isEmpty ifTrue: [^ self]. Cursor normal showWhile: [form writeOnFileNamed: fileName]. tool := previousTool. ! Item was changed: + ----- Method: FormInspectView>>defaultControllerClass (in category 'controller access') ----- - ----- Method: FormInspectView>>defaultControllerClass (in category 'as yet unclassified') ----- defaultControllerClass "Refer to the comment in View|defaultControllerClass." ^ NoController! Item was changed: + ----- Method: FormInspectView>>displayView (in category 'displaying') ----- - ----- Method: FormInspectView>>displayView (in category 'as yet unclassified') ----- displayView "Display the form as a value in an inspector. 8/11/96 sw" "Defeated form scaling for HS FormInspector. 8/20/96 di" | scale | Display fill: self insetDisplayBox fillColor: Color white. model selectionIndex = 0 ifTrue: [^ self]. scale := self insetDisplayBox extent / model selection extent. scale := (scale x min: scale y) min: 1. model selection displayOn: Display transformation: (WindowingTransformation scale: scale asPoint translation: self insetDisplayBox topLeft - model selection offset) clippingBox: self insetDisplayBox rule: self rule fillColor: self fillColor! Item was changed: + ----- Method: MVCProject>>addProject: (in category 'sub-projects & hierarchy') ----- - ----- Method: MVCProject>>addProject: (in category 'as yet unclassified') ----- addProject: project | view | super addProject: project. view := ProjectView new model: project; minimumSize: 50@30; borderWidth: 2; resizeInitially; yourself. view controller status: #open.! Item was changed: ----- Method: MVCProject>>jumpToProject (in category 'utilities') ----- jumpToProject + "Present a list of potential projects and enter the one selected. + We use mvcStartUpLeftFlush for possibly no longer valid historical reasons" - "Present a list of potential projects and enter the one selected." "Project current jumpToProject" + self jumpToSelection: (self buildJumpToMenu: CustomMenu new) mvcStartUpLeftFlush! - self jumpToSelection: (self buildJumpToMenu: CustomMenu new) startUpLeftFlush! Item was removed: - ----- Method: MVCProject>>selectorPrefixForDispatch (in category 'dispatching') ----- - selectorPrefixForDispatch - "A string to be prepended to selectors for project specific methods" - - ^ 'mvc'! Item was changed: ----- Method: MVCProject>>storeSegment (in category 'file in/out') ----- storeSegment "Store my project out on the disk as an ImageSegment. Keep the outPointers in memory. Name it <project name>.seg. *** Caller must be holding (Project alInstances) to keep subprojects from going out. ***" + (Project current world == world) ifTrue: [^ false]. - (World == world) ifTrue: [^ false]. "self inform: 'Can''t send the current world out'." world isInMemory ifFalse: [^ false]. "already done" self projectParameters at: #isMVC put: true. ^ false "Only Morphic projects for now" ! Item was changed: ----- Method: MVCProject>>storeSegmentNoFile (in category 'file in/out') ----- storeSegmentNoFile "For testing. Make an ImageSegment. Keep the outPointers in memory. Also useful if you want to enumerate the objects in the segment afterwards (allObjectsDo:)" + (Project current world == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'." - (World == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'." world isInMemory ifFalse: [^ self]. "already done" self projectParameters at: #isMVC put: true. ^ self "Only Morphic projects for now" ! Item was removed: - ----- Method: MailComposition>>mvcOpen (in category '*ST80-Support') ----- - mvcOpen - | textView sendButton | - - mvcWindow := StandardSystemView new - label: 'Mister Postman'; - minimumSize: 400@250; - model: self. - - textView := PluggableTextView - on: self - text: #messageText - accept: #messageText:. - textEditor := textView controller. - - sendButton := PluggableButtonView - on: self - getState: nil - action: #submit. - sendButton label: 'Send'. - sendButton borderWidth: 1. - - sendButton window: (1@1 extent: 398@38). - mvcWindow addSubView: sendButton. - - textView window: (0@40 corner: 400@250). - mvcWindow addSubView: textView below: sendButton. - - mvcWindow controller open. - - - ! Item was changed: + ----- Method: ModalController>>close (in category 'scheduling') ----- - ----- Method: ModalController>>close (in category 'as yet unclassified') ----- close "This is how we leave the mode." modeActive := false. ! Item was changed: + ----- Method: ModalController>>closeAndUnscheduleNoTerminate (in category 'scheduling') ----- - ----- Method: ModalController>>closeAndUnscheduleNoTerminate (in category 'as yet unclassified') ----- closeAndUnscheduleNoTerminate "Erase the receiver's view and remove it from the collection of scheduled views, but do not terminate the current process." ScheduledControllers unschedule: self. view erase. view release.! Item was changed: + ----- Method: ModalController>>controlInitialize (in category 'basic control sequence') ----- - ----- Method: ModalController>>controlInitialize (in category 'as yet unclassified') ----- controlInitialize modeActive := true. ^ super controlInitialize ! Item was changed: + ----- Method: ModalController>>isControlActive (in category 'control defaults') ----- - ----- Method: ModalController>>isControlActive (in category 'as yet unclassified') ----- isControlActive ^ modeActive ! Item was changed: + ----- Method: ModalController>>isControlWanted (in category 'control defaults') ----- - ----- Method: ModalController>>isControlWanted (in category 'as yet unclassified') ----- isControlWanted ^ modeActive ! Item was changed: ----- Method: Paragraph>>hiliteRect: (in category 'selecting') ----- hiliteRect: rect - | highlightColor | - highlightColor := Color quickHighLight: destinationForm depth. rect ifNotNil: [ + | highlightColor | + highlightColor := Color quickHighLight: destinationForm depth. destinationForm fill: rect rule: Form reverse + fillColor: highlightColor]. - fillColor: highlightColor. - "destinationForm - fill: (rect translateBy: 1@1) - rule: Form reverse - fillColor: highlightColor" ]. ! Item was changed: ----- Method: Paragraph>>reverseFrom:to: (in category 'selecting') ----- reverseFrom: characterBlock1 to: characterBlock2 "Reverse area between the two character blocks given as arguments." | visibleRectangle initialRectangle interiorRectangle finalRectangle lineNo baseline caret | characterBlock1 = characterBlock2 ifTrue: [lineNo := self lineIndexOfCharacterIndex: characterBlock1 stringIndex. baseline := lineNo = 0 ifTrue: [textStyle baseline] ifFalse: [(lines at: lineNo) baseline]. caret := self caretFormForDepth: Display depth. ^ caret "Use a caret to indicate null selection" displayOn: destinationForm at: characterBlock1 topLeft + (-3 @ baseline) clippingBox: clippingRectangle rule: (false "Display depth>8" ifTrue: [9 "not-reverse"] ifFalse: [Form reverse]) fillColor: nil]. visibleRectangle := (clippingRectangle intersect: compositionRectangle) "intersect: destinationForm boundingBox" "not necessary". characterBlock1 top = characterBlock2 top ifTrue: [characterBlock1 left < characterBlock2 left ifTrue: [initialRectangle := (characterBlock1 topLeft corner: characterBlock2 bottomLeft) intersect: visibleRectangle] ifFalse: [initialRectangle := (characterBlock2 topLeft corner: characterBlock1 bottomLeft) intersect: visibleRectangle]] ifFalse: [characterBlock1 top < characterBlock2 top + ifTrue: + [initialRectangle := + (characterBlock1 topLeft + corner: visibleRectangle right @ characterBlock1 bottom) + intersect: visibleRectangle. + finalRectangle := + (visibleRectangle left @ characterBlock2 top + corner: characterBlock2 bottomLeft) + intersect: visibleRectangle. + characterBlock1 bottom = characterBlock2 top + ifFalse: + [interiorRectangle := + (visibleRectangle left @ characterBlock1 bottom + corner: visibleRectangle right @ characterBlock2 top) + intersect: visibleRectangle]] - ifTrue: - [initialRectangle := - (characterBlock1 topLeft - corner: visibleRectangle right @ characterBlock1 bottom) - intersect: visibleRectangle. - characterBlock1 bottom = characterBlock2 top - ifTrue: - [finalRectangle := - (visibleRectangle left @ characterBlock2 top - corner: characterBlock2 bottomLeft) - intersect: visibleRectangle] - ifFalse: - [interiorRectangle := - (visibleRectangle left @ characterBlock1 bottom - corner: visibleRectangle right - @ characterBlock2 top) - intersect: visibleRectangle. - finalRectangle := - (visibleRectangle left @ characterBlock2 top - corner: characterBlock2 bottomLeft) - intersect: visibleRectangle]] ifFalse: [initialRectangle := (visibleRectangle left @ characterBlock1 top corner: characterBlock1 bottomLeft) intersect: visibleRectangle. + finalRectangle := + (characterBlock2 topLeft + corner: visibleRectangle right @ characterBlock2 bottom) + intersect: visibleRectangle. characterBlock1 top = characterBlock2 bottom - ifTrue: - [finalRectangle := - (characterBlock2 topLeft - corner: visibleRectangle right - @ characterBlock2 bottom) - intersect: visibleRectangle] ifFalse: [interiorRectangle := (visibleRectangle left @ characterBlock2 bottom corner: visibleRectangle right @ characterBlock1 top) - intersect: visibleRectangle. - finalRectangle := - (characterBlock2 topLeft - corner: visibleRectangle right - @ characterBlock2 bottom) intersect: visibleRectangle]]]. self hiliteRect: initialRectangle. self hiliteRect: interiorRectangle. self hiliteRect: finalRectangle.! Item was changed: ----- Method: ParagraphEditor>>browseClassFromIt (in category 'menu messages') ----- browseClassFromIt "Launch a browser for the class indicated by the current selection. If multiple classes matching the selection exist, let the user choose among them." | aClass | + + self lineSelectAndEmptyCheck: [^ self]. - self - lineSelectAndEmptyCheck: [^ self]. aClass := UIManager default classFromPattern: self selection string withCaption: 'choose a class to browse...'. + aClass ifNil: [^ view flash]. + self terminateAndInitializeAround: + [self systemNavigation browseClass: aClass].! - aClass - ifNil: [^ view flash]. - self - terminateAndInitializeAround: - [| aBrow | - aBrow := SystemBrowser default new. - aBrow setClass: aClass selector: nil. - aBrow class - openBrowserView: (aBrow openEditString: nil) label: 'System Browser'].! Item was changed: ----- Method: ParagraphEditor>>browseIt (in category 'menu messages') ----- browseIt "Launch a browser for the current selection, if appropriate" | aSymbol | self flag: #yoCharCases. Preferences alternativeBrowseIt ifTrue: [^ self browseClassFromIt]. self lineSelectAndEmptyCheck: [^ self]. (aSymbol := self selectedSymbol) isNil ifTrue: [^ view flash]. self terminateAndInitializeAround: [aSymbol first isUppercase + ifTrue: [| anEntry | + anEntry := (Smalltalk at: aSymbol + ifAbsent: [ self systemNavigation browseAllImplementorsOf: aSymbol. - ifTrue: - [| anEntry | - anEntry := (Smalltalk - at: aSymbol - ifAbsent: - [ self systemNavigation browseAllImplementorsOf: aSymbol. ^ nil]). anEntry isNil ifTrue: [^ view flash]. (anEntry isBehavior or: [ anEntry isTrait ]) ifFalse: [ anEntry := anEntry class ]. + self systemNavigation browseClass: anEntry. + ] ifFalse:[ self systemNavigation browseAllImplementorsOf: aSymbol]]! - ToolSet browse: anEntry selector: nil. - ] ifFalse:[ self systemNavigation browseAllImplementorsOf: aSymbol]]! Item was changed: ----- Method: ParagraphEditor>>cursorHome: (in category 'nonediting/nontyping keys') ----- cursorHome: characterStream "Private - Move cursor from position in current line to beginning of current line. If control key is pressed put cursor at beginning of text" | string | string := paragraph text string. self moveCursor: [ :position | Preferences wordStyleCursorMovement ifTrue:[ (paragraph lines at:(paragraph lineIndexOfCharacterIndex: position)) first] ifFalse:[ (string lastIndexOfAnyOf: CharacterSet crlf + startingAt: position - 1) + 1]] - startingAt: position - 1 - ifAbsent:[0]) + 1]] forward: false specialBlock: [:dummy | 1]. ^true! Item was changed: ----- Method: ParagraphEditor>>encompassLine: (in category 'new selection') ----- encompassLine: anInterval "Return an interval that encompasses the entire line" | string left right | string := paragraph text string. + left := (string lastIndexOfAnyOf: CharacterSet crlf startingAt: anInterval first - 1) + 1. - left := (string lastIndexOfAnyOf: CharacterSet crlf startingAt: anInterval first - 1 ifAbsent:[0]) + 1. right := (string indexOfAnyOf: CharacterSet crlf startingAt: anInterval last + 1 ifAbsent: [string size + 1]) - 1. ^left to: right! Item was changed: ----- Method: ParagraphEditor>>explainChar: (in category 'explain') ----- explainChar: string "Does string start with a special character?" | char | char := string at: 1. char = $. ifTrue: [^'"Period marks the end of a Smalltalk statement. A period in the middle of a number means a decimal point. (The number is an instance of class Float)."']. char = $' ifTrue: [^'"The characters between two single quotes are made into an instance of class String"']. char = $" ifTrue: [^'"Double quotes enclose a comment. Smalltalk ignores everything between double quotes."']. char = $# ifTrue: [^'"The characters following a hash mark are made into an instance of class Symbol. If parenthesis follow a hash mark, an instance of class Array is made. It contains literal constants."']. (char = $( or: [char = $)]) ifTrue: [^'"Expressions enclosed in parenthesis are evaluated first"']. + (char = $[ or: [char = $]]) ifTrue: [^'"The code inside square brackets is an unevaluated block of code. It becomes an instance of BlockClosure and is usually passed as an argument."']. - (char = $[ or: [char = $]]) ifTrue: [^'"The code inside square brackets is an unevaluated block of code. It becomes an instance of BlockContext and is usually passed as an argument."']. (char = ${ or: [char = $}]) ifTrue: [^ '"A sequence of expressions separated by periods, when enclosed in curly braces, are evaluated to yield the elements of a new Array"']. (char = $< or: [char = $>]) ifTrue: [^'"<primitive: xx> means that this method is usually preformed directly by the virtual machine. If this method is primitive, its Smalltalk code is executed only when the primitive fails."']. char = $^ ifTrue: [^'"Uparrow means return from this method. The value returned is the expression following the ^"']. char = $| ifTrue: [^'"Vertical bars enclose the names of the temporary variables used in this method. In a block, the vertical bar separates the argument names from the rest of the code."']. char = $_ ifTrue: [^'"Left arrow means assignment. The value of the expression after the left arrow is stored into the variable before it."']. char = $; ifTrue: [^'"Semicolon means cascading. The message after the semicolon is sent to the same object which received the message before the semicolon."']. char = $: ifTrue: [^'"A colon at the end of a keyword means that an argument is expected to follow. Methods which take more than one argument have selectors with more than one keyword. (One keyword, ending with a colon, appears before each argument).', '\\' withCRs, 'A colon before a variable name just inside a block means that the block takes an agrument. (When the block is evaluated, the argument will be assigned to the variable whose name appears after the colon)."']. char = $$ ifTrue: [^'"The single character following a dollar sign is made into an instance of class Character"']. char = $- ifTrue: [^'"A minus sign in front of a number means a negative number."']. char = $e ifTrue: [^'"An e in the middle of a number means that the exponent follows."']. char = $r ifTrue: [^'"An r in the middle of a bunch of digits is an instance of Integer expressed in a certain radix. The digits before the r denote the base and the digits after it express a number in that base."']. char = Character space ifTrue: [^'"the space Character"']. char = Character tab ifTrue: [^'"the tab Character"']. char = Character cr ifTrue: [^'"the carriage return Character"']. char = Character lf ifTrue: [^'"the line feed Character"']. ^nil! Item was changed: ----- Method: ParagraphEditor>>explainCtxt: (in category 'explain') ----- explainCtxt: symbol "Is symbol a context variable?" | reply classes text cls | symbol = #nil ifTrue: [reply := '"is a constant. It is the only instance of class UndefinedObject. nil is the initial value of all variables."']. symbol = #true ifTrue: [reply := '"is a constant. It is the only instance of class True and is the receiver of many control messages."']. symbol = #false ifTrue: [reply := '"is a constant. It is the only instance of class False and is the receiver of many control messages."']. + symbol = #thisContext ifTrue: [reply := '"is a context variable. Its value is always the Context which is executing this method."']. - symbol = #thisContext ifTrue: [reply := '"is a context variable. Its value is always the MethodContext which is executing this method."']. (model respondsTo: #selectedClassOrMetaClass) ifTrue: [ cls := model selectedClassOrMetaClass]. cls ifNil: [^ reply]. "no class known" symbol = #self ifTrue: [classes := cls withAllSubclasses. classes size > 12 ifTrue: [text := cls printString , ' or a subclass'] ifFalse: [classes := classes printString. text := 'one of these classes' , (classes copyFrom: 4 to: classes size)]. reply := '"is the receiver of this message; an instance of ' , text , '"']. symbol = #super ifTrue: [reply := '"is just like self. Messages to super are looked up in the superclass (' , cls superclass printString , ')"']. ^reply! Item was changed: ----- Method: ParagraphEditor>>inOutdent:delta: (in category 'editing keys') ----- inOutdent: characterStream delta: delta "Add/remove a tab at the front of every line occupied by the selection. Flushes typeahead. Derived from work by Larry Tesler back in December 1985. Now triggered by Cmd-L and Cmd-R. 2/29/96 sw" + | realStart realStop lines startLine stopLine start stop adjustStart "indentation" numLines oldText newText newSize | - | realStart realStop lines startLine stopLine start stop adjustStart indentation numLines oldString newString newSize | sensor keyboard. "Flush typeahead" "Operate on entire lines, but remember the real selection for re-highlighting later" realStart := self startIndex. realStop := self stopIndex - 1. "Special case a caret on a line of its own, including weird case at end of paragraph" (realStart > realStop and: [realStart < 2 or: [(paragraph string at: realStart - 1) == Character cr or: [(paragraph string at: realStart - 1) == Character lf]]]) ifTrue: [delta < 0 ifTrue: [view flash] ifFalse: [self replaceSelectionWith: Character tab asSymbol asText. self selectAt: realStart + 1]. ^true]. lines := paragraph lines. startLine := paragraph lineIndexOfCharacterIndex: realStart. "start on a real line, not a wrapped line" [startLine = 1 or: [CharacterSet crlf includes: (paragraph string at: (lines at: startLine-1) last)]] whileFalse: [startLine := startLine - 1]. stopLine := paragraph lineIndexOfCharacterIndex: (realStart max: realStop). start := (lines at: startLine) first. stop := (lines at: stopLine) last. "Pin the start of highlighting unless the selection starts a line" adjustStart := realStart > start. "Find the indentation of the least-indented non-blank line; never outdent more" + "indentation := (startLine to: stopLine) inject: 1000 into: - indentation := (startLine to: stopLine) inject: 1000 into: [:m :l | m min: (paragraph indentationOfLineIndex: l ifBlank: [:tabs | 1000])]. + indentation + delta <= 0 ifTrue: [^false]." - indentation + delta <= 0 ifTrue: ["^false"]. numLines := stopLine + 1 - startLine. + oldText := paragraph text copyFrom: start to: stop. + newText := oldText species new: oldText size + ((numLines * delta) max: 0). + - oldString := paragraph string copyFrom: start to: stop. - newString := oldString species new: oldString size + ((numLines * delta) max: 0). - "Do the actual work" newSize := 0. delta > 0 ifTrue: [| tabs | + tabs := oldText species new: delta withAll: Character tab. + oldText string lineIndicesDo: [:startL :endWithoutDelimiters :endL | + startL < endWithoutDelimiters ifTrue: [newText replaceFrom: 1 + newSize to: (newSize := newSize + delta) with: tabs startingAt: 1]. + newText replaceFrom: 1 + newSize to: (newSize := 1 + newSize + endL - startL) with: oldText startingAt: startL]] - tabs := oldString species new: delta withAll: Character tab. - oldString lineIndicesDo: [:startL :endWithoutDelimiters :endL | - startL < endWithoutDelimiters ifTrue: [newString replaceFrom: 1 + newSize to: (newSize := newSize + delta) with: tabs startingAt: 1]. - newString replaceFrom: 1 + newSize to: (newSize := 1 + newSize + endL - startL) with: oldString startingAt: startL]] ifFalse: [| tab | tab := Character tab. + oldText string lineIndicesDo: [:startL :endWithoutDelimiters :endL | - oldString lineIndicesDo: [:startL :endWithoutDelimiters :endL | | i | i := 0. + [i + delta < 0 and: [ i + startL <= endWithoutDelimiters and: [(oldText at: i + startL) == tab]]] whileTrue: [i := i + 1]. + newText replaceFrom: 1 + newSize to: (newSize := 1 + newSize + endL - (i + startL)) with: oldText startingAt: i + startL]]. + newSize < newText size ifTrue: [newText := newText copyFrom: 1 to: newSize]. - [i + delta < 0 and: [ i + startL <= endWithoutDelimiters and: [(oldString at: i + startL) == tab]]] whileTrue: [i := i + 1]. - newString replaceFrom: 1 + newSize to: (newSize := 1 + newSize + endL - (i + startL)) with: oldString startingAt: i + startL]]. - newSize < newString size ifTrue: [newString := newString copyFrom: 1 to: newSize]. "Adjust the range that will be highlighted later" adjustStart ifTrue: [realStart := (realStart + delta) max: start]. + realStop := realStop + newSize - oldText size. - realStop := realStop + newSize - oldString size. "Replace selection" self selectInvisiblyFrom: start to: stop. + self replaceSelectionWith: newText. - self replaceSelectionWith: newString asText. self selectFrom: realStart to: realStop. "highlight only the original range" ^ true! Item was changed: + ----- Method: ParagraphEditor>>offerMenuFromEsc: (in category 'menu messages') ----- - ----- Method: ParagraphEditor>>offerMenuFromEsc: (in category 'as yet unclassified') ----- offerMenuFromEsc: aStream sensor keyboard. " consume the character " self yellowButtonActivity. ^true "tell the caller that the character was processed "! Item was changed: ----- Method: ParagraphEditor>>saveContentsInFile (in category 'menu messages') ----- saveContentsInFile "Save the receiver's contents string to a file, prompting the user for a file-name. Suggest a reasonable file-name." | fileName stringToSave parentWindow labelToUse suggestedName | stringToSave := paragraph text string. stringToSave size = 0 ifTrue: [^ self inform: 'nothing to save.']. parentWindow := self model dependents detect: [:dep | dep isKindOf: SystemWindow orOf: StandardSystemView] ifNone: [nil]. labelToUse := parentWindow ifNil: ['Untitled'] ifNotNil: [parentWindow label]. suggestedName := nil. #(('Decompressed contents of: ' '.gz')) do: "can add more here..." [:leaderTrailer | | lastIndex | (labelToUse beginsWith: leaderTrailer first) ifTrue: [suggestedName := labelToUse copyFrom: leaderTrailer first size + 1 to: labelToUse size. (labelToUse endsWith: leaderTrailer last) ifTrue: [suggestedName := suggestedName copyFrom: 1 to: suggestedName size - leaderTrailer last size] ifFalse: + [lastIndex := suggestedName lastIndexOf: $.. + (lastIndex > 1) ifTrue: - [lastIndex := suggestedName lastIndexOf: $. ifAbsent: [0]. - (lastIndex = 0 or: [lastIndex = 1]) ifFalse: [suggestedName := suggestedName copyFrom: 1 to: lastIndex - 1]]]]. suggestedName ifNil: [suggestedName := labelToUse, '.text']. + fileName := UIManager default saveFilenameRequest: 'File name?' translated - fileName := UIManager default request: 'File name?' translated initialAnswer: suggestedName. fileName isEmptyOrNil ifFalse: [(FileStream newFileNamed: fileName) nextPutAll: stringToSave; close]! Item was changed: ----- Method: ParagraphEditor>>sendContentsToPrinter (in category 'menu messages') ----- sendContentsToPrinter | textToPrint printer parentWindow | textToPrint := paragraph text. + textToPrint size == 0 ifTrue: [^self inform: 'nothing to print.' translated]. - textToPrint size = 0 ifTrue: [^self inform: 'nothing to print.']. printer := TextPrinter defaultTextPrinter. parentWindow := self model dependents detect: [:dep | dep isSystemWindow] ifNone: [nil]. parentWindow isNil ifTrue: [printer documentTitle: 'Untitled'] ifFalse: [printer documentTitle: parentWindow label]. printer printText: textToPrint! Item was changed: + ----- Method: ParagraphEditor>>totalTextHeight (in category 'accessing') ----- - ----- Method: ParagraphEditor>>totalTextHeight (in category 'as yet unclassified') ----- totalTextHeight ^paragraph boundingBox height! Item was changed: + ----- Method: ParagraphEditor>>visibleHeight (in category 'accessing') ----- - ----- Method: ParagraphEditor>>visibleHeight (in category 'as yet unclassified') ----- visibleHeight ^paragraph clippingRectangle height! Item was changed: ----- Method: PluggableButtonView>>label: (in category 'accessing') ----- label: aStringOrDisplayObject "Label this button with the given String or DisplayObject." + | fontToUse | + fontToUse := self userInterfaceTheme font ifNil: [TextStyle defaultFont]. ((aStringOrDisplayObject isKindOf: Paragraph) or: [aStringOrDisplayObject isForm]) ifTrue: [label := aStringOrDisplayObject] + ifFalse: [label := (Paragraph withText: (aStringOrDisplayObject asText + addAttribute: (TextFontReference toFont: fontToUse)))]. - ifFalse: [label := aStringOrDisplayObject asParagraph]. self centerLabel. ! Item was changed: + ----- Method: PluggableFileListView>>acceptButtonView: (in category 'accessing') ----- - ----- Method: PluggableFileListView>>acceptButtonView: (in category 'as yet unclassified') ----- acceptButtonView: aView ^acceptButtonView := aView! Item was changed: + ----- Method: PluggableFileListView>>label: (in category 'label access') ----- - ----- Method: PluggableFileListView>>label: (in category 'as yet unclassified') ----- label: aString super label: aString. self noLabel! Item was changed: + ----- Method: PluggableFileListView>>update: (in category 'model access') ----- - ----- Method: PluggableFileListView>>update: (in category 'as yet unclassified') ----- update: aSymbol (aSymbol = #volumeListIndex or: [aSymbol = #fileListIndex]) ifTrue: [self updateAcceptButton]. ^super update: aSymbol! Item was changed: + ----- Method: PluggableFileListView>>updateAcceptButton (in category 'private') ----- - ----- Method: PluggableFileListView>>updateAcceptButton (in category 'as yet unclassified') ----- updateAcceptButton self model canAccept ifTrue: [acceptButtonView backgroundColor: Color green; borderWidth: 3; controller: acceptButtonView defaultController] ifFalse: [acceptButtonView backgroundColor: Color lightYellow; borderWidth: 1; controller: NoController new]. acceptButtonView display.! Item was changed: + ----- Method: PluggableListViewByItem>>changeModelSelection: (in category 'model access') ----- - ----- Method: PluggableListViewByItem>>changeModelSelection: (in category 'as yet unclassified') ----- changeModelSelection: anInteger "Change the model's selected item to be the one at the given index." | item | setSelectionSelector ifNotNil: [ item := (anInteger = 0 ifTrue: [nil] ifFalse: [itemList at: anInteger]). model perform: setSelectionSelector with: item]. ! Item was changed: + ----- Method: PluggableListViewByItem>>getCurrentSelectionIndex (in category 'model access') ----- - ----- Method: PluggableListViewByItem>>getCurrentSelectionIndex (in category 'as yet unclassified') ----- getCurrentSelectionIndex "Answer the index of the current selection." | item | getSelectionSelector == nil ifTrue: [^ 0]. item := model perform: getSelectionSelector. ^ itemList findFirst: [ :x | x = item] ! Item was changed: + ----- Method: PluggableListViewByItem>>getList (in category 'model access') ----- - ----- Method: PluggableListViewByItem>>getList (in category 'as yet unclassified') ----- getList "Ensure that there are only strings in that list." ^ super getList collect: [:ea | ea asString]! Item was changed: + ----- Method: PluggableListViewByItem>>list: (in category 'initialization') ----- - ----- Method: PluggableListViewByItem>>list: (in category 'as yet unclassified') ----- list: arrayOfStrings "Set the receivers items to be the given list of strings." "Note: the instance variable 'items' holds the original list. The instance variable 'list' is a paragraph constructed from this list." itemList := arrayOfStrings. isEmpty := arrayOfStrings isEmpty. "add top and bottom delimiters" list := ListParagraph withArray: (Array streamContents: [:s | s nextPut: topDelimiter. arrayOfStrings do: [:item | item == nil ifFalse: [s nextPut: item]]. s nextPut: bottomDelimiter]) style: self assuredTextStyle. selection := self getCurrentSelectionIndex. self positionList.! Item was changed: + ----- Method: PluggableTextController>>accept (in category 'menu messages') ----- - ----- Method: PluggableTextController>>accept (in category 'as yet unclassified') ----- accept view hasUnacceptedEdits ifFalse: [^ view flash]. view hasEditingConflicts ifTrue: [(self confirm: 'Caution!! This method may have been changed elsewhere since you started editing it here. Accept anyway?' translated) ifFalse: [^ self flash]]. (view setText: paragraph text from: self) == true ifTrue: [initialText := paragraph text copy. view ifNotNil: [view hasUnacceptedEdits: false]] . ! Item was changed: + ----- Method: PluggableTextController>>userHasEdited (in category 'edit flag') ----- - ----- Method: PluggableTextController>>userHasEdited (in category 'as yet unclassified') ----- userHasEdited "Note that the user has edited my text." view hasUnacceptedEdits: true! Item was changed: + ----- Method: PluggableTextController>>userHasNotEdited (in category 'edit flag') ----- - ----- Method: PluggableTextController>>userHasNotEdited (in category 'as yet unclassified') ----- userHasNotEdited "Note that my text is free of user edits." view hasUnacceptedEdits: false! Item was changed: + ----- Method: ProjectView class>>open: (in category 'opening') ----- - ----- Method: ProjectView class>>open: (in category 'as yet unclassified') ----- open: aProject "Answer an instance of me for the argument, aProject. It is created on the display screen." | topView | topView := self new model: aProject. topView minimumSize: 50 @ 30. topView borderWidth: 2. topView controller open! Item was changed: + ----- Method: ProjectView class>>openAndEnter: (in category 'opening') ----- - ----- Method: ProjectView class>>openAndEnter: (in category 'as yet unclassified') ----- openAndEnter: aProject "Answer an instance of me for the argument, aProject. It is created on the display screen." | topView | topView := self new model: aProject. topView minimumSize: 50 @ 30. topView borderWidth: 2. topView window: (RealEstateAgent initialFrameFor: topView world: nil). ScheduledControllers schedulePassive: topView controller. aProject enter: false revert: false saveForRevert: false! Item was changed: + ----- Method: ReadOnlyTextController>>accept (in category 'menu messages') ----- - ----- Method: ReadOnlyTextController>>accept (in category 'as yet unclassified') ----- accept "Overridden to allow accept of clean text" (view setText: paragraph text from: self) ifTrue: [initialText := paragraph text copy. view ifNotNil: [view hasUnacceptedEdits: false]]. ! Item was changed: + ----- Method: ReadOnlyTextController>>userHasEdited (in category 'edit flag') ----- - ----- Method: ReadOnlyTextController>>userHasEdited (in category 'as yet unclassified') ----- userHasEdited "Ignore this -- I stay clean"! Item was changed: + ----- Method: ReadOnlyTextController>>zapSelectionWith: (in category 'private') ----- - ----- Method: ReadOnlyTextController>>zapSelectionWith: (in category 'as yet unclassified') ----- zapSelectionWith: aText view flash "no edits allowed"! Item was changed: TestCase subclass: #ST80MenusTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ST80-Menus-Tests'! + !ST80MenusTest commentStamp: 'eem 3/30/2017 17:33' prior: 0! - !ST80MenusTest commentStamp: 'tlk 5/2/2006 22:41' prior: 0! I am an SUnit Test of PopUpMenu and FillInTheBlank. The original motivation for my creation was the regression of functionality associated with allowing the non-interactive testing of these menus. My fixtures are: None NOTES ABOUT AUTOMATING USER INPUTS (See MethodContextTest also for a discussion of this functionality.) When executing non-interactive programs you will inevitably run into programs that require user input during their execution and these sort of problems shoot the whole non-interactiveness of your enclosing program. This is particularly true in doing Sunit tests. + PopUpMenu and FillInTheBlankMorph were modified to first signal a ProvideAnswerNotification and if someone handles that (e.g. the enclosing block) then the user interaction will be avoided and a answer provided by an array will be used instead. PopUpMenu and FillInTheBlankMorph take advantage of BlockClosure helper methods have been made available and tests of these helpers are provided in this class to demonstrate that it can intercept requests for user interaction. Of course, - PopUpMenu and FillInTheBlankMorph were modified to first signal a ProvideAnswerNotification and if someone handles that (e.g. the enclosing block) then the user interaction will be avoided and a answer provided by an array will be used instead. PopUpMenu and FillInTheBlankMorph take advantage of BlockContext helper methods have been made available and tests of these helpers are provided in this class to demonstrate that it can intercept requests for user interaction. Of course, The basic syntax looks like: [self confirm: 'Install spyware?'] valueSupplyingAnswer: #('Install spyware?' false) There a few variants on this theme making it easy to provide a literal list of answers for the block so that you can handle a bunch of questions in a block with appropriate answers. Additionally, it is possible to suppress Object>>inform: modal dialog boxes as these get in the way of automating anything. After applying this changeset you should be able to tryout the following code snippets to see the variants on this theme that are available. Examples: So you don't need any introduction here -- this one works like usual. [self inform: 'hello'. #done] value. Now let's suppress all inform: messages. [self inform: 'hello'; inform: 'there'. #done] valueSuppressingAllMessages. Here we can just suppress a single inform: message. [self inform: 'hi'; inform: 'there'. #done] valueSuppressingMessages: #('there') Here you see how you can suppress a list of messages. [self inform: 'hi'; inform: 'there'; inform: 'bill'. #done] valueSuppressingMessages: #('hi' 'there') Enough about inform:, let's look at confirm:. As you see this one works as expected. [self confirm: 'You like Squeak?'] value Let's supply answers to one of the questions -- check out the return value. [{self confirm: 'You like Smalltalk?'. self confirm: 'You like Squeak?'}] valueSupplyingAnswer: #('You like Smalltalk?' true) Here we supply answers using only substrings of the questions (for simplicity). [{self confirm: 'You like Squeak?'. self confirm: 'You like MVC?'}] valueSupplyingAnswers: #( ('Squeak' true) ('MVC' false) ) This time let's answer all questions exactly the same way. [{self confirm: 'You like Squeak?'. self confirm: 'You like Morphic?'}] valueSupplyingAnswer: true And, of course, we can answer FillInTheBlank questions in the same manner. [FillInTheBlank request: 'What day is it?'] valueSupplyingAnswer: 'the first day of the rest of your life' We can also return whatever the initialAnswer of the FillInTheBlank was by using the #default answer. [FillInTheBlank request: 'What day is it?' initialAnswer: DateAndTime now dayOfWeekName] valueSupplyingAnswer: #default Finally, you can also do regex matches on any of the question text (or inform text) (should you have VB-Regex enhancements in your image). [FillInTheBlank request: 'What day is it?'] valueSupplyingAnswers: { {'What day.*\?'. DateAndTime now dayOfWeekName} }! Item was changed: + ----- Method: ST80MenusTest>>testSupplyAnswerOfFillInTheBlank (in category 'tests') ----- - ----- Method: ST80MenusTest>>testSupplyAnswerOfFillInTheBlank (in category 'testing') ----- testSupplyAnswerOfFillInTheBlank self should: ['blue' = ([UIManager default request: 'Should not see this message or this test failed?'] valueSupplyingAnswer: #('Should not see this message or this test failed?' 'blue'))]! Item was changed: ----- Method: ScreenController>>setDisplayDepth (in category 'menu messages') ----- setDisplayDepth "Let the user choose a new depth for the display. " | result | + (result := (SelectionMenu selections: Display supportedDisplayDepths) startUpWithCaption: ('Choose a display depth + (it is currently {1})' translated format: {Display depth printString})) == nil ifFalse: - (result := (SelectionMenu selections: Display supportedDisplayDepths) startUpWithCaption: 'Choose a display depth - (it is currently ' , Display depth printString , ')') == nil ifFalse: [Display newDepth: result]! Item was changed: ----- Method: StandardSystemView class>>doCacheBits (in category 'class initialization') ----- doCacheBits "StandardSystemView doCacheBits - Enable fast window repaint feature" CacheBits := true. + ScheduledControllers ifNotNil: [:sc | sc unCacheWindows; restore]! - ScheduledControllers ifNotNilDo: [:sc | sc unCacheWindows; restore]! Item was added: + ----- Method: StandardSystemView>>defaultBackgroundColor (in category 'initialize-release') ----- + defaultBackgroundColor + + ^ model + ifNil: [Color white] + ifNotNil: [:m | m windowColorToUse]! Item was added: + ----- Method: StandardSystemView>>defaultForegroundColor (in category 'initialize-release') ----- + defaultForegroundColor + + ^ (self userInterfaceTheme borderColorModifier ifNil: [ [:c | c adjustBrightness: -0.5] ]) value: self defaultBackgroundColor! Item was removed: - ----- Method: StandardSystemView>>model: (in category 'initialize-release') ----- - model: aModel - "Set the receiver's model. For a Standard System View, we also at this time get the default background color set up. 7/30/96 sw" - super model: aModel. - self setDefaultBackgroundColor! Item was changed: + ----- Method: TestIndenting>>testBreakAtSpaceLeavesSpaceOnOriginalLine (in category 'tests') ----- - ----- Method: TestIndenting>>testBreakAtSpaceLeavesSpaceOnOriginalLine (in category 'testing') ----- testBreakAtSpaceLeavesSpaceOnOriginalLine "When an indented line is broken at a space, the character block must still lie in the line crossing the right margin." | cb | para compositionRectangle: (0@0 extent: para width - 24 @100); updateCompositionHeight. para clippingRectangle: (0@0 extent: 200@200). cb := para characterBlockForIndex: 7. self assert: cb top = 0. self assert: cb left >= 24! Item was changed: + ----- Method: TestIndenting>>testCR (in category 'tests') ----- - ----- Method: TestIndenting>>testCR (in category 'testing') ----- testCR "Checks whether the beginning of a new line starts at the indented position" | cb | para replaceFrom: 7 to: 7 with: (String with: Character cr) displaying: false. para clippingRectangle: (0@0 extent: 200@200). cb := para characterBlockForIndex: 8. self assert: cb top > 0. self assert: cb left = 24! Item was changed: + ----- Method: TestIndenting>>testCR2 (in category 'tests') ----- - ----- Method: TestIndenting>>testCR2 (in category 'testing') ----- testCR2 "Checks whether the drawing of indented text is really indented..." | cb | para replaceFrom: 7 to: 7 with: (String with: Character cr) displaying: false. para clippingRectangle: (0@0 extent: 200@200). cb := para characterBlockForIndex: 8. self assert: (para asForm copy: (0@cb top extent: 24@cb height)) isAllWhite! Item was changed: + ----- Method: TestIndenting>>testCR3 (in category 'tests') ----- - ----- Method: TestIndenting>>testCR3 (in category 'testing') ----- testCR3 "Checks whether the beginning of a new line starts at the indented position" | cb | para replaceFrom: 11 to: 11 with: (Text string: (String with: Character cr) attribute: (TextIndent tabs: 1)) displaying: false. para clippingRectangle: (0@0 extent: 200@200). cb := para characterBlockForIndex: 12. self assert: cb top > 0. self assert: cb left = 24! Item was changed: + ----- Method: TestIndenting>>testNewLineAndTabProvidesDoubleIndent (in category 'tests') ----- - ----- Method: TestIndenting>>testNewLineAndTabProvidesDoubleIndent (in category 'testing') ----- testNewLineAndTabProvidesDoubleIndent "Checks whether the beginning of a new line starts at the indented position" | cb | para replaceFrom: 11 to: 11 with: (Text string: (String with: Character cr) attribute: (TextIndent tabs: 1)) displaying: false. cb := para characterBlockForIndex: 12. self assert: cb top > 0. self assert: cb left = 24! Item was changed: + ----- Method: TestIndenting>>testNewLineLeaveSpacesOnOldLine (in category 'tests') ----- - ----- Method: TestIndenting>>testNewLineLeaveSpacesOnOldLine (in category 'testing') ----- testNewLineLeaveSpacesOnOldLine "Checks whether the drawing of indented text is really indented..." | cb | para replaceFrom: 7 to: 7 with: (String with: Character cr) displaying: false. cb := para characterBlockForIndex: 8. self assert: (para asForm copy: (0@cb top extent: 24@cb height)) isAllWhite! Item was changed: + ----- Method: TestIndenting>>testNewLineStartsIndented (in category 'tests') ----- - ----- Method: TestIndenting>>testNewLineStartsIndented (in category 'testing') ----- testNewLineStartsIndented "Checks whether the beginning of a new line starts at the indented position" | cb | para replaceFrom: 7 to: 7 with: (String with: Character cr) displaying: false. cb := para characterBlockForIndex: 8. self assert: cb top > 0. self assert: cb left = 24! Item was changed: + ----- Method: TestIndenting>>testNewLineStartsIndentedWhenWrapped (in category 'tests') ----- - ----- Method: TestIndenting>>testNewLineStartsIndentedWhenWrapped (in category 'testing') ----- testNewLineStartsIndentedWhenWrapped "Checks whether the beginning of a new line starts at the indented position" | cb | para compositionRectangle: (0@0 extent: para width - 24@100); updateCompositionHeight. para clippingRectangle: (0@0 extent: 200@200). cb := para characterBlockForIndex: 8. self assert: cb top > 0. self assert: cb left = 24! Item was changed: + ----- Method: TestIndenting>>testSetUp (in category 'tests') ----- - ----- Method: TestIndenting>>testSetUp (in category 'testing') ----- testSetUp "just reminding us all what the paragraph looks like to begin with. assuming Accuny12 font " | cb | cb := para characterBlockForIndex: 1. "p" self assert: cb top = 0. self assert: cb left = 0. self assert: cb right = 7. cb := para characterBlockForIndex: 2. "the tab" self assert: cb top = 0. self assert: cb left = 7. self assert: cb right = 24. cb := para characterBlockForIndex: 3. "w" self assert: cb top = 0. self assert: cb left = 24. self assert: cb right = 34. cb := para characterBlockForIndex: 7. " " "between word and word" self assert: cb top = 0. self assert: cb left = 52. self assert: cb right = 57. cb := para characterBlockForIndex: 11. "d" "last char" self assert: cb top = 0. self assert: cb left = 79. self assert: cb right = 85. ! Item was added: + ----- Method: View>>defaultBackgroundColor (in category 'initialize-release') ----- + defaultBackgroundColor + + ^ self userInterfaceTheme color! Item was added: + ----- Method: View>>defaultForegroundColor (in category 'initialize-release') ----- + defaultForegroundColor + + ^ self userInterfaceTheme borderColor! Item was changed: ----- Method: View>>model:controller: (in category 'controller access') ----- model: aModel controller: aController "Set the receiver's model to aModel, add the receiver to aModel's list of dependents, and set the receiver's controller to aController. Subsequent changes to aModel (see Model|change) will result in View|update: messages being sent to the receiver. #NoControllerAllowed for the value of aController indicates that no default controller is available; nil for the value of aController indicates that the default controller is to be used when needed. If aController is neither #NoControllerAllowed nor nil, its view is set to the receiver and its model is set to aModel." model ~~ nil & (model ~~ aModel) ifTrue: [model removeDependent: self]. aModel ~~ nil & (aModel ~~ model) ifTrue: [aModel addDependent: self]. model := aModel. aController ~~ nil ifTrue: [aController view: self. aController model: aModel]. + controller := aController. + + self setDefaultForegroundColor. + self setDefaultBackgroundColor.! - controller := aController! Item was changed: ----- Method: View>>setDefaultBackgroundColor (in category 'initialize-release') ----- setDefaultBackgroundColor "Obtain the background color from the receiver's model. The preferences make sure whether this is a colorful or uniform look." + self backgroundColor: self defaultBackgroundColor! - self backgroundColor: model windowColorToUse! Item was added: + ----- Method: View>>setDefaultForegroundColor (in category 'initialize-release') ----- + setDefaultForegroundColor + + self foregroundColor: self defaultForegroundColor!

1 0

The Trunk: HelpSystem-Tests-pre.21.mcz
by commits＠source.squeak.org 13 Dec '18

13 Dec '18

Patrick Rein uploaded a new version of HelpSystem-Tests to project The Trunk: http://source.squeak.org/trunk/HelpSystem-Tests-pre.21.mcz ==================== Summary ==================== Name: HelpSystem-Tests-pre.21 Author: pre Time: 13 December 2018, 12:22:53.399468 pm UUID: 34bfe3d0-cae7-40ed-a82a-0ab59110965a Ancestors: HelpSystem-Tests-dtl.20 Categorizes uncategorized methods in the HelpSystem tests package. =============== Diff against HelpSystem-Tests-dtl.20 =============== Item was changed: + ----- Method: AdvancedHelpBrowserDummy>>model (in category 'accessing') ----- - ----- Method: AdvancedHelpBrowserDummy>>model (in category 'testing') ----- model ^self! Item was changed: + ----- Method: AdvancedHelpBrowserDummy>>showFirstTopic (in category 'mocking') ----- - ----- Method: AdvancedHelpBrowserDummy>>showFirstTopic (in category 'testing') ----- showFirstTopic ^rootTopic! Item was changed: + ----- Method: ClassAPIHelpBuilderTest>>testDefaultBuilding (in category 'tests') ----- - ----- Method: ClassAPIHelpBuilderTest>>testDefaultBuilding (in category 'testing') ----- testDefaultBuilding |topic| topic := CurrentReadOnlySourceFiles cacheDuring: [ ClassAPIHelpBuilder buildHelpTopicFrom: Integer ]. self assert: topic subtopics size = 2. self assert: topic subtopics first title = 'Instance side'. self assert: topic subtopics last title = 'Class side' ! Item was changed: + ----- Method: ClassAPIHelpBuilderTest>>testMethodsButNoSubclasses (in category 'tests') ----- - ----- Method: ClassAPIHelpBuilderTest>>testMethodsButNoSubclasses (in category 'testing') ----- testMethodsButNoSubclasses |topic| topic := CurrentReadOnlySourceFiles cacheDuring: [ ClassAPIHelpBuilder buildHierarchicalHelpTopicFrom: Integer withSubclasses: false withMethods: true ]. self assert: topic subtopics size = 2. self assert: topic subtopics first title = 'Instance side'. self assert: topic subtopics last title = 'Class side' ! Item was changed: + ----- Method: HelpBrowserTest>>testDefaultHelpBrowser (in category 'tests') ----- - ----- Method: HelpBrowserTest>>testDefaultHelpBrowser (in category 'testing') ----- testDefaultHelpBrowser | current replacement instance | current := self defaultTestClass defaultHelpBrowser. replacement := AdvancedHelpBrowserDummy. [ self defaultTestClass defaultHelpBrowser: replacement. self assert: self defaultTestClass defaultHelpBrowser == replacement. instance := self defaultTestClass open. self assert: instance rootTopic notNil. self assert: instance isOpen. ] ensure: [ self defaultTestClass defaultHelpBrowser: current ] ! Item was changed: + ----- Method: HelpBrowserTest>>testDefaultHelpBrowserIsReplacable (in category 'tests') ----- - ----- Method: HelpBrowserTest>>testDefaultHelpBrowserIsReplacable (in category 'testing') ----- testDefaultHelpBrowserIsReplacable | current replacement instance | "save the one that is registered" current := self defaultTestClass defaultHelpBrowser. replacement := AdvancedHelpBrowserDummy. [ self defaultTestClass defaultHelpBrowser: replacement. self assert: self defaultTestClass defaultHelpBrowser == replacement. instance := self defaultTestClass open. ] ensure: [ self defaultTestClass defaultHelpBrowser: current ] ! Item was changed: + ----- Method: HelpBrowserTest>>testLazyDefaultHelpBrowser (in category 'tests') ----- - ----- Method: HelpBrowserTest>>testLazyDefaultHelpBrowser (in category 'testing') ----- testLazyDefaultHelpBrowser self assert: self defaultTestClass defaultHelpBrowser notNil! Item was changed: + ----- Method: HelpBrowserTest>>testOpen (in category 'tests') ----- - ----- Method: HelpBrowserTest>>testOpen (in category 'testing') ----- testOpen | browser | [ "This should not throw an exception." browser := self defaultTestClass open. Project current world doOneCycleNow ] ensure: [ browser ifNotNil: [ browser delete ] ]! Item was changed: + ----- Method: HelpBrowserTest>>testRegistration (in category 'tests') ----- - ----- Method: HelpBrowserTest>>testRegistration (in category 'testing') ----- testRegistration TheWorldMenu registeredOpenCommands detect: [:each | each first = 'Help Browser'] ifNone: [self fail]. ! Item was changed: + ----- Method: HelpIconsTest>>testIconCaching (in category 'tests') ----- - ----- Method: HelpIconsTest>>testIconCaching (in category 'testing') ----- testIconCaching | first second | #(bookIcon pageIcon refreshIcon) do: [:iconSymbol | first := self defaultTestClass iconNamed: iconSymbol. second := self defaultTestClass iconNamed: iconSymbol. self assert: first notNil. self assert: first == second. ] ! Item was changed: + ----- Method: HelpTopicListItemWrapperTest>>testDisplayLabel (in category 'tests') ----- - ----- Method: HelpTopicListItemWrapperTest>>testDisplayLabel (in category 'testing') ----- testDisplayLabel |instance| instance := self defaultTestClass with: (HelpTopic named: 'My Topic'). self assert: instance asString = 'My Topic' ! Item was changed: + ----- Method: HelpTopicTest>>testAddingSubtopic (in category 'tests') ----- - ----- Method: HelpTopicTest>>testAddingSubtopic (in category 'testing') ----- testAddingSubtopic |subtopic returned| subtopic := self defaultTestClass named: 'Subtopic'. returned := topic addSubtopic: subtopic. self assert: returned == subtopic. self assert: (topic subtopics includes: subtopic) ! Item was changed: + ----- Method: HelpTopicTest>>testInitialization (in category 'tests') ----- - ----- Method: HelpTopicTest>>testInitialization (in category 'testing') ----- testInitialization self assert: topic title = 'Unnamed Topic'. self assert: topic contents isEmpty ! Item was changed: + ----- Method: HelpTopicTest>>testInstanceCreation (in category 'tests') ----- - ----- Method: HelpTopicTest>>testInstanceCreation (in category 'testing') ----- testInstanceCreation |instance| instance := self defaultTestClass named: 'My Topic'. self assert: instance title = 'My Topic'. ! Item was changed: + ----- Method: HelpTopicTest>>testSortOrder (in category 'tests') ----- - ----- Method: HelpTopicTest>>testSortOrder (in category 'testing') ----- testSortOrder |a b c sorted | a := self defaultTestClass named: 'A'. b := self defaultTestClass named: 'B'. c := self defaultTestClass named: 'C'. sorted := (OrderedCollection with: b with: c with: a) sort. self assert: sorted first = a. self assert: sorted last = c. !

1 0

The Trunk: HelpSystem-Core-pre.107.mcz
by commits＠source.squeak.org 13 Dec '18

13 Dec '18

Patrick Rein uploaded a new version of HelpSystem-Core to project The Trunk: http://source.squeak.org/trunk/HelpSystem-Core-pre.107.mcz ==================== Summary ==================== Name: HelpSystem-Core-pre.107 Author: pre Time: 13 December 2018, 12:22:11.571468 pm UUID: 7f07a7ac-ec18-432a-85df-a1c6901cb73b Ancestors: HelpSystem-Core-tpr.106 Categorizes uncategorized methods in the HelpSystem package. =============== Diff against HelpSystem-Core-tpr.106 =============== Item was changed: + ----- Method: HelpTopicListItemWrapper class>>with:model:parent: (in category 'instance creation') ----- - ----- Method: HelpTopicListItemWrapper class>>with:model:parent: (in category 'as yet unclassified') ----- with: anObject model: aModel parent: aParent ^self new setItem: anObject model: aModel parent: aParent ! Item was changed: + ----- Method: SearchTopic>>find:in:results: (in category 'searching') ----- - ----- Method: SearchTopic>>find:in:results: (in category 'as yet unclassified') ----- find: term in: path results: results | resultTemplate c topic | topic := path last. resultTemplate := Array new: 6. (topic title asString findString: term startingAt: 1 caseSensitive: false) in: [:index | index > 0 ifTrue: [resultTemplate at: 2 put: (index to: index + term size)]]. ((c := topic contents asString withSqueakLineEndings) findString: term startingAt: 1 caseSensitive: false) in: [:index | index > 0 ifTrue: [ | leadingContext trailingContext i | leadingContext := 0. trailingContext := 0. i := index. [i notNil] whileTrue: [ (leadingContext = 2 or: [i = 1]) ifTrue: [ leadingContext := i = 1 ifTrue: [i] ifFalse: [i+1]. i := nil] ifFalse: [ ((c at: i) = Character cr) ifTrue: [ leadingContext := leadingContext + 1]. i := i - 1] ]. i := index + term size. [i notNil] whileTrue: [ (trailingContext = 2 or: [i >= c size]) ifTrue: [ trailingContext := i = c size ifTrue: [i] ifFalse: [i-1]. i := nil] ifFalse: [ ((c at: i) = Character cr) ifTrue: [ trailingContext := trailingContext + 1]. i := i + 1] ]. resultTemplate at: 1 put: path; at: 3 put: (index - leadingContext + 1 to: index - leadingContext + term size); at: 4 put: (c copyFrom: leadingContext to: trailingContext); at: 5 put: leadingContext; at: 6 put: (index to: index + term size - 1). self mutex critical: [ results add: resultTemplate ]. self triggerUpdateContents. ] ]. topic isSearchable ifTrue: [ topic subtopics do: [:t | self find: term in: path, {t} results: results]].! Item was changed: + ----- Method: SearchTopic>>mutex (in category 'private') ----- - ----- Method: SearchTopic>>mutex (in category 'as yet unclassified') ----- mutex ^ mutex ifNil: [mutex := Mutex new]! Item was changed: + ----- Method: SearchTopic>>printResultEntry: (in category 'private') ----- - ----- Method: SearchTopic>>printResultEntry: (in category 'as yet unclassified') ----- printResultEntry: entry | resultEntry topic | resultEntry := '' asText. topic := entry first last. entry second notNil ifFalse: [resultEntry append: ( (topic title) asText addAttribute: TextEmphasis bold)] ifTrue: [resultEntry append: ( (topic title) asText addAttribute: TextEmphasis bold; addAttribute: (TextColor color: Color green muchDarker) from: entry second first to: entry second last)]. resultEntry append: (' (open topic)' asText addAttribute: (PluggableTextAttribute evalBlock: [ self changed: #searchResultSelected with: entry first. self changed: #searchResultContentsSelected with: entry sixth])). resultEntry append: String cr. entry fourth in: [:contents | | text | text := contents asText. text addAttribute: (TextColor color: Color green muchDarker) from: entry third first to: entry third last; addAttribute: TextEmphasis bold from: entry third first to: entry third last. resultEntry append: text withBlanksTrimmed; append: '\\' withCRs. ]. ^ resultEntry! Item was changed: + ----- Method: SearchTopic>>startSearch (in category 'private') ----- - ----- Method: SearchTopic>>startSearch (in category 'as yet unclassified') ----- startSearch self stopSearch. results := OrderedCollection new. self topicsToSearch ifEmpty: [ self changed: #contents. ^ self]. process := [ (self topicsToSearch sorted: [:t1 :t2 | t1 priorityForSearch <= t2 priorityForSearch]) do: [:topic | | nestedResults | nestedResults := OrderedCollection new. self mutex critical: [results add: topic -> nestedResults]. self find: self term in: {topic} results: nestedResults]. results add: 'Search finished.'. self triggerUpdateContents. ] forkAt: 35.! Item was changed: + ----- Method: SearchTopic>>stopSearch (in category 'private') ----- - ----- Method: SearchTopic>>stopSearch (in category 'as yet unclassified') ----- stopSearch process ifNotNil: #terminate. process := nil.! Item was changed: + ----- Method: SearchTopic>>triggerUpdateContents (in category 'private') ----- - ----- Method: SearchTopic>>triggerUpdateContents (in category 'as yet unclassified') ----- triggerUpdateContents self mutex critical: [ updatePending == true ifFalse: [ updatePending := true. Project current addDeferredUIMessage: [ActiveWorld addAlarm: #updateContents withArguments: #() for: self at: Time millisecondClockValue + 250] ] ]. ! Item was changed: + ----- Method: SearchTopic>>updateContents (in category 'private') ----- - ----- Method: SearchTopic>>updateContents (in category 'as yet unclassified') ----- updateContents self mutex critical: [ updatePending := false ]. resultText := nil. self changed: #contents with: self.! Item was changed: + ----- Method: SearchTopic>>updateResultText (in category 'private') ----- - ----- Method: SearchTopic>>updateResultText (in category 'as yet unclassified') ----- updateResultText resultText := '' asText. self mutex critical: [ results ifNil: [^ resultText]. results do: [:topicToResult | topicToResult isString ifTrue: [resultText append: ( (topicToResult, String cr) asText addAttribute: (TextColor color: (Color gray: 0.7)); yourself)] ifFalse: [ resultText append: ( ('\----- Matches found in ''', topicToResult key title, ''' -----\\') withCRs asText addAttribute: (TextColor color: (Color gray: 0.7))). topicToResult value do: [:entry | resultText append: (self printResultEntry: entry)] ]]]. ^ resultText!

1 0

The Trunk: GraphicsTests-mt.51.mcz
by commits＠source.squeak.org 12 Dec '18

12 Dec '18

Marcel Taeumel uploaded a new version of GraphicsTests to project The Trunk: http://source.squeak.org/trunk/GraphicsTests-mt.51.mcz ==================== Summary ==================== Name: GraphicsTests-mt.51 Author: mt Time: 12 December 2018, 10:09:09.446544 am UUID: 472be479-c09a-674a-a046-b47a64264bfe Ancestors: GraphicsTests-mt.50 Updates tests for converting points into rectangles. =============== Diff against GraphicsTests-mt.50 =============== Item was changed: ----- Method: PointTest>>testRectangleMix (in category 'tests') ----- testRectangleMix { Rectangle center: 60@60 extent: 100@100. Rectangle origin: 10@10 extent: 100@100. + Rectangle origin: 10@10 corner: 110@110. + + "1) Point/receiver is the origin, i.e. upper left corner." - Rectangle origin: 10@10 corner: 110@110. - - 60@60 inflate: 100@100. 10@10 extent: 100@100. 10@10 corner: 110@110. + + "2) Point/receiver is the extent." + 100@100 origin: 10@10. + 100@100 center: 60@60. + + "3) Receiver and argument are either origin or corner." + 110@110 rect: 10@10. + } permutationsDo: [:rects | rects overlappingPairsDo: [:r1 :r2 | self assert: r1 equals: r2]].! Item was added: + ----- Method: PointTest>>testRectangleWithCenter (in category 'tests') ----- + testRectangleWithCenter + + self + assert: (Rectangle center: 50@50 extent: 100@100) + equals: (100@100 center: 50@50).! Item was removed: - ----- Method: PointTest>>testRectangleWithInflate (in category 'tests') ----- - testRectangleWithInflate - - self - assert: (Rectangle center: 50@50 extent: 100@100) - equals: (50@50 inflate: 100@100).! Item was added: + ----- Method: PointTest>>testRectangleWithOrigin (in category 'tests') ----- + testRectangleWithOrigin + + self + assert: (Rectangle origin: 50@50 extent: 100@100) + equals: (100@100 origin: 50@50).! Item was added: + ----- Method: PointTest>>testRectangleWithPoints (in category 'tests') ----- + testRectangleWithPoints + + self + assert: (Rectangle origin: 50@50 corner: 100@100) + equals: (100@100 rect: 50@50).!

1 0

The Trunk: Graphics-mt.405.mcz
by commits＠source.squeak.org 12 Dec '18

12 Dec '18

Marcel Taeumel uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-mt.405.mcz ==================== Summary ==================== Name: Graphics-mt.405 Author: mt Time: 12 December 2018, 10:07:51.370544 am UUID: de6add9e-f9c2-9a46-a50d-4a5c6d9450eb Ancestors: Graphics-mt.404 Improvements on the recent addition (mt.404) of a new infix way to build rectangles around a center: - rename #inflate: to #center: to match the "noun style" of #corner: and extent: - for #center: treat the receiver as extent for readability - add #origin: to have both infix ways where the receiver is the rectangle's extent - change category for #corner:, #extent:, #center:, #origin:, and #rect: to "converting to rectangle" for discoverability For the discussion, see http://forum.world.st/The-Trunk-Graphics-mt-404-mcz-td5090000.html =============== Diff against Graphics-mt.404 =============== Item was added: + ----- Method: Point>>center: (in category 'converting to rectangle') ----- + center: aPoint + "Answer a Rectangle whose extent is the receiver and whose center is + aPoint. This is one of the infix ways of expressing the creation of a + rectangle." + + ^Rectangle center: aPoint extent: self! Item was changed: + ----- Method: Point>>corner: (in category 'converting to rectangle') ----- - ----- Method: Point>>corner: (in category 'converting') ----- corner: aPoint "Answer a Rectangle whose origin is the receiver and whose corner is aPoint. This is one of the infix ways of expressing the creation of a rectangle." ^Rectangle origin: self corner: aPoint! Item was changed: + ----- Method: Point>>extent: (in category 'converting to rectangle') ----- - ----- Method: Point>>extent: (in category 'converting') ----- extent: aPoint "Answer a Rectangle whose origin is the receiver and whose extent is aPoint. This is one of the infix ways of expressing the creation of a rectangle." ^Rectangle origin: self extent: aPoint! Item was removed: - ----- Method: Point>>inflate: (in category 'converting') ----- - inflate: aPoint - "Answer a Rectangle whose center is the receiver and whose extent is - aPoint. This is one of the infix ways of expressing the creation of a - rectangle." - - ^Rectangle center: self extent: aPoint! Item was added: + ----- Method: Point>>origin: (in category 'converting to rectangle') ----- + origin: aPoint + "Answer a Rectangle whose extent is the receiver and whose origin is + aPoint. This is one of the infix ways of expressing the creation of a + rectangle." + + ^Rectangle origin: aPoint extent: self! Item was changed: + ----- Method: Point>>rect: (in category 'converting to rectangle') ----- - ----- Method: Point>>rect: (in category 'converting') ----- rect: aPoint "Answer a Rectangle that encompasses the receiver and aPoint. This is the most general infix way to create a rectangle." ^ Rectangle origin: (self min: aPoint) corner: (self max: aPoint)!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages December 2018