Add support for Drag and Drop to PluggableListMorphOfMany. Thanks Gerald.

'From Haver 6.0 [latest update: #5441] on 10 August 2022 at 2:54:53 pm'!

!PluggableListMorphOfMany methodsFor: 'events' stamp: 'KLG 8/10/2022 14:50:03'!
mouseButton1Down: aMouseButtonEvent localPosition: localEventPosition

	| oldIndex oldVal row w |
	self hasKeyboardFocus ifFalse: [
		aMouseButtonEvent hand newKeyboardFocus: self ].

	row _ self rowAtLocation: localEventPosition.

	row = 0 ifTrue: [
		^super mouseButton1Down: aMouseButtonEvent localPosition: localEventPosition ].

	"Highlight the row to be selected, for immediate user feedback in case the model takes a while to update the view."
	scroller highlightedRow: row.

	w _ self owningWindow.
	(w isNil or: [ w okToChange ]) ifTrue: [ "No change if model is locked"

		"Set meaning for subsequent dragging of selection"
		dragOnOrOff _ (self listSelectionAt: row) not.
		dragStartRow _ row.
		oldIndex _ self getCurrentSelectionIndex.
		oldIndex ~= 0 ifTrue: [oldVal _ self listSelectionAt: oldIndex].

		"Different from PluggableListMorph. There, we highlight on mouse down, and act on mouse up.
		Here, we act on mouse down, because we support dragging of selection, so mouse up will
		only happen after user is finished dragging. In order to get the highlight visible for the user,
		update the model on next world cycle."
		UISupervisor whenUIinSafeState: [
			"Set or clear new primary selection (listIndex)"
			dragOnOrOff == true
				ifTrue: [self setSelectionIndex: row]
				ifFalse: [self setSelectionIndex: 0].
			"Need to restore the old one, due to how model works, and set new one."
			oldIndex ~= 0 ifTrue: [self listSelectionAt: oldIndex put: oldVal].
			self listSelectionAt: row put: dragOnOrOff ].
	].
	aMouseButtonEvent hand
		waitForClicksOrDragOrSimulatedMouseButton2: self
		event: aMouseButtonEvent
		clkSel: nil
		clkNHalf: nil
		dblClkSel: #doubleClick:localPosition:
		dblClkNHalfSel: nil
		tripleClkSel: nil
		dragSel: (
			aMouseButtonEvent shiftPressed ifFalse: [
				(self valueOfProperty: #allowsItemDrag) = true
						ifTrue: [ #dragEvent:localPosition: ] ifFalse: [ nil ] ])! !


Fix a walkback in Layouts when proportional part is zero.

'From Cuis 6.0 [latest update: #5105] on 18 April 2022 at 10:52:39 am'!

!LayoutSpec methodsFor: 'testing' stamp: 'jmv 4/18/2022 10:51:25'!
isProportionalHeight
	"Zero actuaqlly means fixed height."

	^ proportionalHeight notNil and: [ proportionalHeight isZero not ].! !

!LayoutSpec methodsFor: 'testing' stamp: 'jmv 4/18/2022 10:50:58'!
isProportionalWidth
	"Zero actuaqlly means fixed width."

	^ proportionalWidth notNil and: [ proportionalWidth isZero not ].! !


Fix shout on empty Workspace. Thanks Ken.

'From Cuis 5.0 of 7 November 2016 [latest update: #3382] on 27 July 2018 at 6:17:35 pm'!

!SHParserST80 methodsFor: 'parse' stamp: 'jmv 7/27/2018 18:16:30'!
parse: isAMethod
	"Parse the receiver's text. If isAMethod is true
    then treat text as a method, if false as an
    expression with no message pattern"

	| continue |
	self initializeInstanceVariables.
	sourcePosition _ 1.
	arguments _ Dictionary new.
	temporaries _ Dictionary new.
	blockDepth _ bracketDepth := 0.
	blockDepths _ OrderedCollection with: blockDepth.
	blockDepthsStartIndexes _ OrderedCollection with: sourcePosition.
	ranges ifNil: [ ranges := OrderedCollection new: 100] ifNotNil: [ ranges reset].
	errorBlock _ [^false].
	[
		self scanNext.
		isAMethod
			ifTrue: [
				self parseMessagePattern.
				self parsePragmaSequence].
		self parseMethodTemporaries.
		isAMethod ifTrue: [self parsePragmaSequence].
		"Iterate once for methods, but pontentially several times for workspaces
		(to recover after errors, for possible good next lines or chunks)"
		continue _ true.
		[ continue ] whileTrue: [
			self parseStatementList.
			isAMethod
				ifTrue: [
					"Only if we are parsing a method, consider everything after this point as error."
					currentToken ifNotNil: [ self error ].
					continue _ false]
				ifFalse: [
					sourcePosition > source size ifTrue: [continue _ false]]].
	] ensure: [errorBlock _ nil].
	^true! !


Fix to bug in deferred Morphic processing. Thanks Hilaire.

'From Cuis 5.0 of 7 November 2016 [latest update: #3250] on 14 January 2018 at 11:26:34 am'!

!WorldState methodsFor: 'stepping' stamp: 'jmv 1/14/2018 11:26:09'!
runStepMethods
	"Perform periodic activity inbetween event cycles"
	| queue readyToProcess |

	queue _ self class deferredUIMessages.
	"Processing the queue until empty is wrong if a block in it calls #addDeferredUIMessage: itself, because this loop will never end.
	Instead, process no more than entries already in queue befor we start iterating!!"
	readyToProcess _ queue size.
	readyToProcess timesRepeat: [
		queue nextOrNil ifNotNil: [ :block |
			block value
		]
	].
	self triggerAlarmsBefore: lastCycleTime.
	self runLocalStepMethods: lastCycleTime.

	"we are using a normal #step for these now"
	"aWorld allLowerWorldsDo: [ :each | each runLocalStepMethods ]."
! !


Remove the seldom used 'resize from menu' halo menu option.

'From Cuis 5.0 [latest update: #4402] on 12 October 2020 at 9:31:21 pm'!

!Morph methodsFor: 'menus' stamp: 'jmv 10/12/2020 21:29:49'!
addHaloActionsTo: aMenu
	"Add items to aMenu representing actions requestable via halo"

	| subMenu |
	subMenu := MenuMorph new defaultTarget: self.
	subMenu addTitle: (self printStringLimitedTo: 40).
	subMenu addStayUpIcons.
	subMenu addLine.
	(subMenu add: 'delete' action: #dismissViaHalo)
		setBalloonText: 'Delete this object -- warning -- can be destructive!!' .
	self maybeAddCollapseItemTo: subMenu.
	(subMenu add: 'grab' action: #openInHand)
		setBalloonText: 'Pick this object up -- warning, since this removes it from its container, it can have adverse effects.' .
	subMenu addLine.
	(subMenu add: 'duplicate' action: #maybeDuplicateMorph)
		setBalloonText: 'Hand me a copy of this object'.
	(subMenu
		add: 'set color'
		target: self
		action: #changeColor)
			setBalloonText: 'Change the color of this object'.
	(subMenu
		add: 'inspect'
		target: self
		action: #inspect)
			setBalloonText: 'Open an Inspector on this object'.
	aMenu add: 'halo actions...' subMenu: subMenu! !

!methodRemoval: Morph #resizeFromMenu stamp: 'jmv 10/12/2020 21:30:04'!
Morph removeSelector: #resizeFromMenu!
!methodRemoval: Morph #resizeMorph stamp: 'jmv 10/12/2020 21:30:26'!
Morph removeSelector: #resizeMorph!
!classRemoval: #HandleMorph stamp: 'jmv 10/12/2020 21:30:51'!
Smalltalk removeClassNamed: #HandleMorph!


Class {
	#name : #MCReleaseTest,
	#superclass : #MCTestCase,
	#category : #'Monticello-Tests-Base'
}

{ #category : #tests }
MCReleaseTest >> testMonticelloInitializersAreEnabledByDefault [

	"Monticello should by default have this option enabled.
	If this is not the case, the image cannot be released, as it will break users that expect class initializations to be run automatically"

	self assert: MCMethodDefinition initializersEnabled.
]


"
Verify that number of states does not match with size of matrix
"
Class {
	#name : #K2StateSizeDoesNotMachMatrixSizeExceptions,
	#superclass : #K2CTMCExceptions,
	#category : #'Kendrick2-CTMC-Exceptions'
}


Fix annoyance in Menu>>wantsToBeOnTop. Thanks Gerald.

'From Cuis 5.0 [latest update: #4928] on 15 October 2021 at 1:09:52 pm'!

!MenuMorph methodsFor: 'testing' stamp: 'KLG 10/14/2021 23:47:37'!
wantsToBeOnTop
	"If true, will be above all siblings who don't."

	^ stayUp not! !


Fix to TextParagraphMorph drawing. Thanks Hilaire.

'From Cuis 5.0 [latest update: #4984] on 28 November 2021 at 9:34:07 pm'!

!TextParagraphMorph methodsFor: 'drawing' stamp: 'hlsf 11/28/2021 21:30:56'!
drawOn: aCanvas
	aCanvas
		fillRectangle: self morphLocalBounds color: color.
	aCanvas
		textComposition: textComposition
		bounds: (self morphLocalBounds insetBy: borderWidth * 2)
		color: Theme current text
		selectionColor: `Color red`.
	aCanvas
		frameRectangle: self morphLocalBounds
		color: borderColor
		borderWidth: borderWidth
		borderStyleSymbol: nil! !


'From Cuis 5.0 of 7 November 2016 [latest update: #3757] on 21 May 2019 at 12:10:25 pm'!

!Morph methodsFor: 'meta-actions' stamp: 'KenD 5/8/2019 20:51:33'!
potentialEmbeddingTargets
	"Return the potential targets for embedding the receiver"
	| myRect myWorld |
	owner ifNil:[^#()].
	myWorld := owner world ifNil:[^#()].
	myRect := self morphBoundsInWorld.
	^myWorld submorphs select: [ :m |
		m isReallyVisible
		and: [ m isLocked not
			and: [(m morphBoundsInWorld intersects: myRect)
				and: [(m ~= self)
					and: [(m isKindOf: HaloMorph) not]]]]
		]! !


Add test toa void that projects load automatically their dependencies

tests
testNotLoadingProjectLoadingDoesNotLoadCorrespondingClassesInSystem

	| project testRegistry configurationProject |
	testRegistry := CGOPackageRegistry new.
	project := testRegistry newProjectNamed: 'Test'.

	configurationProject := CGOMetacelloConfigurationProject
		configuration: 'CargoTestExample'
		repositoryUrl: 'http://smalltalkhub.com/mc/Pharo/CargoTestRepository/main'
		version: '1.0'.
	project addDependency: configurationProject.

	self deny: (Smalltalk globals hasClassNamed: 'ConfigurationOfCargoTestExample').
	self deny: (Smalltalk globals hasClassNamed: 'ClassInPackageA').
	self deny: (Smalltalk globals hasClassNamed: 'ClassInPackageB').
	self deny: (Smalltalk globals hasClassNamed: 'ClassInPackageC').
	self deny: (Smalltalk globals hasClassNamed: 'ClassInPackageD').


Use initializePvt as prefix for initializers of immutable objects.

'From Cuis 5.0 of 7 November 2016 [latest update: #3804] on 13 June 2019 at 8:56:28 am'!

!Symbol methodsFor: 'testing' stamp: 'jmv 6/13/2019 08:54:44'!
isInitializePvtSelector
	"Answer whether the receiver is a private instance initialization message selector, that is,
	begins with 'initializePvt' (followed or not by additional stuff, as a unary message, or as keyword with arguments)"

	^ self beginsWith: 'initializePvt'! !

!SelectorNode methodsFor: 'testing' stamp: 'jmv 6/13/2019 08:54:32'!
isInitializePvtSelector
	"Answer whether the receiver is a private instance initialization message selector"

	^ key isInitializePvtSelector! !

!Point methodsFor: 'private - initialization' stamp: 'jmv 6/13/2019 08:51:25'!
initializePvtX: xValue y: yValue
	"Points are immutable."
	x _ xValue.
	y _ yValue! !

!MessageNode methodsFor: 'private' stamp: 'jmv 6/13/2019 08:52:31'!
pvtCheckForPvtSelector: encoder
	"If the code being compiled is trying to send a private message (e.g. 'pvtCheckForPvtSelector:') to anyone other than self, then complain to encoder."

	selector isInitializePvtSelector ifTrue: [
		(receiver isSelfNewMessageSend or: [receiver isSelfBasicNewMessageSend]) ifFalse: [
			encoder notify: 'Private instance initialization messages may only be sent to ''self new'' or "self basicNew" (by class instance creation methods)']].
	selector isPvtSelector ifTrue: [
		(receiver isSelfPseudoVariable or: [ receiver isSuperPseudoVariable ]) ifFalse: [
			encoder notify: 'Private messages may only be sent to self or super']].! !

!Point class methodsFor: 'instance creation' stamp: 'jmv 6/13/2019 08:55:26'!
x: anX y: anY
	"Answer an instance of me with supplied coordinates."

	^self new initializePvtX: anX y: anY! !

!methodRemoval: Point #pvtInitializeX:y:!
Point removeSelector: #pvtInitializeX:y:!
!methodRemoval: SelectorNode #isPvtInitializeSelector!
SelectorNode removeSelector: #isPvtInitializeSelector!
!methodRemoval: Symbol #isPvtInitializeSelector!
Symbol removeSelector: #isPvtInitializeSelector!


Make package loading robust against case errors in case-insensitive Windows

'From Cuis 5.0 of 7 November 2016 [latest update: #3267] on 11 March 2018 at 9:05:37 am'!

!Feature methodsFor: 'testing' stamp: 'jmv 3/11/2018 09:03:09'!
satisfies: featureRequirement
	"Does this provided Feature satisfy the FeatureRequirement?"

	"Must match name."
	^ (name sameAs: featureRequirement name) and: [

		"If no specific version req, we are done. Ok."
		featureRequirement minVersion isNil or: [

		"If our version is exactly the min req version, we must also satisfy minRevision"
		version = featureRequirement minVersion and: [
			featureRequirement minRevision isNil or: [ revision >= featureRequirement minRevision ]]] or: [

		"If we are past min req version, ignore minRevision, but check we are not beyond max req version"
		version > featureRequirement minVersion and: [
			featureRequirement maxVersion isNil or: [ version <= featureRequirement maxVersion ]]]]! !


Add composition descriptions to stream without duplicates

Extension { #name : #AsyncWithoutDuplicatesStream }

{ #category : #'*GToolkit-Extensions' }
AsyncWithoutDuplicatesStream >> gtCompositionChildren [

	^ { stream }
]

{ #category : #'*GToolkit-Extensions' }
AsyncWithoutDuplicatesStream >> gtCompositionDescription [

	| aString |
	aString := self printString asRopedText append: ': ' asRopedText.
	comparisonBlock ifNotNil: [
		aString append:
			(comparisonBlock printString asRopedText foreground:
				 BrGlamorousColors disabledButtonTextColor) ].
	^ aString
]


Make CPUWatcher tally reset on each period, as most people would expect.

'From Cuis 5.0 [latest update: #3840] on 21 August 2019 at 12:30:57 pm'!

!CPUWatcher methodsFor: 'startup-shutdown' stamp: 'pb 8/21/2019 12:23:45'!
monitorProcessPeriod: secs sampleRate: msecs suspendPorcine: aBoolean
	| delay |
	self stopMonitoring.
	watcher _ [
	delay _ Delay forMilliseconds: msecs truncated.
	[ | thisTally |
	thisTally _ IdentityBag new: 20.
	secs * 1000 // msecs timesRepeat: [
		delay wait.
		thisTally add: Processor nextReadyProcess ].
	tally _ thisTally.
	aBoolean ifTrue: [ self findThePig ]] repeat ] newProcess.
	watcher
		priority: Processor highestPriority;
		name: 'CPUWatcher monitor';
		resume.
	Processor yield.! !

!ProcessBrowser methodsFor: 'initialization' stamp: 'pb 8/21/2019 12:16:40'!
startCPUWatcher
	"Answers whether I started the CPUWatcher"

	CPUWatcher isMonitoring ifFalse: [
		CPUWatcher startMonitoringPeriod: 1 rate: 25 threshold: 0.85 suspendPorcine: false.
		^true
	].
	^false
! !


Fix occasional TrueType on BitBlt rounding error

'From Cuis 5.0 [latest update: #4149] on 20 May 2020 at 3:25:56 pm'!

!BitBltCanvas methodsFor: 'drawing-text' stamp: 'jmv 5/20/2020 15:18:06'!
drawString: aString from: firstIndex to: lastIndex at: aPoint font: fontOrNil color: aColor
	"Answer last affected pixel position
	Answer nil if nothing was done"

	| p1 font |
	"Don't waste any time if NOP"
	lastIndex = 0 ifTrue: [
		^nil ].

	p1 _ (currentTransformation transform: aPoint rounded) rounded.
	engine colorMap: nil.
	font _ fontOrNil ifNil: [ AbstractFont default ].
	^font
		onBitBltCanvasEngine: engine
		displayString: aString
		from: firstIndex
		to: lastIndex
		at: p1
		color: aColor! !


Allow subtitles between menu items. Thanks Gerald.

'From Haver 5.0 [latest update: #4587] on 6 May 2021 at 3:57:03 pm'!

!MenuMorph methodsFor: 'construction' stamp: 'KLG 5/6/2021 15:45:51'!
addTitle: aString
	"Add a title line at the top of this menu Make aString its initial
	contents.
	If aSelector is not nil, then periodically obtain fresh values for its
	contents by sending aSelector to aTarget.."

	| s pp w newMorph |

	newMorph _ WidgetMorph new noBorder.
	newMorph color: Theme current menuTitleBar.
	pp _ `8@2`.
	aString asString linesDo: [ :line |
		s _ LabelMorph new
			contents: line;
			font: Preferences standardMenuFont bold.
		newMorph addMorphBack: s position: pp.
		pp _ pp + (0@(s morphHeight+2)) ].
	w _ newMorph submorphs inject: 0 into: [ :prev :each |
		prev max: each morphWidth ].
	newMorph morphExtent: (w + 16) @ (pp y).
	titleMorph
		 ifNil: [
			titleMorph _ newMorph.
			self addMorphFront: titleMorph ]
		ifNotNil: [ self addMorphBack: newMorph ].

	(self hasProperty: #needsStayUpIcons) ifTrue: [ self addStayUpIcons ]! !


'From Cuis 5.0 [latest update: #5017] on 30 December 2021 at 11:28:15 am'!
!classDefinition: #EventSensor category: #'Kernel-Processes'!
InputSensor subclass: #EventSensor
	instanceVariableNames: 'mouseButtons mousePosition keyboardBuffer interruptKey interruptSemaphore eventQueue inputSemaphore lastEventPoll hasInputSemaphore '
	classVariableNames: 'EventTicklerProcess '
	poolDictionaries: ''
	category: 'Kernel-Processes'!
!classDefinition: #EventSensor category: #'Kernel-Processes'!
InputSensor subclass: #EventSensor
	instanceVariableNames: 'mouseButtons mousePosition interruptKey eventQueue inputSemaphore lastEventPoll hasInputSemaphore'
	classVariableNames: 'EventTicklerProcess'
	poolDictionaries: ''
	category: 'Kernel-Processes'!


'From Cuis 5.0 [latest update: #4997] on 3 December 2021 at 3:00:53 pm'!

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 12/3/2021 15:00:28'!
show: anObject
	"Old TranscriptStream protocol."
	(anObject asString findTokens: Character newLineCharacter)
		do: [ :line | self nextPutAll: line; newLine ]! !


Add a script that runs the tests of a single test class in a new TestRunner.

"Run a single test class in a TestRunner.
 Usage: myvm myimage.image RunATestClass.st TheTestClass
 A confirmer will appear after the tests have run.  Click to exit or not."
| testRunner testClass |
testRunner := TestRunner open model.
testClass := Smalltalk getSystemAttribute: 3.
testRunner
	selectNoClasses;
	classAt: ((1 to: testRunner classList size) detect:
				[:i| (testRunner classList at: i) string endsWith: testClass])
	put: true;
	runAll.
(UIManager default confirm: 'Quit?') ifTrue:
	[[Smalltalk quit]
		on: MessageNotUnderstood
		do: [:ex| Smalltalk quitPrimitive]]


Make Dictionary>>storeOn: be determistic if possible, to avoid spurious decompiler test failures.

'From Cuis 5.0 [latest update: #4381] on 24 September 2020 at 3:51:28 pm'!

!Dictionary methodsFor: 'printing' stamp: 'jmv 9/24/2020 15:49:52'!
storeOn: aStream
	| noneYet |
	aStream nextPutAll: '(('.
	aStream nextPutAll: self class name.
	aStream nextPutAll: ' new)'.
	noneYet _ true.
	self keysSortedSafely do: [ :key |
			noneYet
				ifTrue: [noneYet _ false]
				ifFalse: [aStream nextPut: $;].
			aStream nextPutAll: ' add: '.
			aStream store: (self associationAt: key)].
	noneYet ifFalse: [aStream nextPutAll: '; yourself'].
	aStream nextPut: $)! !


Make the debugger always show _some_ context.

'From Cuis 5.0 [latest update: #4994] on 1 December 2021 at 5:11:46 pm'!

!Debugger methodsFor: 'context stack (message list)' stamp: 'jmv 12/1/2021 17:09:14'!
toggleContextStackIndex: anInteger
	"If anInteger is the same as the index of the selected context, deselect it, and select the top context.
	Otherwise, the context whose index is anInteger becomes the selected context."

	self contextStackIndex:
		(contextStackIndex = anInteger
			ifTrue: [1]
			ifFalse: [anInteger max: 1])
		oldContextWas:
		(contextStackIndex = 0
			ifTrue: [nil]
			ifFalse: [contextStack at: contextStackIndex])! !


Fix paste of a Morph in a TextEditor. Thanks Ken.

'From Cuis 4.2 of 25 July 2013 [latest update: #2733] on 10 April 2016 at 4:30:06.304051 pm'!

!Clipboard methodsFor: 'accessing' stamp: 'KenD 4/8/2016 13:58'!
retrieveStringOrText
	"Answer a Text or a String. Appropriate for a Text Editor."
	| answer |

	answer _ self retrieveObject.

	"If clipboard contents is already a Text or String, answer it."
	(answer isString or: [ answer is: #Text ]) ifTrue: [
		^answer ].

	"If clipboard contains a Morph, answer a TextAnchor incuding it..."
	(answer is: #Morph) ifTrue: [
		^ (Text string: '*' attribute: (TextAnchor new anchoredFormOrMorph: answer)) ].

	"If clipboard contains a Form, prepare a Text including it."
	(answer is: #Form) ifTrue: [
		^Text withForm: answer ].

	"Answer some string..."
	^answer ifNil: [ '' ] ifNotNil: [ answer printString ]! !


Fix recently introduced walkback when resizing columns in a Browser. Thanks Sven.

'From Cuis 5.0 of 7 November 2016 [latest update: #3221] on 26 November 2017 at 5:12:13 pm'!

!Morph methodsFor: 'geometry' stamp: 'jmv 11/26/2017 17:11:34'!
minPaneWidthForReframe
	^ self minimumExtent x! !


Fix a bug in 5014, found by CI and tests.

'From Cuis 5.0 [latest update: #5015] on 30 December 2021 at 10:41:06 am'!

!ClassDescription methodsFor: 'initialization' stamp: 'jmv 12/30/2021 10:40:34'!
canUpdateFrom: oldClass
	"If some compiled method that will become invalid is currently being executed,
	the shape conversion of instances is extremely insecure.
	Answer if migration of instances looks safe"
	| answer newMethod oldMethod selector newActualClass oldActualClass |
	answer _ true.
	Processor
		processesDo: [ :p | ]
		withStackFramestDo: [ :process :context |
			(context receiver isKindOf: oldClass) ifTrue: [
				oldActualClass _ context receiver class.
				self withAllSubclassesDo: [ :c |
					c name = oldActualClass name ifTrue: [
						newActualClass _ c ]].
				selector _ context method selector.
				oldMethod _ oldActualClass lookupSelector: selector.
				newMethod _ newActualClass lookupSelector: selector.
				oldMethod = newMethod ifFalse: [
					('Class reshaping: ', context receiver class name, ' has some instance running #', selector, '. This CompiledMethod would become invalid. Class reshaping aborted.') print.
					answer _ false ].
				]]
		runningProcessSearchStart: nil.
	^answer! !


Tweak to StringRequestMorph open position. Thanks Ken.

'From Cuis 5.0 [latest update: #4188] on 26 May 2020 at 11:42:00 am'!

!StringRequestMorph class methodsFor: 'private' stamp: 'KenD 5/25/2020 12:37:58'!
deltaToTextPane
	"Answer a distance to translate an instance of the receiver by when it is opened in the world in order to have the hand be over the text pane (so the text pane has focus).
	Distance is relative to font size"
	| e |
	e _ Preferences windowTitleFont lineSpacing.
	^ (2 * e)@(1.5 * e)! !


Set appropriate button extent on initialization

'From Cuis 5.0 of 7 November 2016 [latest update: #3158] on 28 August 2017 at 5:26:35 pm'!

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'jmv 8/25/2017 15:05:56'!
label: aStringOrNil font: aFontOrNil
	"Label this button with the given string."
	label _ aStringOrNil.
	font _ aFontOrNil.
	(self fontToUse notNil and: [ label notNil ])
		ifTrue: [ "Add a bit of padding"
			extent := (self fontToUse widthOfString: label) + 10 @ (self fontToUse height + 10) ]! !


Fix recently broken ctrl-arrowKeys keystrokes

'From Cuis 5.0 of 7 November 2016 [latest update: #3263] on 1 March 2018 at 4:59:38 pm'!

!HandMorph methodsFor: 'private events' stamp: 'jmv 3/1/2018 16:59:14'!
shouldControlEmulateAltFor: keyValue
	"At least on Linux Windows, command key is usually ctrl, not alt.
	But not for arrow keys!! ctrl-left ~~ alt-left"
	^ keyValue > 32! !


Fix to MessageNames when a class matches request.

'From Cuis 5.0 [latest update: #4372] on 7 September 2020 at 1:10:40 pm'!

!MessageNames methodsFor: 'class list' stamp: 'KLG 9/1/2020 21:48:42'!
selectedClassOrMetaClass
	"Answer the currently selected class (or metaclass).

	If no method is selected, try to interpret the selected message name
	as a class"

	^ super selectedClassOrMetaClass ifNil: [
		self selectedMessageName ifNotNil: [ :className | | mayBeClass |
			(mayBeClass _ Smalltalk
				at: className ifAbsent: [^ nil ]) isBehavior
					ifTrue: [ mayBeClass ]
					ifFalse: [ mayBeClass class ] ] ].! !


'From Cuis 5.0 of 7 November 2016 [latest update: #3418] on 21 August 2018 at 4:01:58 pm'!

!ProtocolBrowser methodsFor: 'initialization' stamp: 'jmv 8/21/2018 16:01:20'!
initialize
	super initialize.
	exclude _ OrderedCollection new! !


Use default cursor if asked for a missing one. Thanks Phil.

'From Cuis 5.0 [latest update: #3878] on 18 September 2019 at 8:25:36 pm'!

!Cursor class methodsFor: 'accessing' stamp: 'pb 9/18/2019 20:24:42'!
cursorAt: cursorKey ifAbsent: aBlock
	^ (CursorDict
		at: cursorKey
		ifAbsent: [
			(self respondsTo: cursorKey) ifTrue: [ | newCursor |
				newCursor _ self perform: cursorKey.
				newCursor hasMask ifFalse: [ newCursor _ newCursor withMask ].
				self
					cursorAt: cursorKey
					put: newCursor ]]) ifNil: aBlock.! !

!Cursor class methodsFor: 'accessing' stamp: 'pb 9/18/2019 20:25:12'!
cursorAt: cursorKey
	^ self
		cursorAt: cursorKey
		ifAbsent: [ self defaultCursor ].! !


'From Cuis 5.0 [latest update: #4804] on 24 August 2021 at 4:38:23 pm'!

!Rectangle methodsFor: 'rectangle functions' stamp: 'jmv 8/24/2021 16:36:44'!
updateMerging: aRectangle
	"Modify receiver"

	origin _ origin min: aRectangle origin.
	corner _ corner max: aRectangle corner.! !

!DamageRecorder methodsFor: 'recording' stamp: 'jmv 8/24/2021 16:37:48'!
damageReportedOther
	"Answer damage reported for no specific morph, for morphs that are not visible, and for morphs that are carried by the Hand."
	| answer possiblyMoreRectsToMerge |
	answer _ OrderedCollection new.
	self pvtAccessProtect critical: [
		damageByRoot keysAndValuesDo: [ :m :r |
			(m visible not or: [m owner isNil or: [m owner is: #HandMorph]]) ifTrue: [
				answer add: r]].
		otherDamage do: [ :r | answer add: r ].
	].
	possiblyMoreRectsToMerge _ true.
	[possiblyMoreRectsToMerge] whileTrue: [
		possiblyMoreRectsToMerge _ false.
		answer withIndexDo: [ :r1 :i |
			r1 ifNotNil: [
				i+1 to: answer size do: [ :j | | r2 |
					r2 _ answer at: j.
					r2 ifNotNil: [
						(r1 intersects: r2) ifTrue: [
							r1 updateMerging: r2.
							answer at: j put: nil.
							possiblyMoreRectsToMerge _ true ]]]]]].
	answer _ answer select: [ :r | r notNil ].
	^answer! !


Fix method timestamp retrieval for exclamation mark selectors. Thanks Luciano.

'From Cuis 6.0 [latest update: #5117] on 2 May 2022 at 10:45:22 am'!

!CompiledMethod methodsFor: 'source code management' stamp: 'len 4/30/2022 18:38:39'!
getPreambleFrom: aFileStream at: position
	|  writeStream c p |
	writeStream _ String new writeStream.
	p _ position - 1.
	c _ nil.
	aFileStream position: p.
	aFileStream atEnd ifTrue: [ ^ nil ].
	[ p >= 0 and: [ c ~~ $!! ]] whileTrue: [
		aFileStream position: p.
		c _ aFileStream basicNext.
		p _ p - 1 ].
	[ p >= 0] whileTrue: [
		aFileStream position: p.
		c _ aFileStream basicNext.
		c == $!!
			ifTrue: [^ writeStream contents reverse ]
			ifFalse: [ writeStream nextPut: c ].
		p _ p - 1 ].
	^ nil! !


Fix a visual glitch in drag and drop methods.

'From Cuis 5.0 [latest update: #4329] on 3 August 2020 at 2:34:23 pm'!

!PluggableListMorph methodsFor: 'events' stamp: 'jmv 8/3/2020 14:31:56'!
dragEvent: aMouseEvent localPosition: localEventPosition

	| row dragged listItem sm |
	self listMorph highlightedRow: nil.
	row _ self rowAtLocation: localEventPosition ifNone: [ ^self ].
	listItem _ self getListItem: row.

	sm _ StringMorph contents: listItem.
	dragged _ DraggingGuideMorph new.
	dragged addMorph: sm.
	dragged morphExtent: sm morphExtent.
	dragged setProperty: #dragSource toValue: self.
	dragged setProperty: #dropSelectorArgument toValue: listItem.

	aMouseEvent hand attachMorphBeside: dragged.! !


Fix walkback when browsing package files with pretty print on. Thanks Javier.

'From Cuis 5.0 of 7 November 2016 [latest update: #3442] on 16 September 2018 at 10:20:05 am'!

!PseudoClass methodsFor: 'accessing' stamp: 'JO 9/16/2018 10:19:39'!
variablesAndOffsetsDo: aBinaryBlock
	"NOp"! !


Fix to log of RenameInstanceVariable refactoring.

'From Cuis 5.0 [latest update: #3913] on 18 October 2019 at 6:43:17 pm'!

!RenameInstanceVariable methodsFor: 'applying - private' stamp: 'HAW 10/18/2019 18:39:55'!
logClassDefinition

	Smalltalk
		logChange: classToRefactor definition
		preamble: classToRefactor definitionPreamble.! !

!RenameInstanceVariable methodsFor: 'applying' stamp: 'HAW 10/18/2019 18:40:03'!
apply

	self
		lookForMethodsReferencingOldVariable;
		changeInstanceVariableName;
		logClassDefinition;
		renameReferencesToOldVariable.

	^renamedReferences
		! !

!RenameInstanceVariable reorganize!
('applying - private' changeInstanceVariableName keepMethodToChangeNamed:in: logClassDefinition lookForMethodsReferencingOldVariable lookForMethodsReferencingOldVariableIn: newSourceOf: renameReferencesToOldVariable renameReferencesToOldVariableInMethod:)
('applying' apply)
('initialization' initializeFrom:to:in:)
!


'From Cuis 5.0 of 7 November 2016 [latest update: #3620] on 20 February 2019 at 7:05:43 pm'!

!CodePackageList methodsFor: 'as yet unclassified' stamp: 'HAW 2/20/2019 19:05:23'!
methodNodeOf: aSourceCode ifErrorsParsing: aParsingErrorBlock

	^aParsingErrorBlock value: nil! !


Fix TextRunner layout. Thanks Shaping for the report.

'From Cuis 5.0 of 7 November 2016 [latest update: #3763] on 24 May 2019 at 10:05:57 am'!

!TestRunnerWindow methodsFor: 'GUI building' stamp: 'jmv 5/24/2019 10:04:35'!
buildUpperControls
	| refreshButton filterButton stopButton runOneButton runButton runProfiledButton row column1 column2 column3 theTestsList |

	refreshButton _ self buildRefreshButton.
	filterButton _ self buildFilterButton.
	stopButton _ self buildStopButton.
	column1 _ LayoutMorph newColumn.
	column1 doAdoptWidgetsColor.
	column1 addMorphs: { refreshButton . filterButton . stopButton }.

	theTestsList _ PluggableListMorphOfMany
				model: model
				listGetter: #tests
				primarySelectionGetter: #selectedSuite
				primarySelectionSetter: #selectedSuite:
				listSelectionGetter: #listSelectionAt:
				listSelectionSetter: #listSelectionAt:put:
				mainView: self
				menuGetter: #listMenu
				keystrokeAction: nil.
	theTestsList autoDeselect: false.
	theTestsList color: self textBackgroundColor.
	column2 _ LayoutMorph newColumn.
	column2
		addMorph: theTestsList proportionalHeight: 1;
		addMorph: self optionalButtonRow fixedHeight: self defaultButtonPaneHeight.

	runOneButton _ self buildRunOneButton.
	runButton _ self buildRunButton.
	runProfiledButton := self buildRunProfiledButton.
	column3 _ LayoutMorph newColumn.
	column3 doAdoptWidgetsColor.
	column3 addMorphs: { runOneButton . runButton . runProfiledButton }.

	row _ LayoutMorph newRow.
	row
		addMorph: column1 proportionalWidth: 0.1;
		addMorph: column2 proportionalWidth: 0.7;
		addMorph: column3 proportionalWidth: 0.2.

	^row

! !


Fix position of notifications in case of parsing failure

'From Cuis 5.0 [latest update: #4570] on 26 April 2021 at 3:43:21 pm'!

!Scanner methodsFor: 'multi-character scans' stamp: 'jmv 4/26/2021 15:26:05'!
xSingleQuote

	"String."

	self readUpToNext: $' ifNotFound: [
		^self notify: 'Unmatched string quote' at: mark + 1].
	tokenType := #string! !

!Parser methodsFor: 'public access' stamp: 'jmv 4/26/2021 15:12:23'!
parse: sourceStream class: class category: aCategory noPattern: noPattern doIt: doIt context: aContext notifying: aRequestor ifFail: aBlock

	"Answer a MethodNode for the argument, sourceStream, that is the root of
	 a parse tree. Parsing is done with respect to the argument, class, to find
	 instance, class, and pool variables; and with respect to the argument,
	 ctxt, to find temporary variables. Errors in parsing are reported to the
	 argument, req, if not nil; otherwise aBlock is evaluated. The argument
	 noPattern is a Boolean that is true if the the sourceStream does not
	 contain a method header (i.e., for DoIts)."

	| methNode repeatNeeded myStream sourceCode startPosition |

	category _ aCategory.
	myStream _ sourceStream.
	[
		repeatNeeded _ false.
		startPosition _ myStream position.
		sourceCode _ myStream upToEnd.
		myStream position: startPosition.
		self encoder init: class context: aContext notifying: self.
		"Protect against possible parsing failure"
		doIt ifTrue: [
			(sourceCode beginsWith: Scanner doItInSelector)
				ifTrue: [encoder selector: Scanner doItInSelector]
				ifFalse: [
					(sourceCode beginsWith: Scanner doItSelector)
						ifTrue: [encoder selector: Scanner doItSelector]]].
		self init: myStream notifying: aRequestor failBlock: [^ aBlock value ].
		doitFlag _ noPattern.
		failBlock _ aBlock.
		[ methNode _ self method: noPattern doIt: doIt context: aContext ]
			on: ReparseAfterSourceEditing
			do: [ :ex |
				repeatNeeded _ true.
				myStream _ ReadStream on: requestor text string ].
		repeatNeeded
	] whileTrue: [ encoder _ self encoder class new ].

	methNode sourceText: sourceCode.
	"See #xBacktick"
	sentInLiterals do: [ :sym | encoder noteOptimizedSelector: sym ].

	^ methNode! !


Fix MessageSet when class shown gets deleted. Thanks Hernán.

'From Cuis 5.0 of 7 November 2016 [latest update: #3674] on 19 March 2019 at 6:57:48 am'!

!MessageSet methodsFor: 'message list' stamp: 'HAW 3/19/2019 06:56:35'!
selectedMessage
	"Answer the source method for the currently selected message."

	| class selector |
	selectedMessage ifNil: [^ 'Class vanished'].

	class _ selectedMessage actualClass.
	selector _ selectedMessage methodSymbol.
	selector ifNil: [ ^'prims'].
	(class notNil and: [ class includesSelector: selector]) ifFalse: [
		currentCompiledMethod _ nil.
		^ 'Missing'].

	selector first isUppercase ifTrue: [
		selector == #Comment ifTrue: [
			currentCompiledMethod _ class organization commentRemoteStr.
			^ class comment].
		selector == #Definition ifTrue: [
			^ class definition].
		selector == #Hierarchy ifTrue: [^ class printHierarchy]].

	self showingDecompile ifTrue: [
		^ self decompiledSource ].

	currentCompiledMethod _ class compiledMethodAt: selector ifAbsent: nil.
	self showingDocumentation ifTrue: [
		^ self commentContents ].

	^self sourceStringPrettifiedAndDiffed! !


Make the FileList pattern entry field accept contents on <Enter>

'From Cuis 5.0 [latest update: #4923] on 14 October 2021 at 12:28:03 pm'!

!FileListWindow methodsFor: 'GUI building' stamp: 'hlsf 10/14/2021 12:27:46'!
morphicPatternPane

	^ (TextModelMorph
		textProvider: model
		textGetter: #pattern
		textSetter: #pattern:)
		acceptOnCR: true;
		yourself.! !


'From Cuis 5.0 [latest update: #4392] on 12 October 2020 at 7:18:56 pm'!

!MenuItemMorph methodsFor: 'selecting' stamp: 'jmv 10/12/2020 19:17:55'!
select
	self isSelected: true.
	owner activeSubmenu: subMenu.
	subMenu ifNotNil: [
		self displayBounds ifNotNil: [ :r |
			subMenu delete.
			subMenu
				popUpAdjacentTo: (Array with: r topRight + `10@0` with: r topLeft)
				from: self ].
		subMenu selectItem: nil ]! !


Fix to Theme, evident when loading StyledTextEditor

'From Cuis 5.0 of 7 November 2016 [latest update: #3068] on 26 March 2017 at 11:30:12 pm'!

!Theme class methodsFor: 'class initialization' stamp: 'jmv 3/26/2017 23:25:17'!
currentTheme: aTheme

	CurrentTheme := aTheme new.
	SHTextStylerST80 initialize.
	self runningWorld ifNotNil: [ :w |
		w backgroundImage ifNil: [
			w color: CurrentTheme background ]].
	SystemWindow initialize.
	BitBltCanvas releaseClassCachedState.
	self runningWorld ifNotNil: [ :w |
		CurrentTheme useTaskbar
			ifTrue: [w showTaskbar]
			ifFalse: [w hideTaskbar].
		w restoreMorphicDisplay ].

	^ CurrentTheme! !


Add test suite inspired on BlSubTextExamples

Class {
	#name : #BlSubTextTest,
	#superclass : #TestCase,
	#category : #'Bloc-Text-Rope-Tests'
}

{ #category : #running }
BlSubTextTest >> helloWorldText [

	^ BlRopedText string: 'HelloWorld'
]

{ #category : #tests }
BlSubTextTest >> testFromOneToZeroRepresentsEmptyText [

	| aSubText |
	aSubText := self helloWorldText from: 1 to: 0.

	self assert: aSubText start equals: 1.
	self assert: aSubText end equals: 0.
	self assert: aSubText isEmpty.
	self assert: aSubText size equals: 0.
	self assert: aSubText asString equals: ''.

]

{ #category : #tests }
BlSubTextTest >> testFromZeroToZeroSignalsTextOutOfBoundsError [
	"Detect it's not allowed"

	| aSubText anError |
	[ aSubText := self helloWorldText from: 0 to: 0. ]
		on: BlTextOutOfBoundsError
		do: [ :e | anError := e ].

	self assert: anError isNotNil.
	self assert: aSubText isNil.

]

{ #category : #tests }
BlSubTextTest >> testInsertAtZero [

	| aSubText |
	aSubText := self helloWorldText from: 1 to: 0.
	aSubText insertString: '0' at: 0.

	self assert: aSubText text asString equals: '0HelloWorld'.
	self assert: aSubText asString equals: '0'.

	self assert: aSubText start equals: 1.
	self assert: aSubText end equals: 1.
	self assert: aSubText isEmpty not.
	self assert: aSubText size equals: 1.
]

{ #category : #tests }
BlSubTextTest >> testInsertOutOfBoundsSignalsError [

	| aSubText anError |
	aSubText := self helloWorldText from: 1 to: 0.

	[ aSubText insertString: '1' at: 1 ]
		on: BlTextOutOfBoundsError
		do: [ :e | anError := e ].

	self assert: anError isNotNil.
	self assert: aSubText text asString equals: 'HelloWorld'.
	self assert: aSubText asString equals: ''.

	self assert: aSubText start equals: 1.
	self assert: aSubText end equals: 0.
	self assert: aSubText isEmpty.
	self assert: aSubText size equals: 0.

]


Add new trachel shape TRBezier with 4 control points

Class {
	#name : #TRBezier4Shape,
	#superclass : #TRBezier3Shape,
	#category : #'Trachel-Shapes'
}

{ #category : #hooks }
TRBezier4Shape >> computePath [
	path := self athensCanvas
		createPath: [ :builder |
			builder
				absolute;
				moveTo: listOfPoints first.
			builder
				curveViaX: listOfPoints second x asFloat Y: listOfPoints second y asFloat
				viaX: listOfPoints third x asFloat Y: listOfPoints third y asFloat
				toX: listOfPoints fourth x asFloat Y: listOfPoints fourth y asFloat.
		]
]

{ #category : #public }
TRBezier4Shape >> points: points [
	self assert: [ points size = 4 ] description: 'Only 3 points may be provided'.
	listOfPoints := points
]

{ #category : #public }
TRBezier4Shape >> points: aListOfPoints color: aColor [
	self assert: [ aListOfPoints size = 4 ] description: 'Only 3 points may be provided'.

	self points: aListOfPoints.
	self strokePaint: aColor.
	self color: aColor
]


Add a variant of border attach points that allows to customize the end attach point.

Class {
	#name : #RSHorizontalEndBorderAttachPoint,
	#superclass : #RSBorderAttachPoint,
	#category : #'Roassal3-Shapes-AttachPoint'
}

{ #category : #'public - hooks' }
RSHorizontalEndBorderAttachPoint >> basicEndingPointOf: edge [

	^ self
		  positionFor: edge to
		  in: edge
		  point: edge to encompassingRectangle leftCenter + (endOffset @ 0)
]


Fix a bug when autocorrecting a sent message at method save.

'From Cuis 5.0 of 7 November 2016 [latest update: #3564] on 8 January 2019 at 4:19:03 pm'!

!Parser methodsFor: 'error correction' stamp: 'jmv 1/8/2019 16:18:53'!
correctSelector: proposedKeyword wordIntervals: spots exprInterval: expInt ifAbort: abortAction
	"Correct the proposedKeyword to some selector symbol, correcting the original text if such action is indicated.  abortAction is invoked if the proposedKeyword couldn't be converted into a valid selector.  Spots is an ordered collection of intervals within the test stream of the for each of the keyword parts."

	| correctSelector userSelection correctedSpots |
	"If we can't ask the user, assume that the keyword will be defined later"
	self interactive ifFalse: [^proposedKeyword asSymbol].

	"If the requestor is of an exotic kind (like a telnet server) we might not be allowed to open a PupUpMenu for querying the user"
	"
	((requestor isKindOf: Editor) or: [ requestor is: #Morph ])
		ifFalse: [ ^ proposedKeyword asSymbol ].
	"

	userSelection _ requestor selectionInterval.
	requestor selectFrom: spots first first to: spots last last.

	correctSelector _ UnknownSelector name: proposedKeyword.
	correctSelector ifNil: [^abortAction value].

	requestor selectInvisiblyFrom: userSelection first to: userSelection last.

	correctedSpots _ spots with: proposedKeyword keywords collect: [ :interval :toCorrect | interval first to: interval first + toCorrect size-1].
	self substituteSelector: correctSelector keywords wordIntervals: correctedSpots.
	^(proposedKeyword last ~~ $:
	   and: [correctSelector last == $:])
		ifTrue: [abortAction value]
		ifFalse: [correctSelector]! !


'From Cuis 6.0 [latest update: #5466] on 25 August 2022 at 9:29:48 am'!

!SystemDictionary methodsFor: 'startup' stamp: 'jmv 8/25/2022 09:29:22'!
processCommandLineArgument: rawArgStream storeStartUpScriptArgsOn: startUpScriptArgs
	"
	Smalltalk processCommandLineArguments

	A possible example (duplicated single quotes: '' should be double quotes, but not allowed in a Smalltalk comment):
	Squeak.exe Cuis4.2-2211x.image -r RequiredFeature1 -rRequiredFeature2 -d ''Transcript show: 'popo1'; newLine'' -d''Transcript show: 'popo2'; newLine'' -s smalltalkScript.st paramAlScript1 paramAlSCript2 ''parametro al script ->>>--// 3''
	"
	| p data entry |
	p _ rawArgStream next.

	(p size > 1 and: [p first = $-]) ifTrue: [
		"If the command is not included in p, it is next argument"
		p size = 2
			ifTrue: [
				"as in 		-r RequiredFeature1"
				data _ rawArgStream next ]
			ifFalse: [
				"as in 		-rRequiredFeature2"
				data _ p copyFrom: 3 to: p size ].
		p second caseOf: {
			[ $r ] -> [		"as in 		-rRequiredFeature2"
				{ 'Feature require: '. data } print.
				[ Feature require: data ] on: UnhandledError do: [:ex | ex return] ].
			[ $d ] -> [		"as in 		-d ''Transcript show: 'popo1'; newLine'' -d''Transcript show: 'popo2'; newLine''        (duplicated singleQuotes should read doubleQuote)"
				{ 'Compiler evaluate: '. data } print.
				[ Compiler evaluate: data ] on: UnhandledError do: [:ex | ex return] ].
			[$l ] -> ["file in the file"
				{ 'File in: '. data} print.
				[(CodeFile newFromFile: data asFileEntry) fileIn] on: UnhandledError do: [:ex | ex return]].
			[ $s ] -> [		"as in 		-s smalltalkScript.st paramAlScript1 paramAlSCript2 ''parametro al script ->>>--// 3'' 			(duplicated singleQuotes should read doubleQuote)"
				[ rawArgStream atEnd ] whileFalse: [
					startUpScriptArgs nextPut: rawArgStream next ].
				"Can use 'Smalltalk startUpScriptArguments' inside the startUp script
				{ 'Compiler evaluate contents of file named: '. data. ' arguments: '. Smalltalk startUpScriptArguments } print."
				entry _ data asFileEntry.
				entry exists ifTrue: [
					entry readStreamDo: [ :stream |
						[ Compiler evaluate: stream contentsOfEntireFile ] on: UnhandledError do: [:ex | ex return]]].
				"Maybe we decide to clear them after startup script execution
				startUpScriptArguments _ nil" ]
		}
		otherwise: []
	]! !


'From Cuis 5.0 of 7 November 2016 [latest update: #2981] on 9 December 2016 at 10:27:21 am'!

!PasteUpMorph methodsFor: 'printing' stamp: 'jmv 12/9/2016 10:25:13'!
printOn: aStream
	"Reimplemented to add a tag showing that the receiver is currently functioning as a 'world', if it is"

	self isWorldMorph
		ifTrue: [aStream nextPutAll: ' [world]']
		ifFalse: [super printOn: aStream]! !


Set menu stay-up buttons color to transparent, so automatically gets the default menu color and icon is more visible

'From Cuis 4.2 of 25 July 2013 [latest update: #2577] on 16 November 2015 at 2:55:28.617298 am'!

!MenuMorph methodsFor: 'construction' stamp: 'len 11/16/2015 02:52'!
addStayUpIcons
	| closeBox pinBox w |
	Preferences optionalButtons ifFalse: [ ^self ].
	(self valueOfProperty: #hasStayUpIcons ifAbsent: [ false ])
		ifTrue: [
		 	self removeProperty: #needsStayUpIcons.
			^self ].
	titleMorph ifNil: [
		"Title not yet there. Flag ourself, so this method is called again when adding title."
		self setProperty: #needsStayUpIcons toValue: true.
		^ self].
	closeBox _ PluggableButtonMorph model: self action: #delete.
	closeBox icon: Theme current closeIcon; color: Color transparent.
	pinBox _ PluggableButtonMorph model: self action: #stayUp.
	pinBox icon: Theme current pushPinIcon; color: Color transparent.
	w _ (titleMorph hasSubmorphs ifTrue: [ titleMorph firstSubmorph morphWidth ] ifFalse: [ 0 ]) + 60.
	self addMorphFront:
		(LayoutMorph newRow
			"Make room for buttons"
			morphExtent: w @ (titleMorph morphHeight max: 19);
			color: Color transparent;
			addMorph: closeBox fixedWidth: 20;
			addMorph: (RectangleLikeMorph new color: Color transparent) fixedWidth: 4;
			addMorph: titleMorph proportionalWidth: 1;
			addMorph: (RectangleLikeMorph new color: Color transparent) fixedWidth: 4;
			addMorph: pinBox fixedWidth: 20).

	self setProperty: #hasStayUpIcons toValue: true.
	self removeProperty: #needsStayUpIcons! !


Fix to [install] from FileList. Thanks Ken.

'From Cuis 5.0 [latest update: #3905] on 8 October 2019 at 8:44:06 am'!

!FeatureRequirement methodsFor: 'requires' stamp: 'KenD 10/7/2019 10:59:06'!
satisfyRequirementsAndInstall
	"Like #require, but install me even if already satisified (i.e. installed)"

	| packagesToLoad |

	"Preflight before load"
	[packagesToLoad _ self requireUnlessIn: OrderedCollection new main: self]
		on: FeatureRequirementUnsatisfied
		do: [ :error | error defaultAction.
			^self "exit"
		].

	"Check to see that each requirement is actually satisfied"
	[packagesToLoad do: [ :fReq | fReq checkRequirement ]]
		on: FeatureRequirementUnsatisfied
		do: [ :error | error defaultAction.
			^self "exit"
		].

	"All requirements are satisfied; do the deed"
	packagesToLoad reverseDo: [ :requirement |
		requirement isAlreadySatisfied ifFalse: [
			requirement install ]].
	self install! !


Handle borders appropriately in TextParagraphMorph. Thanks Hilaire.

'From Cuis 5.0 [latest update: #4982] on 27 November 2021 at 9:22:52 am'!

!TextParagraphMorph methodsFor: 'accessing' stamp: 'jmv 11/27/2021 09:20:49'!
extentForComposing

	^ extent x - (4 * borderWidth) @ 9999999! !

!InnerTextMorph methodsFor: 'private' stamp: 'jmv 11/27/2021 09:20:26'!
extentForComposing

	^wrapFlag
		ifTrue: [ extent x @ 9999999 ]
		ifFalse: [ 9999999@9999999 ]! !

!TextParagraphMorph methodsFor: 'initialization' stamp: 'jmv 11/27/2021 09:22:04'!
initialize
	super initialize.
	textComposition _ TextComposition new.
	textComposition
		setModel: (TextModel withText: '');
		extentForComposing: self extentForComposing;
		composeAll.! !

!TextParagraphMorph methodsFor: 'drawing' stamp: 'hlsf 11/26/2021 10:59:52'!
drawOn: aCanvas
	super drawOn: aCanvas.
	aCanvas
		textComposition: textComposition
		bounds: (self morphLocalBounds insetBy: borderWidth * 2)
		color: Theme current text
		selectionColor: `Color red`.! !

!TextParagraphMorph methodsFor: 'geometry' stamp: 'jmv 11/27/2021 09:21:10'!
extentChanged: oldExtent
	"Our extent changed. Reflow text."
	super extentChanged: oldExtent.
	extent x = oldExtent x ifFalse: [
	textComposition
		initialize;
		extentForComposing: self extentForComposing;
		composeAll.
	self fit.
	(owner is: #ScrollPane) ifTrue: [
		owner
			updateScrollBarsBounds;
			setScrollDeltas ]].! !


Add rounded rectangle support on Alexandrie

Extension { #name : #BlRoundedRectangleGeometry }

{ #category : #'*Bloc-Alexandrie' }
BlRoundedRectangleGeometry >> aeApplyTo: aeCanvas element: aBlElement [

	aeCanvas
		setPathKey: self
		hasJoins: false
		hasCaps: false
		block: [ :cairoContext |
			cairoContext
				roundedRectangle: self geometryBounds
				radii: cornerRadii asArray ]

]


'From Cuis 5.0 of 7 November 2016 [latest update: #3426] on 19 August 2018 at 6:11:23 pm'!

!WorldState methodsFor: 'accessing' stamp: 'jmv 8/19/2018 18:11:12'!
runLocalStepMethods: nowTime
	"Run morph 'step' methods (LOCAL TO THIS WORLD) whose time has come. Purge any morphs that are no longer in this world."

	| stepMessage |
	[ stepList notEmpty and: [ stepList first scheduledTime <= nowTime ]]
		whileTrue: [
			stepMessage _ stepList first.
			(stepMessage receiver shouldGetStepsFrom: world)
				ifFalse: [ stepList removeFirst ]
				ifTrue: [
					stepMessage valueAtTime: nowTime.
					stepMessage rescheduleAfter: nowTime.
					"We've just updated the  scheduled time for stepMessage.
					It might have been that stepMessage was removed altogether from stepList.
					It also may be the case that stepList got added or removed other elements while on #valueAtTime:
					Just reSort. It will be ok in any case."
					stepList reSort.
					]
		]! !


'From Cuis 5.0 of 7 November 2016 [latest update: #3404] on 15 August 2018 at 3:42:44 pm'!

!MenuItemMorph methodsFor: 'events' stamp: 'jmv 8/15/2018 15:42:06'!
activateSubmenu: evt
	"Activate our submenu; e.g., pass control to it"
	subMenu ifNil: [ ^false ]. "not applicable"
	(subMenu morphContainsPoint: (subMenu internalizeFromWorld: evt eventPosition)) ifFalse:[^false].
	subMenu activate: evt.
	^true! !

!MenuItemMorph methodsFor: 'selecting' stamp: 'jmv 8/15/2018 15:41:44'!
deselect

	self isSelected: false.
	subMenu ifNotNil: [
		owner ifNotNil: [ owner activeSubmenu: nil ]]! !

!methodRemoval: MenuItemMorph #deselectTimeOut!
MenuItemMorph removeSelector: #deselectTimeOut!
!methodRemoval: MenuItemMorph #mouseLeave:!
MenuItemMorph removeSelector: #mouseLeave:!


Make non MovableMorph effectively non movable

'From Cuis 5.0 [latest update: #4447] on 10 November 2020 at 4:31:24 pm'!

!MovableMorph methodsFor: 'dropping/grabbing' stamp: 'jmv 11/10/2020 16:14:40'!
aboutToBeGrabbedBy: aHand
	"The receiver is being grabbed by a hand.
	Perform necessary adjustments (if any) and return the actual morph
	that should be added to the hand.
	Answer nil to reject the drag."

	^self "Grab me"! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'jmv 11/10/2020 16:15:25'!
aboutToBeGrabbedBy: aHand
	"The receiver is being grabbed by a hand.
	Perform necessary adjustments (if any) and return the actual morph
	that should be added to the hand.
	Answer nil to reject the drag."

	^nil  		"MovableMorphs can be grabbed and moved around with the hand"! !

!MorphicCanvas methodsFor: 'morphic' stamp: 'jmv 11/10/2020 16:09:55'!
drawCurrentAsError
	"The morph (or one of its submorphs) had an error in its drawing method."
	| r w |
	r _ currentMorph morphLocalBounds intersect: clipRect.
	r hasPositiveExtent ifFalse: [r _ clipRect ].
	w _ r extent > `50@50`
		ifTrue: [ 6 ]
		ifFalse: [ 2 ].
	self
		frameAndFillRectangle: r
		fillColor: `Color red`
		borderWidth: w
		borderColor: `Color yellow`.
	self line: r topLeft to: r bottomRight-w width: w color: `Color yellow`.
	self line: r topRight -(w@0) to: r bottomLeft -(0@w)width: w color: `Color yellow`! !

!MovableMorph reorganize!
('accessing' location)
('geometry' allocHeightForFactor: allocWidthForFactor: externalize: externalizeDisplayBounds: externalizeDistance: internalize: internalizeDistance: minimumLayoutExtent morphAlign:with: morphPosition morphPosition: morphPositionInWorld: orbitBy: referencePosition referencePosition: rotateBy: rotation: rotation:scale: rotationDegrees: scale scaleBy:)
('initialization' initialize openInWorld:)
('dropping/grabbing' aboutToBeGrabbedBy:)
('layout' minimumLayoutHeight minimumLayoutWidth minimumShrinkExtent minimumShrinkHeight minimumShrinkWidth)
('private' privateOwner: privatePosition:)
('layout-properties' layoutSpec layoutSpec:)
('testing' isProportionalHeight isProportionalWidth)
!


'From Cuis 5.0 of 7 November 2016 [latest update: #3401] on 10 August 2018 at 11:07:42 am'!

!SinglePackageBrowser methodsFor: 'lists' stamp: 'jmv 8/10/2018 11:05:40'!
defaultClassList
	"Answer an array of the class names of the selected category. Answer an
	empty array if no selection exists."
	| answer |
	answer _ selectedSystemCategory
		ifNil: [#()]
		ifNotNil: [
			(package includesSystemCategory: selectedSystemCategory)
				ifTrue: [ systemOrganizer listAtCategoryNamed: selectedSystemCategory ]
				ifFalse: [
					package extensionClassNamesIn: (selectedSystemCategory copyFrom: 2 to: selectedSystemCategory size) ]].
	selectedClassName ifNil: [
		answer size = 0 ifFalse: [
			selectedClassName _ answer first.
			self setClassOrganizer.
			self editSelection: #editClass ]].
	^answer! !

!methodRemoval: SinglePackageBrowser #classList!
SinglePackageBrowser removeSelector: #classList!


Make LabelMorph honor its borderWidth. Thanks Ken.

'From Cuis 5.0 [latest update: #4428] on 26 October 2020 at 11:30:04 am'!

!LabelMorph methodsFor: 'drawing' stamp: 'KenD 10/23/2020 13:37:36'!
drawOn: aCanvas
	aCanvas
		drawString: (contents ifNil: [ '' ])
		at: self morphTopLeft  + borderWidth
		font: self fontToUse
		color: color.
	(borderWidth > 0) ifTrue: [
		aCanvas
			frameRectangle: (0@0 extent: extent)
			color: borderColor
			borderWidth: borderWidth
			borderStyleSymbol: #simple ]! !


Fix to grabbed morph position. Hopefully correct this time.

'From Cuis 5.0 [latest update: #4583] on 3 May 2021 at 5:40:42 pm'!

!HandMorph methodsFor: 'grabbing/dropping' stamp: 'jmv 5/3/2021 17:39:58'!
grabMorph: aMorph moveUnderHand: moveUnderHand
	"Grab the given morph (i.e., add it to this hand and remove it from its current owner).
	If moveUnderHand is requested or it seems neccesary anyway, move the grabbed morph under the hand."

	| grabbed positionInHandCoordinates tx |
	self releaseMouseFocus.	"Break focus"
	grabbed _ aMorph.
	aMorph owner ifNotNil: [ :o | grabbed _ o aboutToGrab: aMorph ].
	grabbed ifNil: [ ^ self ].
	grabbed _ grabbed aboutToBeGrabbedBy: self.
	grabbed ifNil: [ ^ self ].

	moveUnderHand
		ifTrue: [
			"We can possibly do better, especially for non WidgetMorphs"
			positionInHandCoordinates _ -30 @ -10.
			grabbed isInWorld ifTrue: [
				grabbed displayBounds ifNotNil: [ :r |
					positionInHandCoordinates _ (r extent // 2) negated ]].
			self
				grabMorph: grabbed
				delta: positionInHandCoordinates.
			^self ].

	positionInHandCoordinates _ (grabbed isInWorld ifTrue: [grabbed] ifFalse: [aMorph])
		morphPositionInWorld - self morphPositionInWorld.

	tx _ GeometryTransformation identity.
	(grabbed isInWorld ifTrue: [grabbed] ifFalse: [aMorph]) withAllOwnersDo: [ :o |
		tx _ o location composedWith: tx ].
	self withAllOwnersReverseDo: [ :o |
		tx _ o location inverseTransformation composedWith: tx ].
	self
		grabMorph: grabbed
		delta: positionInHandCoordinates.

	grabbed location: tx.! !


Add StringSignal>>asDictionary and StringSignal class>>fromStonDictionary: back in

Extension { #name : #StringSignal }

{ #category : #'*Bloc' }
StringSignal >> asDictionary [

	^ super asDictionary
		at: #message put: message;
		yourself.
]

{ #category : #'*Bloc' }
StringSignal class >> fromStonDictionary: aDictionary [

	^(super fromStonDictionary: aDictionary)
		message: (aDictionary at: #message);
		yourself
]


Fix Shout bracket coloring. Thanks Phil.

'From Cuis 5.0 of 7 November 2016 [latest update: #3194] on 11 October 2017 at 12:29:51 pm'!

!SHParserST80 methodsFor: 'parse support' stamp: 'tween 4/28/2004 09:48'!
enterBlock
	blockDepth := blockDepth + 1.
	bracketDepth := bracketDepth + 1! !

!SHParserST80 methodsFor: 'parse support' stamp: 'jmv 3/2/2010 10:06'!
leaveBlock
	arguments removeKey: blockDepth ifAbsent: nil.
	temporaries removeKey: blockDepth ifAbsent: nil.
	blockDepth := blockDepth - 1.
	bracketDepth := bracketDepth - 1! !

!SHParserST80 methodsFor: 'parse' stamp: 'jmv 12/30/2016 10:51:03'!
parseBacktick
	self enterBlock.
	self scanPast: #backtick.
	currentTokenFirst == $| ifTrue: [self parseBlockTemporaries].
	self parseStatementList.
	self failUnless: currentTokenFirst == $`.
	self scanPast: #backtick.
	self leaveBlock! !

!SHParserST80 methodsFor: 'parse' stamp: 'jmv 10/11/2017 12:27:51'!
parseBlock

	"Just read $["
	blockDepths add: blockDepth+1.
	blockDepthsStartIndexes add: sourcePosition-1.

	self enterBlock.
	self scanPast: #blockStart level: bracketDepth.
	currentTokenFirst == $: ifTrue: [self parseBlockArguments].
	currentTokenFirst == $| ifTrue: [self parseBlockTemporaries].
	self parseStatementList.
	self failUnless: currentTokenFirst == $].

	"Just read $]"
	blockDepths add: blockDepth-1.
	blockDepthsStartIndexes add: sourcePosition.

	self scanPast: #blockEnd level: bracketDepth.
	self leaveBlock! !


Extension { #name : #BlTelemetryLogger }

{ #category : #'*Bloc-Spec2' }
BlTelemetryLogger >> inspectorTreeIn: aBuilder [
	<inspectorPresentationOrder: 3 title: 'Tasks Tree'>

	^ aBuilder newTree
		display: [ :each | each asString ];
		children: [ :each | each tasks ];
		items: (self recordings reverse collect: #task);
		yourself
]


Update new button command a Box Zoom for views

Class {
	#name : #GLMBoxZoomAction,
	#superclass : #GLMRoassal2Action,
	#category : #'Roassal2GT-Glamour-Actions'
}

{ #category : #'as yet unclassified' }
GLMBoxZoomAction >> execute [
	| int |
	int := RTZoomableBoxView new.
	self roassalView @ int.
]

{ #category : #'as yet unclassified' }
GLMBoxZoomAction >> title [
	^ 'Add Box zoom'
]


Fix autoselect, for instance, for class references.

'From Cuis 5.0 [latest update: #3878] on 19 September 2019 at 5:33:19 pm'!

!TextEditor methodsFor: 'new selection' stamp: 'jmv 9/19/2019 17:31:32'!
messageSendsRanges: aRanges
	"aRanges must be notEmpty"

	selectionStartBlocks := OrderedCollection new.
	selectionStopBlocks := OrderedCollection new.

	aRanges do: [ :range |
		selectionStartBlocks add: (textComposition characterBlockForIndex: range first).
		selectionStopBlocks add: (textComposition characterBlockForIndex: range last + 1) ].
	self selectFrom: aRanges last first to: aRanges last last! !

!TextModelMorph methodsFor: 'updating' stamp: 'jmv 9/19/2019 17:31:48'!
selectMessage

	| messageSendsRanges |

	messageSendsRanges := model textProvider messageSendsRangesOf: model autoSelectString.
	^ messageSendsRanges notEmpty
		ifTrue: [ self editor messageSendsRanges: messageSendsRanges ]; yourself! !

!TextModelMorph methodsFor: 'updating' stamp: 'jmv 9/19/2019 17:30:20'!
updateAutoSelect

	TextEditor abandonChangeText.	"no replacement!!"
	self selectMessage
		ifFalse: [ self selectString ].

	self textMorph updateFromTextComposition.
	^self scrollSelectionIntoView! !


tests
testCartesianOfThreeByThreeReturnsNineElements
	| model |
	model := KEModel new.
	model
		attributes:
			{(#status -> #(#S #I #R)).
			(#species -> #(#mosquito #reservoir1 #reservoir2))}.
	self assert: model compartments size equals: 9


Add back allButFirstDo: and allButLastDo:

'From Cuis 5.0 of 7 November 2016 [latest update: #3577] on 16 January 2019 at 8:40:56 am'!

!SequenceableCollection methodsFor: 'enumerating' stamp: 'jmv 1/16/2019 08:38:06'!
allButFirstDo: block

	2 to: self size do:
		[:index | block value: (self at: index)]! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'jmv 1/16/2019 08:38:18'!
allButLastDo: block

	1 to: self size - 1 do:
		[:index | block value: (self at: index)]! !


Fix to Base64MimeConverter. Thanks Nicola.

'From Cuis 5.0 [latest update: #4884] on 24 September 2021 at 11:22:34 am'!

!Base64MimeConverter class methodsFor: 'services' stamp: 'NM 9/24/2021 15:05:45'!
mimeEncode: aCollectionOrStream to: outStream
	self new
		dataStream: ((aCollectionOrStream is: #Stream)
			ifTrue: [aCollectionOrStream]
			ifFalse: [ReadStream on: aCollectionOrStream]);
		mimeStream: outStream;
		multiLine: true;
		mimeEncode! !


'From Cuis 6.0 [latest update: #5297] on 15 June 2022 at 5:02:15 pm'!

!SourceCodeInterval class methodsFor: 'error messages' stamp: 'jmv 6/15/2022 17:01:29'!
canNotExpandIncompleteStatementError

	^ 'Can not expand an incomplete statement'.! !


Add the full path of the running image to World / Help / About this system...

'From Cuis 5.0 [latest update: #4745] on 10 August 2021 at 10:36:39 am'!

!SystemDictionary methodsFor: 'sources, change log' stamp: 'jmv 8/10/2021 10:35:47'!
systemInformationString
	"Identify software version"
	^ SystemVersion current version, String newLineString,
		self lastUpdateString, String newLineString,
		'Running at :', self imageName.! !


Fix possible walkback in taskbar window preview

'From Cuis 5.0 [latest update: #4187] on 25 May 2020 at 10:51:22 pm'!

!Morph methodsFor: 'previewing' stamp: 'jmv 5/25/2020 22:49:11'!
endPreview

	self previewing ifTrue: [
		self visible: self visibleBeforePreview.
		owner notNil ifTrue: [ owner addMorph: self inFrontOf: self morphBehindBeforePreview ].
		self previewing: false. ]! !


Add support for dynamik keystroke handlers to TextMorphs. Thanks Hernan.

'From Cuis 5.0 of 7 November 2016 [latest update: #3805] on 26 June 2019 at 9:02:51 am'!

!InnerTextMorph methodsFor: 'events' stamp: 'HAW 6/26/2019 09:02:18'!
keyStroke: aKeyboardEvent

	(self focusKeyboardFor: aKeyboardEvent)
		ifTrue: [ ^ self ].

	autoCompleter
		ifNil: [ self processKeyStroke: aKeyboardEvent ]
		ifNotNil: [
			autoCompleter
				autoCompletionAround: [ self processKeyStroke: aKeyboardEvent ]
				keyStroke: aKeyboardEvent ].

	super keyStroke: aKeyboardEvent! !


Add a Preference to control styling with emphasis (bold, italic) in Workspaces.

'From Cuis 5.0 [latest update: #4541] on 22 March 2021 at 5:18:56 pm'!

!Preferences class methodsFor: 'personalization' stamp: 'jmv 3/22/2021 17:18:15'!
stylingWithEmphasisInWorkspaces
	^ self
		valueOfFlag: #stylingWithEmphasisInWorkspaces
		ifAbsent: [false]! !

!Workspace methodsFor: 'user interface support' stamp: 'jmv 3/22/2021 17:17:29'!
allowStylingWithEmphasis
	"Disabled by default for faster styling of large contents, as text metrics are not affected by styling."

	^ Preferences stylingWithEmphasisInWorkspaces! !


Add back lost source code for a method in Debugger. Thanks Hernán.

'From Cuis 5.0 [latest update: #3826] on 5 August 2019 at 10:56:29 am'!

!Debugger methodsFor: 'private' stamp: 'jmv 8/5/2019 10:51:08'!
contextStackIndex: anInteger oldContextWas: oldContext
	"Change the context stack index to anInteger, perhaps in response to user selection."

	| isNewMethod selectedContextSlotName index |
	contextStackIndex _ anInteger.
	anInteger = 0 ifTrue: [
		currentCompiledMethod _ nil.
		self changed: #contextStackIndex.
		self acceptedContentsChanged.
		contextVariablesInspector object: nil.
		self fixReceiverInspector.
		^ self ].
	selectedContextSlotName _ contextVariablesInspector selectedSlotName.
	isNewMethod _ oldContext == nil
					or: [ oldContext method ~~ (currentCompiledMethod _ self selectedContext method) ].
	isNewMethod ifTrue: [
		self acceptedContentsChanged.
		self pcRange ].
	self changed: #contextStackIndex.
	self triggerEvent: #decorateButtons.
	contextVariablesInspector object: self selectedContext.
	((index _ contextVariablesInspector fieldList indexOf: selectedContextSlotName) ~= 0 and: [
		index ~= contextVariablesInspector selectionIndex ]) ifTrue: [
			contextVariablesInspector toggleIndex: index ].
	self fixReceiverInspector.
	isNewMethod ifFalse: [ self changed: #contentsSelection ].! !


Add example to directly load the software

Gofer new
    url: 'filetree://./mc';
    package: 'BaselineOfShortMessageCenter';
    load.

Metacello new
    baseline: 'ShortMessageCenter';
    repository: 'filetree://./mc';
    load: 'default'


'From Cuis 5.0 [latest update: #4961] on 1 November 2021 at 9:52:29 am'!

!InnerTextMorph methodsFor: 'selection' stamp: 'jmv 7/29/2012 15:12'!
scrollSelectionIntoView

	(owner is: #ScrollPane) ifTrue: [
		owner scrollSelectionIntoView ]! !


Fix walkback when changing context in debugger with text entered in the bottom right ContextVariablesInspector.

'From Cuis 6.0 [latest update: #5044] on 18 January 2022 at 3:53:57 pm'!

!ContextVariablesInspector methodsFor: 'shout styling' stamp: 'jmv 1/18/2022 15:53:28'!
bindingNamesDo: aBlock
	self fieldList do: aBlock! !

!ContextVariablesInspector methodsFor: 'shout styling' stamp: 'jmv 1/18/2022 15:53:22'!
hasBindingOf: aString
	^ self fieldList includes: aString! !


Fix to Collection printElementsOn. Thanks Gerald.

'From Haver 6.0 [latest update: #5496] on 20 October 2022 at 5:12:50 pm'!

!Collection methodsFor: 'printing' stamp: 'KLG 10/20/2022 17:11:30'!
printElementsOn: aStream
	"Print my elements on aStream."

	aStream nextPut: $(.
	self do: [ :element | aStream print: element ] separatedBy: [ aStream space ].
	aStream nextPut: $)! !


Fix to position of alternative morph to grab

'From Cuis 5.0 [latest update: #4582] on 3 May 2021 at 10:59:54 am'!

!HandMorph methodsFor: 'grabbing/dropping' stamp: 'jmv 5/3/2021 10:57:05'!
grabMorph: aMorph moveUnderHand: moveUnderHand
	"Grab the given morph (i.e., add it to this hand and remove it from its current owner).
	If moveUnderHand is requested or it seems neccesary anyway, move the grabbed morph under the hand."

	| grabbed positionInHandCoordinates tx |
	self releaseMouseFocus.	"Break focus"
	grabbed _ aMorph.
	aMorph owner ifNotNil: [ :o | grabbed _ o aboutToGrab: aMorph ].
	grabbed ifNil: [ ^ self ].
	grabbed _ grabbed aboutToBeGrabbedBy: self.
	grabbed ifNil: [ ^ self ].

	moveUnderHand
		ifTrue: [
			"We can possibly do better, especially for non WidgetMorphs"
			positionInHandCoordinates _ -30 @ -10.
			grabbed isInWorld ifTrue: [
				grabbed displayBounds ifNotNil: [ :r |
					positionInHandCoordinates _ (r extent // 2) negated ]].
			self
				grabMorph: grabbed
				delta: positionInHandCoordinates.
			^self ].

	positionInHandCoordinates _ (grabbed isInWorld ifTrue: [grabbed] ifFalse: [aMorph])
		morphPositionInWorld - self morphPositionInWorld.

	tx _ GeometryTransformation identity.
	grabbed withAllOwnersDo: [ :o |
		tx _ o location composedWith: tx ].
	self withAllOwnersReverseDo: [ :o |
		tx _ o location inverseTransformation composedWith: tx ].

	self
		grabMorph: grabbed
		delta: positionInHandCoordinates.

	grabbed location: tx.! !


Fix to tile windows when no windows to tile. Thanks Mariano.

'From Cuis 5.0 of 7 November 2016 [latest update: #3445] on 17 September 2018 at 5:37:57 pm'!

!TileResizeMorph class methodsFor: 'as yet unclassified' stamp: 'MM 9/17/2018 17:36:57'!
tileOpenWindows

	|windows regions i |

	windows _ (SystemWindow
		windowsIn: self runningWorld
		satisfying: [ :w | w visible]).

	windows ifEmpty: [^ self].

	regions _ self calculateTileRegions: windows size.

	i _ 1.
	windows do: [:w | |r|
		r _ regions at: i.
		w resize: r.
		i _ i + 1]! !


Adjust taskbar height when selecting default font. Thanks Gerald.

'From Cuis 5.0 [latest update: #4748] on 10 August 2021 at 1:47:40 pm'!

!TaskbarMorph methodsFor: 'notifications' stamp: 'jmv 8/10/2021 13:47:11'!
fontPreferenceChanged
	clock font: nil.
	self scale: self scale.! !


Fix bug when setting an empty String to a Balloon.

'From Cuis 6.0 [latest update: #5092] on 8 March 2022 at 9:11:26 pm'!

!Morph methodsFor: 'halos and balloon help' stamp: 'HAW 3/8/2022 20:40:29'!
showBalloon: msgStringOrText hand: aHand
	"Pop up a balloon containing the given string,
	first removing any existing BalloonMorphs in the world."

	| doWordWrap msg |
	doWordWrap _ true.
	msg _ msgStringOrText.
	(msgStringOrText notEmpty and: [ msgStringOrText last isLineSeparator ]) ifTrue: [
		doWordWrap _ false.
		msg _ msg allButLast ].
	self
		showBalloon: msg
		hand: aHand
		doWordWrap: doWordWrap.! !


Test RUle manager cache invalidation on class add

tests
testClassAdded

	| rule rulesCount |

	ReRuleManager reset.

	rulesCount := ReRuleManager default nodeRules size.

	rule := ReNodeMatchRule
		subclass: #ReRuleManagerTestingRule
		instanceVariableNames: ''
		classVariableNames: ''
		category: testPackage name.

	rule compile: 'name ^ ''test'''.

	self
		assert: ReRuleManager default nodeRules size - rulesCount
		equals: 1.

	self assert:
		(ReRuleManager default allRules anySatisfy: [ :r |
			r class == rule ]).

	rule removeFromSystem.


'From Cuis 5.0 [latest update: #4183] on 25 May 2020 at 10:31:26 am'!

!CodeWindow methodsFor: 'misc' stamp: 'len 5/25/2020 07:08:44'!
sendQuery: querySelector to: queryPerformer
	"Apply a query to the primary selector associated with the current context.  If no such selection exists, obtain one by user type-in. Then send querySelector to queryPerformer with the selector as its argument."

	model selectedMessageName ifNotNil: [:aSymbol| ^ queryPerformer perform: querySelector with: aSymbol].
	self request: 'Type selector:' initialAnswer: 'flag:' verifying: [:aString| aString notEmpty] do: [:aString|
		(Symbol hasInterned: aString ifTrue: [ :aSymbol | queryPerformer perform: querySelector with: aSymbol])
			ifFalse: [self inform: 'no such selector']]! !


Add more test for p=2 in Kleinberg model

tests
testNumberOfPathsOfLengthOnInKleinbergWithPEqualsTwoIsTwelve
	| grid2D |
	grid2D := KEKleinbergContactNetwork new
		nodes: (1 to: 25 * 25);
		n: 25;
		p: 2;
		q: 0;
		r: 2.
	grid2D run.
	self assert: (grid2D pathOfLength: 1 startingFrom: (grid2D nodes at: 90)) size equals: 12


Fix to TextParagraphMorph. Last visible line could draw outside morph bounds.

'From Cuis 5.0 [latest update: #4990] on 30 November 2021 at 2:05:56 pm'!

!MorphicCanvas methodsFor: 'drawing-text' stamp: 'jmv 11/30/2021 13:58:15'!
textComposition: aTextComposition bounds: boundsRect color: c selectionColor: sc avoidOverhang: strict
	"strict boolean controls whether to avoid or include the last line, if it doesn't fully fit in boundsRect"

	| displayScanner leftInRun line possibleVisibleLocalRect textTopLeft |

	textTopLeft _ boundsRect topLeft.
	possibleVisibleLocalRect _ currentTransformation boundsOfInverseTransformOf: self clipRect.
	possibleVisibleLocalRect _ possibleVisibleLocalRect intersect: boundsRect.
	possibleVisibleLocalRect _ possibleVisibleLocalRect translatedBy: boundsRect topLeft negated.

	displayScanner _ MorphicScanner new
		defaultFont: aTextComposition defaultFont;
		text: aTextComposition textComposed
		foreground: c.
	displayScanner canvas: self.

	leftInRun _ 0.
	"Take clipRect into account. Extrememly fast scrolls and redraws of huge files (like .sources)"
	(aTextComposition lineIndexForPoint: (possibleVisibleLocalRect topLeft - textTopLeft max: `0@0`) )
		to: (aTextComposition lineIndexForPoint: (possibleVisibleLocalRect bottomRight - textTopLeft min: boundsRect bottomRight))
		do: [ :i |
			line _ aTextComposition lines at: i.
			(strict not or: [ line top + line baseline < possibleVisibleLocalRect bottom ]) ifTrue: [
				aTextComposition
					displaySelectionInLine: line
					on: self
					textTopLeft: textTopLeft
					selectionColor: sc.
				leftInRun _ displayScanner displayLine: line textTopLeft: textTopLeft leftInRun: leftInRun ]]! !

!TextParagraphMorph methodsFor: 'drawing' stamp: 'jmv 11/30/2021 13:59:22'!
drawOn: aCanvas
	aCanvas
		fillRectangle: self morphLocalBounds color: color.
	aCanvas
		textComposition: textComposition
		bounds: (self morphLocalBounds insetBy: borderWidth * 2)
		color: Theme current text
		selectionColor: `Color red`
		avoidOverhang: true.
	aCanvas
		frameRectangle: self morphLocalBounds
		color: borderColor
		borderWidth: borderWidth
		borderStyleSymbol: nil! !

!MorphicCanvas methodsFor: 'drawing-text' stamp: 'jmv 11/30/2021 13:58:53'!
textComposition: aTextComposition bounds: boundsRect color: c selectionColor: sc

	self textComposition: aTextComposition bounds: boundsRect color: c selectionColor: sc avoidOverhang: false! !


'From Cuis 5.0 of 7 November 2016 [latest update: #3450] on 22 September 2018 at 3:33:36 pm'!

!Number class methodsFor: 'instance creation' stamp: 'jmv 9/22/2018 09:01:25'!
readRemainderOf: integerPart from: aStream base: base withSign: sign
	"Read optional fractional part and exponent, and return the final result"
	| value fraction fracpos peekChar |

	value := integerPart.
	(aStream peekFor: $.)
		ifTrue: [		 "<integer>.<fraction>"
			(aStream atEnd not and: [ aStream peek digitValue between: 0 and: base - 1 ])
				ifTrue:  [
					fracpos := aStream position.
					fraction := Integer readFrom: aStream base: base.
					fraction := fraction / (base raisedTo: aStream position - fracpos).
					value := value asFloat + fraction]
				ifFalse: [
					"oops - just <integer>."
					aStream skip: -1.
					"un-gobble the period"
					^ value * sign"Number readFrom: '3r-22.2'"]].
	peekChar := aStream peek.
	peekChar = $e | (peekChar = $d) | (peekChar = $q)
		ifTrue: [			"<number>(e|d|q)<exponent>>"
			aStream next.
			(aStream atEnd not and: [ (aStream peek digitValue between: 0 and: 9) or: [ aStream peek = $- ]])
				ifTrue:  [
					value := value * (base raisedTo: (Integer readFrom: aStream)) ]
				ifFalse: [
					"oops - just <number>."
					aStream skip: -1.]].
	^(value isFloat
		and: [ value = 0.0 and: [ sign = -1 ]])
			ifTrue: [ Float negativeZero ]
			ifFalse: [ value * sign ]! !


Fix to subtle bugin morphic display repair

'From Cuis 5.0 [latest update: #4477] on 24 November 2020 at 5:12:33 pm'!

!MorphicCanvas methodsFor: 'morphic world' stamp: 'jmv 11/24/2020 17:12:19'!
computeDamage: aWorldMorph repair: aDamageRecorder rootMorphs: rootMorphs rootMorphsDamage: rootMorphsDamage
	"Iterate front to back while computing damage to actually repair for each morph, and for world background.
	Answer uncoveredDamage, the areas where World background needs to be redrawn."

	| uncoveredDamage morph morphDamage prevMorphDamage reuseInstance morphBefore |
	morphDamage _ OrderedCollection new.
	prevMorphDamage _ OrderedCollection new.
	uncoveredDamage _ aDamageRecorder damageReportedOther.
	"Iterate from front to back"
	1 to: rootMorphs size do: [ :i |
		morph _ rootMorphs at: i.
		morphDamage removeAll.
		(aDamageRecorder damageReportedFor: morph) ifNotNil: [ :r |
			morphDamage add: r ].
		morph displayFullBounds ifNotNil: [ :morphFullBounds |
			uncoveredDamage do: [ :r | | intersection |
				intersection _ r intersect: morphFullBounds.
				intersection hasPositiveExtent ifTrue: [
					morphDamage add: intersection ]]].
		1 to: i-1 do: [ :j |
			reuseInstance _ prevMorphDamage.
			prevMorphDamage _ morphDamage.
			morphDamage _ reuseInstance removeAll.
			morphBefore _ rootMorphs at: j.
			prevMorphDamage do: [ :r |
				morphBefore addPossiblyUncoveredAreasIn: r to: morphDamage ]].
		(Rectangle merging: morphDamage) ifNotNil: [ :morphDamageRect |
			rootMorphsDamage at: i put: morphDamageRect.
			morph addPossiblyUncoveredAreasIn: morphDamageRect to: uncoveredDamage ]].

	^ uncoveredDamage! !

!MorphicCanvas methodsFor: 'morphic world' stamp: 'jmv 11/24/2020 17:12:08'!
drawWorld: aWorldMorph rootMorphs: rootMorphs rootMorphsDamage: rootMorphsDamage allDamage: worldDamage
	"Redraw the damaged areas.
	Draw each morph just once, merging rectanges to be repaired as needed."

	| morph morphDamage |

	"Iterate from back to front."
	rootMorphs size to: 1 by: -1 do: [ :i |
		morph _ rootMorphs at: i.
		morph visible ifTrue: [
			morphDamage _ rootMorphsDamage at: i.
			morph displayFullBounds ifNotNil: [ :morphFullBounds |
				worldDamage do: [ :r | | intersection |
					intersection _ r intersect: morphFullBounds.
					intersection hasPositiveExtent ifTrue: [
						morphDamage _ intersection quickMerge: morphDamage ]]].
			morphDamage ifNotNil: [
				self newClipRect: morphDamage.
				self fullDraw: morph.
				worldDamage add: morphDamage ]]].! !


'From Cuis 6.0 [latest update: #5064] on 8 February 2022 at 9:29:26 am'!

!WorldMorph methodsFor: 'world menu' stamp: 'MM 2/8/2022 09:25:39'!
findAWindowSatisfying: qualifyingBlock orMakeOneUsing: makeBlock
	"Locate a window satisfying a block, open it, and bring it to the front.  Create one if necessary, by using the makeBlock"
	| aWindow |
	submorphs do: [ :aMorph |
		(((aWindow _ aMorph) is: #SystemWindow) and: [ qualifyingBlock value: aWindow ]) ifTrue: [
			aWindow isCollapsed ifTrue: [ aWindow expand ].
			aWindow activateAndForceLabelToShow.
			^ aWindow ]].
	"None found, so create one"
	^ makeBlock value.! !


Fix recent breakage in SmalltalkCompleter

'From Cuis 5.0 [latest update: #4253] on 27 July 2020 at 6:40:16 pm'!

!ClassNameCompleter methodsFor: 'testing' stamp: 'HAW 2/21/2019 16:01:01'!
canShowSelectorDocumentation

	^false! !

!SmalltalkCompleter methodsFor: 'testing' stamp: 'HAW 2/21/2019 16:06:32'!
canShowSelectorDocumentation

	^canShowSelectorDocumentation ! !


'From Cuis 5.0 [latest update: #4782] on 21 August 2021 at 2:35:24 pm'!

!WorldMorph methodsFor: 'stepping' stamp: 'jmv 8/21/2021 14:33:52'!
runLocalStepMethods: nowTime
	"Run morph 'step' methods whose time has come. Purge any morphs that are no longer in this world."

	| stepMessage |
	[ stepList notEmpty and: [ (stepMessage _ stepList first) scheduledTime <= nowTime ]]
		whileTrue: [
			(stepMessage receiver shouldGetStepsFrom: self)
				ifFalse: [
					stepList remove: stepMessage ifAbsent: []]
				ifTrue: [
					stepMessage valueAtTime: nowTime.
					stepMessage rescheduleAfter: nowTime.
					"We've just updated the  scheduled time for stepMessage.
					It might have been that stepMessage was removed altogether from stepList.
					It also may be the case that stepList got added or removed other elements while on #valueAtTime:
					Just reSort. It will be ok in any case."
					stepList reSort ]].! !


'From Cuis 5.0 of 7 November 2016 [latest update: #2981] on 18 November 2016 at 10:49:39 am'!

!TheWorldMenu methodsFor: 'construction' stamp: 'jmv 5/3/2015 10:19'!
newMorph
	"The user requested 'new morph' from the world menu.  Put up a menu that allows many ways of obtaining new morphs.  If the preference #classicNewMorphMenu is true, the full form of yore is used; otherwise, a much shortened form is used."
	| menu subMenu catDict shortCat class |
	menu _ self menu: 'Add a new morph'.
	menu

		add: 'From Clipboard'
		target: myHand
		action: #pasteMorph;

		add: 'From Alphabetical List'
		subMenu: self alphabeticalMorphMenu.
	menu addLine.

	"Add 'Classic' New Morph menu"
	catDict _ Dictionary new.
	SystemOrganization categories do: [ :cat |
		((cat beginsWith: 'Morphic-') and: [ (#('Morphic-Menus' 'Morphic-Support' ) includes: cat) not ]) ifTrue: [
			shortCat _ (cat
				copyFrom: 'Morphic-' size + 1
				to: cat size).
			(SystemOrganization listAtCategoryNamed: cat) do: [ :cName |
				class _ Smalltalk at: cName.
				((class inheritsFrom: Morph) and: [ class includeInNewMorphMenu ]) ifTrue: [
					(catDict includesKey: shortCat)
						ifTrue: [ (catDict at: shortCat) addLast: class ]
						ifFalse: [
							catDict
								at: shortCat
								put: (OrderedCollection with: class) ]]]]].
	catDict keys sort do: [ :categ |
		subMenu _ MenuMorph new.
		((catDict at: categ) asArray sort: [ :c1 :c2 |
			c1 name < c2 name ]) do: [ :cl |
			subMenu
				add: cl name
				target: self
				selector: #newMorphOfClass:event:
				argument: cl ].
		menu
			add: categ
			subMenu: subMenu ].

	self doPopUp: menu.! !


Remove possible BOM when creating instances of Utf8String.

'From Cuis 6.0 [latest update: #5162] on 13 May 2022 at 8:38:50 pm'!

!Utf8String class methodsFor: 'instance creation' stamp: 'jmv 5/13/2022 20:37:37'!
withBytes: aByteArray
	"Remove a possible and useless BOM (byte order mark)"

	| bom bytesToUse |
	bom _ `Character utf8BytesOfUnicodeCodePoint: 16rFEFF`.
	bytesToUse _ (aByteArray beginsWith: bom)
		ifFalse: [aByteArray]
		ifTrue: [aByteArray copyFrom: bom size+1 to: aByteArray size].
	^self new bytes: bytesToUse ! !


Add two private accessors to LayoutSpec for the benefit of Erudite

'From Cuis 5.0 [latest update: #4122] on 26 April 2020 at 9:46:37 pm'!

!LayoutSpec methodsFor: 'layout' stamp: 'jmv 4/26/2020 21:46:01'!
privateFixedHeight

	^fixedHeight! !

!LayoutSpec methodsFor: 'layout' stamp: 'jmv 4/26/2020 21:46:11'!
privateProportionalHeight

	^ proportionalHeight! !


Fix to PluggableButtonMorph. A PluggableMorph is always dependent of its model.

'From Cuis 6.0 [latest update: #5097] on 7 April 2022 at 2:44:30 pm'!
!methodRemoval: PluggableButtonMorph #model: stamp: 'jmv 4/7/2022 14:44:11'!
PluggableButtonMorph removeSelector: #model:!


Add open working copy command calling iceberg

Class {
	#name : #PBOpenProjectWorkingCopyCommand,
	#superclass : #CGOProjectCommand,
	#category : #'CargoPackageManager-Calypso-Browser-Commands'
}

{ #category : #accessing }
PBOpenProjectWorkingCopyCommand class >> canBeExecutedInContext: aToolContext [

	^ (aToolContext isProjectSelected and: [ aToolContext selectedProjectItems size = 1 ])
		and: [ aToolContext selectedProjectItems first actualObject project hasRepository ]
]

{ #category : #accessing }
PBOpenProjectWorkingCopyCommand class >> defaultMenuIconName [
	^#monticelloPackage

]

{ #category : #activation }
PBOpenProjectWorkingCopyCommand class >> systemBrowserMenuActivator [
	<classAnnotation>

	^ CmdContextMenuActivation
		byItemOf: CGOSCMMenuGroup
		order: 10000
		for: PBProjectUIItem asCalypsoItemContext
]

{ #category : #activation }
PBOpenProjectWorkingCopyCommand class >> systemBrowserShortcutActivator [
	<classAnnotation>

	^ CmdShortcutActivation by: $s meta for: PBProjectUIItem asCalypsoItemContext
]

{ #category : #activation }
PBOpenProjectWorkingCopyCommand class >> systemBrowserToolbarActivator [
	<classAnnotation>

	^ ClyToolbarActivation
		byItemOf: ClyButtonToolbarGroup
		order: 1010
		for: PBProjectUIItem asCalypsoItemContext , ClyEmptyClassSelectionContext new
]

{ #category : #initialization }
PBOpenProjectWorkingCopyCommand >> defaultMenuItemName [
	^ 'Repository'
]

{ #category : #execution }
PBOpenProjectWorkingCopyCommand >> execute [

	(IceTipWorkingCopyBrowser onRepository: project project repository iceRepository) openWithSpec
]


Fix for MinimalWindows visual themes. Thanks Luciano.

'From Cuis 5.0 [latest update: #4134] on 6 May 2020 at 12:17:40 pm'!

!SystemWindow methodsFor: 'label' stamp: 'len 5/1/2020 06:34:51'!
labelHeight
	"Answer the height for the window label."
	Theme current minimalWindows ifTrue: [^ 0].
	^ Preferences windowTitleFont lineSpacing+1! !


Add new trachel shape TRBezier with 4 control points

Class {
	#name : #TRBezier4Shape,
	#superclass : #TRBezier3Shape,
	#category : #'Trachel-Shapes'
}

{ #category : #hooks }
TRBezier4Shape >> computePath [
	path := self athensCanvas
		createPath: [ :builder |
			builder
				absolute;
				moveTo: listOfPoints first.
			builder
				curveViaX: listOfPoints second x asFloat Y: listOfPoints second y asFloat
				viaX: listOfPoints third x asFloat Y: listOfPoints third y asFloat
				toX: listOfPoints fourth x asFloat Y: listOfPoints fourth y asFloat.
		]
]

{ #category : #public }
TRBezier4Shape >> points: points [
	self assert: [ points size = 4 ] description: 'Only 3 points may be provided'.
	listOfPoints := points
]

{ #category : #public }
TRBezier4Shape >> points: aListOfPoints color: aColor [
	self assert: [ aListOfPoints size = 4 ] description: 'Only 3 points may be provided'.

	self points: aListOfPoints.
	self strokePaint: aColor.
	self color: aColor
]


Fix old shaped Colors in SmartRefStream (thanks Ken)

'From Cuis 5.0 of 7 November 2016 [latest update: #3119] on 22 June 2017 at 12:54:43 pm'!

!Color methodsFor: 'as yet unclassified' stamp: 'jmv 6/22/2017 12:54:10'!
convertToCurrentVersion: varDict refStream: smartRefStrm

	"subclasses should implement if they wish to convert old instances to modern ones"
	self size = 0 ifTrue: [
		^ Color new copyFrom: (varDict at: 'floatRGB') ].
	^ self! !


Update for PreferenceNG's visitor. Thanks Hilaire.

'From Cuis 6.0 [latest update: #5171] on 17 May 2022 at 9:49:40 pm'!

!PreferenceNG methodsFor: 'accessing' stamp: 'hlsf 5/17/2022 21:49:10'!
accept: aVisitor
	| visitMethod |
	self isTypeAClass
		ifTrue: [ visitMethod _ ('visit', type name, 'Preference:') asSymbol ]
		ifFalse: [visitMethod _ ('visit', type species asString, 'Preference:') asSymbol ].
	^ aVisitor perform: visitMethod with: self! !


Fix to BitBltCanvas when displaying a 16bpp Form. Thanks Phil.

'From Cuis 5.0 of 7 November 2016 [latest update: #3134] on 9 August 2017 at 11:37:48 am'!

!BitBltCanvas methodsFor: 'drawing-images' stamp: 'jmv 8/9/2017 11:37:34'!
image: aForm at: aPoint sourceRect: sourceRect
	"Draw a translucent image using the best available way of representing translucency.
	Note: This will be fixed in the future."
	| r p |
	p _ (currentTransformation transform: aPoint) rounded.
	r _ (self depth < 32 or: [ aForm mightBeTranslucent not ])
		ifTrue: [
			"Rule Form paint treats pixels with a value of zero as transparent"
			Form paint ]
		ifFalse: [ Form blend ].
	port colorMap: (aForm colormapIfNeededFor: form); fillColor: nil.
	port image: aForm at: p sourceRect: sourceRect rule: r.
	(self depth = 32 and: [ aForm depth < 32 ]) ifTrue: [
		"If we blit to 32bpp from one of smaller depth,
		it will have zero in the alpha channel (until BitBlt is fixed!!)
		This is the same workaround as in #asFormOfDepth:"
		port sourceForm: nil.
		port combinationRule: 40. "fixAlpha:with:"
		port copyBits ]! !


Add RasPi tinyBenchmarks sample runs (thanks Phil)

'From Cuis 4.2 of 25 July 2013 [latest update: #2918] on 23 August 2016 at 11:38:26 am'!

!Integer methodsFor: 'benchmarks' stamp: 'jmv 8/23/2016 11:37:09'!
tinyBenchmarks
	"Report the results of running the two tiny Squeak benchmarks.
	ar 9/10/1999: Adjusted to run at least 1 sec to get more stable results
	0 tinyBenchmarks
		292 MHz G3 Mac: 				        			 22,727,272 bytecodes/sec; 			    984,169 sends/sec
		400 MHz PII/Win98:  			        			 18,028,169 bytecodes/sec; 			1,081,272 sends/sec
		RasPi2 - StackVM: 								 37,758,112 bytecodes/sec; 		       2,412,667 sends/sec
		Raspi2- Spur: 									     157,441,574 bytecodes/sec; 		     10,946,039 sends/sec
		1.6GHz Atom/Win7 - Cog: 					     201,099,764 bytecodes/sec; 		    28,197,075 sends/sec
		1.5GHz AMD A4-5000 APU - Cog: 			    390,243,902 bytecodes/sec; 		    47,507,997 sends/sec
		3.1GHz Core i3-2100 - Cog:  				1,203,290,246 bytecodes/sec; 		165,723,327 sends/sec
		3.1GHz Core i3-2100 - Spur:  				2,042,892,768 bytecodes/sec; 		127,837,794 sends/sec
	"
	| t1 t2 r n1 n2 |
	n1 _ 1.
	[
		t1 _ Time millisecondsToRun: [n1 benchmark].
		t1 < 1000]
			whileTrue:[n1 _ n1 * 2]. "Note: #benchmark's runtime is about O(n)"

	n2 _ 28.
	[
		t2 _ Time millisecondsToRun: [r _ n2 benchFib].
		t2 < 1000]
			whileTrue:[n2 _ n2 + 1].
	"Note: #benchFib's runtime is about O(k^n),
		where k is the golden number = (1 + 5 sqrt) / 2 = 1.618...."

	^ ((n1 * 500000 * 1000) // t1) printStringWithCommas, ' bytecodes/sec; ',
	  ((r * 1000) // t2) printStringWithCommas, ' sends/sec'! !


Class {
	#name : #K2CMTCWithFourStatesTest,
	#superclass : #TestCase,
	#category : #'Kendrick2-CTMC-Tests'
}

{ #category : #'as yet unclassified' }
K2CMTCWithFourStatesTest >> createCTMCWithFourStates [

^ [
[ -1, 1, 0, 0 ],
[ 5, -10, 5, 0 ],
[ 0, 8, -12, 4 ],
[ 0, 0, 10, -10 ]
] asCTMC.
]


'From Cuis 4.2 of 25 July 2013 [latest update: #1821] on 8 September 2013 at 2:47:46.369369 pm'!

!ChangeSet class methodsFor: 'services' stamp: 'bp 9/8/2013 14:41'!
installNewUpdates: updatesFileDirectory
	(self newUpdates: updatesFileDirectory) do: [:each |
		self install: (updatesFileDirectory fullNameFor: each)]! !

!ChangeSet class methodsFor: 'services' stamp: 'bp 9/8/2013 14:38'!
newUpdates: updatesFileDirectory
	^(updatesFileDirectory fileNames select: [:each | each asNumber > SystemVersion current highestUpdate]) asSortedCollection! !


Add the inspectKey option to Dictionary inspectors. Thanks Nahuel.

'From Cuis 5.0 [latest update: #4034] on 2 February 2020 at 12:45:03 pm'!
"Change Set:		4035-CuisCore-AuthorName-2020Feb02-12h37m
Date:			2 February 2020
Author:			Nahuel Garbezza

Add an option to inspect keys on dictionaty inspector"!

!InspectorWindow methodsFor: 'menu commands' stamp: 'RNG 2/2/2020 12:44:24'!
inspectSelectedKey

	^ model selectedKey inspect! !

!InspectorWindow methodsFor: 'menu building' stamp: 'RNG 2/2/2020 12:41:50'!
menuOptionsForDictionary

	^ `{
		nil.
		{
			#label 			-> 		'inspect key'.
			#selector 		-> 		#inspectSelectedKey.
			#icon 			-> 		#findIcon
		} asDictionary.
		{
			#label 			-> 		'senders of this key'.
			#selector 		-> 		#sendersOfSelectedKey.
			#icon 			-> 		#mailForwardIcon
		} asDictionary.
		{
			#label 			-> 		'add key'.
			#selector 		-> 		#addEntry.
			#icon 			-> 		#listAddIcon
		} asDictionary.
		{
			#label 			-> 		'rename key'.
			#selector 		-> 		#renameEntry.
			#icon 			-> 		#saveAsIcon
		} asDictionary.
		{
			#label 			-> 		'remove'.
			#object 			-> 		#model.
			#selector 		-> 		#removeSelection.
			#icon 			-> 		#listRemoveIcon
		} asDictionary.
	}`! !


'From Cuis 5.0 [latest update: #4883] on 24 September 2021 at 11:18:01 am'!

!MovableMorph methodsFor: 'initialization' stamp: 'jmv 9/24/2021 11:16:19'!
initialize
	"initialize the state of the receiver"

	super initialize.
	location _ MorphicTranslation new.
	self fixYAxisDirection.! !


Extension { #name : #MemoryLogger }

{ #category : #'*Bloc-Spec2' }
MemoryLogger >> inspectorGroupedRecordingsIn: aBuilder [
	<inspectorPresentationOrder: 1 title: 'Grouped'>

	^ aBuilder newTable
		addColumn: (SpStringTableColumn
			title: 'Class' evaluated: [ :each | each key ]);
		addColumn: (SpStringTableColumn
			title: 'Instances' evaluated: [ :each | each value size ]);
"		send: [ :each | self select: [ :s | s class = each key ] ];"
		items: (self recordings reverse groupedBy: [ :each | each class ]) associations;
		yourself

]

{ #category : #'*Bloc-Spec2' }
MemoryLogger >> inspectorRecordingsIn: aBuilder [
	<inspectorPresentationOrder: 0 title: 'Recordings'>

	| table |
	^ (table := aBuilder newTable)
		addColumn: (SpStringTableColumn
			title: 'Timestamp'
			evaluated: [ :each | each timestamp asString ]);
		addColumn: (SpStringTableColumn
			title: 'Process'
			evaluated: [ :each | each processId asString ]);
		addColumn: (SpStringTableColumn
			title: 'Type'
			evaluated: [ :each | each name ]);
		addColumn: (SpStringTableColumn
			title: 'Contents'
			evaluated: [ :each | String streamContents: [ :s | each printOneLineContentsOn: s ] ]);
		items: self recordings reverse;

		contextMenu: (SpMenuPresenter new
			addItem: [ :item |
				item
					name: 'Remove';
					icon: (self iconNamed: #glamorousRemove);
					action: [
						recordings := self recordings \ table selectedItem.
						table refresh ] ];
			addItem: [ :item |
				item
					name: 'Remove all';
					icon: (self iconNamed: #glamorousRemove);
					action: [
						self reset.
						table refresh ] ];
			yourself);
		yourself.

"		dynamicActions: [ :t |
			{
				GLMGenericAction new
					action: [ t unregisterFromAllAnnouncements. t pane updateToolbar  ];
					icon: GLMUIThemeExtraIcons glamorousRedCircle;
					title: 'Stop' .
				GLMGenericAction new
					action: [ t pane update ];
					icon: GLMUIThemeExtraIcons glamorousGreenCircle;
					title: 'Play' }]"
]


Fix to class comment for Pragma. Thanks Hernán.

'From Cuis 6.0 [latest update: #5114] on 25 April 2022 at 11:04:24 am'!

!Pragma commentStamp: 'HAW 4/25/2022 11:03:54' prior: 0!
I represent an occurrence of a pragma in a compiled method.  A pragma is a literal message pattern that occurs between angle brackets at the start of a method after any temporaries.  A common example is the primitive pragma:
	<primitive: 123 errorCode: 'errorCode'>
but one can add one's own and use them as metadata attached to a method.  Because pragmas are messages one can browse senders and implementors and perform them.  One can query a method for its pragmas by sending it the pragmas message, which answers an Array of instances of me, one for each pragma in the method.

I can provide information about the defining class, method, its selector, as well as the information about the pragma keyword and its arguments. See the two 'accessing' protocols for details. 'accessing-method' provides information about the method the pragma is found in, while 'accessing-pragma' is about the pragma itself.

Instances are retrieved using one of the pragma search methods of the 'finding' protocol on the class side.

To browse all methods with pragmas in the system evaluate
	Smalltalk browseAllSelect: [:m| m pragmas notEmpty]
and to browse all nonprimitive methods with pragmas evaluate
	Smalltalk browseAllSelect: [:m| m primitive isZero and: [m pragmas notEmpty]]!


"
Description
--------------------

BottomBorder is a border style that will fill only the bottom of the rectangle.

Public API and Key Messages
--------------------

- #trimSize: 	This option allow to trim the bottom border

Examples
--------------------

	BottomBorder new
		width: 1;
		baseColor: Color white;
		trimSize: 2;
		yourself

Internal Representation and Key Implementation Points.
--------------------

    Instance Variables
	trimSize:		<anInteger>		An amount of pixel to trim from both side of the bottom border

"
Class {
	#name : #BottomBorder,
	#superclass : #SimpleBorder,
	#instVars : [
		'trimSize'
	],
	#category : #'Morphic-Base-Borders'
}

{ #category : #drawing }
BottomBorder >> frameRectangle: aRectangle on: aCanvas [
	self drawLineFrom: aRectangle bottomLeft + (self trimSize @ 0) to: aRectangle bottomRight - (self trimSize @ 0) on: aCanvas
]

{ #category : #accessing }
BottomBorder >> trimSize [
	^ trimSize ifNil: [ trimSize := 0 ]
]

{ #category : #accessing }
BottomBorder >> trimSize: anObject [
	trimSize := anObject
]


Fix a couple of just introduced bugs in Color. Thanks Ken.

'From Cuis 5.0 [latest update: #3898] on 2 October 2019 at 2:16:17 pm'!

!Color methodsFor: 'object serialization' stamp: 'jmv 6/22/2017 12:54:10'!
convertToCurrentVersion: varDict refStream: smartRefStrm

	"subclasses should implement if they wish to convert old instances to modern ones"
	self size = 0 ifTrue: [
		^ Color new copyFrom: (varDict at: 'floatRGB') ].
	^ self! !

!Color methodsFor: 'private' stamp: 'jmv 10/2/2019 13:53:40'!
setRed: r green: g blue: b range: range
	"Initialize this color's r, g, and b components to the given values in the range [0..r]."

	self basicSetRed: r/range green: g/range blue: b/range.
	self clipToValidValues! !

!methodRemoval: Color #*=!
Color removeSelector: #*=!
!methodRemoval: Color #+=!
Color removeSelector: #+=!
!methodRemoval: Color #-=!
Color removeSelector: #-=!
!methodRemoval: Color #/=!
Color removeSelector: #/=!


Fix to IndentingListItemMorph when an icon for nil is present. Thanks Ken.

'From Cuis 5.0 of 7 November 2016 [latest update: #3695] on 16 April 2019 at 10:34:27 am'!

!IndentingListItemMorph methodsFor: 'initialization' stamp: 'KenD 4/14/2019 16:46:00'!
initWithContents: anObject prior: priorMorph forList: hostList indentLevel: newLevel

	| o |
	container _ hostList.
	complexContents _ anObject.
	self initWithContents: anObject asString font: Preferences standardListFont emphasis: nil.
	indentLevel _ 0.
	isExpanded _ false.
 	nextSibling _ firstChild _ nil.
	priorMorph ifNotNil: [
		priorMorph nextSibling: self.
	].
	o _ anObject withoutListWrapper.
	icon _ o ifNotNil: [ (o respondsTo: #icon) ifTrue: [ o icon ] ].
	indentLevel _ newLevel.
! !


Support for themming AutoCompleter. Thanks Gerald.

'From Haver 5.0 [latest update: #4589] on 8 May 2021 at 3:33:56 pm'!

!Theme methodsFor: 'tool colors' stamp: 'KLG 5/8/2021 15:12:47'!
autoCompleter
	"Answer the autocompleter's color for  entries."

	^ self text! !

!Theme methodsFor: 'tool colors' stamp: 'KLG 5/8/2021 15:26:51'!
autoCompleterDefaultBorderColor
	"Answer the auto comleters default border color."

	^ `Color gray`! !

!Theme methodsFor: 'tool colors' stamp: 'KLG 5/8/2021 15:09:00'!
autoCompleterMaybeInvalid
	"Answer the autocompleter's color for possible invalid entries."

	^ `Color blue`! !

!AutoCompleterMorph methodsFor: 'drawing' stamp: 'KLG 5/8/2021 15:10:07'!
colorOf: entry

	^(completer isPossibleInvalidEntry: entry)
		ifTrue: [ Theme current autoCompleterMaybeInvalid ]
		ifFalse: [ Theme current autoCompleter ]
	! !

!AutoCompleterMorph methodsFor: 'initialization' stamp: 'KLG 5/8/2021 15:27:47'!
defaultBorderColor
	"My default border color.

	Note: My background color is derived from this color."
	^ Theme current autoCompleterDefaultBorderColor ! !


Bring back Stream>>nextNumber, removed by mistake.

'From Cuis 5.0 of 7 November 2016 [latest update: #3430] on 18 September 2018 at 5:08:42 pm'!

!Stream methodsFor: 'nonhomogeneous accessing' stamp: 'jmv 9/18/2018 17:08:36'!
nextNumber
	"Answer a number from the (text) stream."

	|element|
	[(element := self next) isNil or: [element isDigit or: [element = $- or: [element = $)]]]] whileFalse.
	element ifNil: [^nil].
	self skip: -1.
	element = $) ifTrue: [^nil].
	^Number readFrom: self! !


Update new button command a Box Zoom for views

Class {
	#name : #GLMBoxZoomAction,
	#superclass : #GLMRoassal2Action,
	#category : #'Roassal2GT-Glamour-Actions'
}

{ #category : #'as yet unclassified' }
GLMBoxZoomAction >> execute [
	| int |
	int := RTZoomableBoxView new.
	self roassalView @ int.
]

{ #category : #'as yet unclassified' }
GLMBoxZoomAction >> title [
	^ 'Add Box zoom'
]


Fix recent slowdown in PluggableListMorph and HierarchycalListMorph

'From Cuis 5.0 [latest update: #4965] on 4 November 2021 at 4:49:32 pm'!

!HierarchicalListMorph methodsFor: 'geometry' stamp: 'jmv 11/4/2021 15:52:51'!
someSubmorphPositionOrExtentChanged
	"Our extent, or some submorph changed. Must layout submorphs again."

	self layoutNeeded: true.
	self updateScrollBarsBounds! !

!PluggableListMorph methodsFor: 'geometry' stamp: 'jmv 11/4/2021 15:52:17'!
someSubmorphPositionOrExtentChanged
	"Our extent, or some submorph changed. Must layout submorphs again."

	self layoutNeeded: true.
	self updateScrollBarsBounds! !


Remove possibly problematic pop up after install updates

'From Cuis 5.0 [latest update: #4425] on 24 October 2020 at 11:01:52 pm'!

!ChangeSet class methodsFor: 'services' stamp: 'jmv 10/24/2020 23:01:03'!
installNewUpdates: updatesFileDirectory

	| warnUser |
	(self newUpdates: updatesFileDirectory) do: [ :each |
		self install: each ].

	warnUser _ false.
	CodePackage installedPackages keysAndValuesDo: [ :pckName :package |
		package fullFileName ifNotNil: [ :fullFileName | | codePackageFile |
			codePackageFile _ CodePackageFile onFileEntry: fullFileName asFileEntry.
			(codePackageFile provides isLaterThan: package provides) ifTrue: [
				warnUser _ true.
				package hasUnsavedChanges
					ifTrue: [ 'Package: ', pckName, '. Package has unsaved changes, but there is a newer version of the file.' print ]
					ifFalse: [ 'Package: ', pckName, '. There is a newer version than the currently loaded.' print ]]]].
	warnUser
		ifTrue: [
			self inform: SystemVersion current version, ' - ', Smalltalk lastUpdateString, String newLineString,
'Some package(s) loaded in the image
have updated package file on disk.
Please see Transcript.' ]
		ifFalse: [
			Smalltalk systemInformationString print ]! !


Fix a bug when advising to install updated packages. Thanks Hilaire.

'From Cuis 5.0 [latest update: #4569] on 19 April 2021 at 12:34:32 pm'!

!ChangeSet class methodsFor: 'services' stamp: 'jmv 4/19/2021 12:33:55'!
installNewUpdates: updatesFileDirectory

	| warnUser |
	(self newUpdates: updatesFileDirectory) do: [ :each |
		self install: each ].

	warnUser _ false.
	CodePackage installedPackages keysAndValuesDo: [ :pckName :package |
		package fullFileName ifNotNil: [ :fullFileName | | codePackageFile |
			codePackageFile _ CodePackageFile onFileEntry: fullFileName asFileEntry.
			(codePackageFile provides isLaterThan: package provides) ifTrue: [
				warnUser _ true.
				package hasUnsavedChanges
					ifTrue: [ ('Package: ', pckName, '. Package has unsaved changes, but there is a newer version of the file.') print ]
					ifFalse: [ ('Package: ', pckName, '. There is a newer version than the currently loaded.') print ]]]].
	warnUser
		ifTrue: [
			self inform: SystemVersion current version, ' - ', Smalltalk lastUpdateString, String newLineString,
'Some package(s) loaded in the image
have updated package file on disk.
Please see Transcript.' ]
		ifFalse: [
			Smalltalk systemInformationString print ]! !