"
I am a Baseline of Brick.
"
Class {
	#name : #BaselineOfBrick,
	#superclass : #BaselineOf,
	#category : #BaselineOfBrick
}

{ #category : #baseline }
BaselineOfBrick >> baseline: spec [
	<baseline>
	spec for: #'common' do: [
		spec
			baseline: 'Bloc' with: [
				spec repository: 'github://feenkcom/Bloc/src' ];
			baseline: 'Beacon' with: [
				spec repository: 'github://pharo-project/pharo-beacon/repository' ].
		spec
			package: #'Brick-Editor' with: [
				spec requires: #('Bloc' 'Beacon' ) ];
			package: #Brick with: [
				spec requires: #('Bloc' 'Brick-Editor' 'Beacon'). ];
			package: #'Brick-Editor-Extensions' with: [
				spec requires: #('Brick'). ];
			package: #'Brick-Material' with: [
				spec requires: #('Brick' ). ];
			package: #'Brick-Hydra' with: [
				spec requires: #('Brick' ). ];
			package: #'Brick-Glamorous' with: [
				spec requires: #('Brick' ). ];
			package: #'Brick-Examples' with: [
				spec requires: #('Brick' 'Brick-Material' 'Brick-Glamorous' 'Brick-Hydra' ). ]. ].

]

Use feenkcom/pharo-beacon instead of pharo-project/pharo-beacon

"
I am a Baseline of Brick.
"
Class {
	#name : #BaselineOfBrick,
	#superclass : #BaselineOf,
	#category : #BaselineOfBrick
}

{ #category : #baseline }
BaselineOfBrick >> baseline: spec [
	<baseline>
	spec for: #'common' do: [
		spec
			baseline: 'Bloc' with: [
				spec repository: 'github://feenkcom/Bloc/src' ];
			baseline: 'Beacon' with: [
				spec repository: 'github://feenkcom/pharo-beacon/repository' ].
		spec
			package: #'Brick-Editor' with: [
				spec requires: #('Bloc' 'Beacon' ) ];
			package: #Brick with: [
				spec requires: #('Bloc' 'Brick-Editor' 'Beacon'). ];
			package: #'Brick-Editor-Extensions' with: [
				spec requires: #('Brick'). ];
			package: #'Brick-Material' with: [
				spec requires: #('Brick' ). ];
			package: #'Brick-Hydra' with: [
				spec requires: #('Brick' ). ];
			package: #'Brick-Glamorous' with: [
				spec requires: #('Brick' ). ];
			package: #'Brick-Examples' with: [
				spec requires: #('Brick' 'Brick-Material' 'Brick-Glamorous' 'Brick-Hydra' ). ]. ].

]


Class {
	#name : #PjObjectTest,
	#superclass : #PjBridgeTestCase,
	#category : #PharoJsCoreLibrariesTest
}

{ #category : #testing }
PjObjectTest >> testPrintString [
	self assert: [ Object new printString ] evaluatesTo: 'an Object'.
	self assert: [ PjSet new printString ] evaluatesTo: 'a PjSet'.
	self assert: [ 'hello world' printString ] evaluatesTo: 'hello world'.
	self assert: [ 123 printString ] evaluatesTo: '123'.
	self assert: [ true printString ] evaluatesTo: 'true'.

]

Test that new objects (Object new) have no enumeratable keys neitehr owned nor inherited

Class {
	#name : #PjObjectTest,
	#superclass : #PjBridgeTestCase,
	#category : #PharoJsCoreLibrariesTest
}

{ #category : #testing }
PjObjectTest >> testNewObjectHasNoEnumeratableKeys [
	"This is important for many JS third party libraries"
	self assertBlock: [ Object new allEnumeratableKeys isEmpty ] .

]

{ #category : #testing }
PjObjectTest >> testPrintString [
	self assert: [ Object new printString ] evaluatesTo: 'an Object'.
	self assert: [ PjSet new printString ] evaluatesTo: 'a PjSet'.
	self assert: [ 'hello world' printString ] evaluatesTo: 'hello world'.
	self assert: [ 123 printString ] evaluatesTo: '123'.
	self assert: [ true printString ] evaluatesTo: 'true'.

]


"
I am a special because I announce changes only if the new value set is different from the current value.
"
Class {
	#name : #IdentityNewValueHolder,
	#superclass : #NewValueHolder,
	#category : #NewValueHolder
}

{ #category : #accessing }
IdentityNewValueHolder >> value: anObject [

	self value == anObject ifTrue: [ ^ anObject ].
	super value: anObject
]

Make IdentitfyNewValueHolder>>value: return a consistent value

"
I am a special because I announce changes only if the new value set is different from the current value.
"
Class {
	#name : #IdentityNewValueHolder,
	#superclass : #NewValueHolder,
	#category : #NewValueHolder
}

{ #category : #accessing }
IdentityNewValueHolder >> value: anObject [

	self value == anObject ifFalse: [	super value: anObject ].
]


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

{ #category : #'as yet unclassified' }
K2CMTCWithTwoStatesTest >> createCTMCWithTwoStates [

^ [
[ -0.4, 0.4 ],
[ 0.7, -0.7 ]
] asCTMC.
]

Test that verify that the new CTMC has no states

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

{ #category : #'as yet unclassified' }
K2CMTCWithTwoStatesTest >> createCTMCWithTwoStates [

^ [
[ -0.4, 0.4 ],
[ 0.7, -0.7 ]
] asCTMC.
]

{ #category : #tests }
K2CMTCWithTwoStatesTest >> testANewCTMCHasNoStates [
	<gtExample>
	| ctmc |
	ctmc := K2CTMC new.
	self assert: ctmc states isEmpty.
	^ctmc
]


Class {
	#name : 'BaselineOfGtGemstoneClient',
	#superclass : 'BaselineOf',
	#category : 'BaselineOfGtGemstoneClient'
}

{ #category : 'baselines' }
BaselineOfGtGemstoneClient >> baseline: spec [
	<baseline>

	spec for: #common do: [
		spec
			baseline: 'RemoteServiceReplication'
			with: [ spec repository: 'github://GemTalk/RemoteServiceReplication:main/src' ].
		spec
			package: 'GToolkit-GemStone' with:
				[ spec requires: #( 'RemoteServiceReplication' ) ];
			package: 'GToolkit-GemStone-Pharo' with:
				[ spec requires: #( 'GToolkit-GemStone' ) ];
			package: 'GToolkit-GemStone-Lepiter' with:
				[ spec requires: #( 'GToolkit-GemStone-Pharo' ) ] ].
]

Load SparkleFFI as part of the Gt client.

Class {
	#name : 'BaselineOfGtGemstoneClient',
	#superclass : 'BaselineOf',
	#category : 'BaselineOfGtGemstoneClient'
}

{ #category : 'baselines' }
BaselineOfGtGemstoneClient >> baseline: spec [
	<baseline>

	spec for: #common do: [
		spec
			baseline: 'RemoteServiceReplication'
			with: [ spec repository: 'github://GemTalk/RemoteServiceReplication:main/src' ].
		spec
			baseline: 'SparkleFFI'
			with: [ spec repository: 'github://feenkcom/SparkleFFI:akg/src' ].
		spec
			package: 'GToolkit-GemStone' with:
				[ spec requires: #( 'SparkleFFI' 'RemoteServiceReplication' ) ];
			package: 'GToolkit-GemStone-Pharo' with:
				[ spec requires: #( 'GToolkit-GemStone' ) ];
			package: 'GToolkit-GemStone-Lepiter' with:
				[ spec requires: #( 'GToolkit-GemStone-Pharo' ) ] ].
]


Class {
	#name : #BaselineOfBlocLayout,
	#superclass : #BaselineOf,
	#category : #BaselineOfBlocLayout
}

{ #category : #baseline }
BaselineOfBlocLayout >> baseline: spec [
	<baseline>
	spec for: #'common' do: [
		spec
			baseline: 'BlocCore' with: [
				spec repository: 'github://pharo-graphics/Bloc/src' ];
			baseline: 'BlocAnimation' with: [
				spec repository: 'github://pharo-graphics/Bloc/src' ].

		spec
			package: #'Bloc-Layout' with: [
				spec requires: #(#BlocCore) ];
			package: #'Bloc-LayoutZoomable' with: [
				spec requires: #(#'Bloc-Layout' #BlocAnimation) ];

			"Layout depends also on compositor see https://github.com/pharo-graphics/Bloc/issues/87"

			package: #'Bloc-Layout-Tests' with: [
				spec requires: #('Bloc-Layout')];

			package: #'Bloc-Layout-Examples' with: [
				spec requires: #('Bloc-Layout'). ]. ].
]

Revert addition of layout examples, too.

Class {
	#name : #BaselineOfBlocLayout,
	#superclass : #BaselineOf,
	#category : #BaselineOfBlocLayout
}

{ #category : #baseline }
BaselineOfBlocLayout >> baseline: spec [
	<baseline>
	spec for: #'common' do: [
		spec
			baseline: 'BlocCore' with: [
				spec repository: 'github://pharo-graphics/Bloc/src' ];
			baseline: 'BlocAnimation' with: [
				spec repository: 'github://pharo-graphics/Bloc/src' ].

		spec
			package: #'Bloc-Layout' with: [
				spec requires: #(#BlocCore) ];
			package: #'Bloc-LayoutZoomable' with: [
				spec requires: #(#'Bloc-Layout' #BlocAnimation) ];

			"Layout depends also on compositor see https://github.com/pharo-graphics/Bloc/issues/87"

			package: #'Bloc-Layout-Tests' with: [
				spec requires: #('Bloc-Layout')]

			"package: #'Bloc-Layout-Examples' with: [
				spec requires: #('Bloc-Layout') ]."
		].
]


Class {
	#name : #WodenCoreAssets,
	#superclass : #Object,
	#classVars : [
		'Session',
		'WodenCoreAssetsLocation'
	],
	#category : #'WodenEngine-CoreAssets'
}

{ #category : #accessing }
WodenCoreAssets class >> findCoreAssets [
	| location |
	location := Smalltalk imageDirectory / 'core-assets'.
	location exists ifFalse: [
		location := IceLibgitRepository repositoriesLocation / #ronsaldo / 'wloden-core-assets' resolve: location.
	].

	location exists ifFalse: [
		location := FileSystem workingDirectory / 'core-assets'
	].

	location exists ifFalse: [
		self error: 'Failed to find the Woden Lowtalk sources.'
	].

	^ location
]

{ #category : #accessing }
WodenCoreAssets class >> location [
	Session ~~ Smalltalk session ifTrue: [
		WodenCoreAssetsLocation := self findCoreAssets.
		Session := Smalltalk session
	].
	^ WodenCoreAssetsLocation
]

Fix a bug on the search of the core assets.

Class {
	#name : #WodenCoreAssets,
	#superclass : #Object,
	#classVars : [
		'Session',
		'WodenCoreAssetsLocation'
	],
	#category : #'WodenEngine-CoreAssets'
}

{ #category : #accessing }
WodenCoreAssets class >> findCoreAssets [
	| location |
	location := Smalltalk imageDirectory / 'core-assets'.
	location exists ifFalse: [
		location := IceLibgitRepository repositoriesLocation / #ronsaldo / 'wloden-core-assets'
	].

	location exists ifFalse: [
		location := FileSystem workingDirectory / 'core-assets'
	].

	location exists ifFalse: [
		self error: 'Failed to find the Woden Lowtalk sources.'
	].

	^ location
]

{ #category : #accessing }
WodenCoreAssets class >> location [
	Session ~~ Smalltalk session ifTrue: [
		WodenCoreAssetsLocation := self findCoreAssets.
		Session := Smalltalk session
	].
	^ WodenCoreAssetsLocation
]


"
SUnit tests for Author
"
Class {
	#name : #AuthorTest,
	#superclass : #TestCase,
	#instVars : [
		'author'
	],
	#category : #'System-Support-Tests'
}

{ #category : #tests }
AuthorTest >> testUniqueness [
	self should: [ Author new ] raise: Error.
]

Remove unnecessary dot to trigger CI

"
SUnit tests for Author
"
Class {
	#name : #AuthorTest,
	#superclass : #TestCase,
	#instVars : [
		'author'
	],
	#category : #'System-Support-Tests'
}

{ #category : #tests }
AuthorTest >> testUniqueness [
	self should: [ Author new ] raise: Error
]


"
I am a basic uml class browser
"
Class {
	#name : #RSUMLClassCalypso,
	#superclass : #RSUMLCalypso,
	#instVars : [
		'targetClass'
	],
	#category : #'Roassal3-UML-Calypso'
}

{ #category : #activation }
RSUMLClassCalypso class >> classUmlTapActivation [
	<classAnnotation>
	^ ClyTabActivationStrategy for: ClyClass asCalypsoItemContext
]

{ #category : #accessing }
RSUMLClassCalypso >> classes [
	| supers |
	supers := targetClass allSuperclasses remove: Object; remove: ProtoObject; yourself .

	^ supers, targetClass withAllSubclasses
]

{ #category : #initialization }
RSUMLClassCalypso >> defaultTitle [
	^'UML-Class'
]

{ #category : #initialization }
RSUMLClassCalypso >> isSimilarTo: anotherBrowserTool [
	(super isSimilarTo: anotherBrowserTool) ifFalse: [ ^false ].

	^targetClass  = anotherBrowserTool targetClass
]

{ #category : #initialization }
RSUMLClassCalypso >> setUpModelFromContext [
	super setUpModelFromContext.

	targetClass := context lastSelectedClass
]

{ #category : #accessing }
RSUMLClassCalypso >> targetClass [
	^ targetClass
]

Fix Calypso plugin when a trait is selected

"
I am a basic uml class browser
"
Class {
	#name : #RSUMLClassCalypso,
	#superclass : #RSUMLCalypso,
	#instVars : [
		'targetClass'
	],
	#category : #'Roassal3-UML-Calypso'
}

{ #category : #activation }
RSUMLClassCalypso class >> classUmlTapActivation [
	<classAnnotation>
	^ ClyTabActivationStrategy for: ClyClass asCalypsoItemContext
]

{ #category : #accessing }
RSUMLClassCalypso >> classes [
	| superclasses |
	superclasses := targetClass allSuperclasses
		copyWithoutAll: { Object. ProtoObject }.
	^ superclasses, targetClass withAllSubclasses
]

{ #category : #initialization }
RSUMLClassCalypso >> defaultTitle [
	^'UML-Class'
]

{ #category : #initialization }
RSUMLClassCalypso >> isSimilarTo: anotherBrowserTool [
	(super isSimilarTo: anotherBrowserTool) ifFalse: [ ^false ].

	^targetClass  = anotherBrowserTool targetClass
]

{ #category : #initialization }
RSUMLClassCalypso >> setUpModelFromContext [
	super setUpModelFromContext.

	targetClass := context lastSelectedClass
]

{ #category : #accessing }
RSUMLClassCalypso >> targetClass [
	^ targetClass
]


| pwd |
pwd := FileDirectory default fullName.
SpurBootstrap bootstrapImage: pwd, '/', 'trunk46forspur'.
SpurBootstrapMonticelloPackagePatcher new
	from: 'temp-v3-repository' to: 'temp-spur-repository';
	patch.
Smalltalk snapshot: false andQuit: true

Make sure the autor initials are set when doing the package patch.

| pwd |
Utilities authorInitialsPerSe isEmpty ifTrue:
	[Utilities setAuthorInitials: 'autoboot'].
pwd := FileDirectory default fullName.
SpurBootstrap bootstrapImage: pwd, '/', 'trunk46forspur'.
SpurBootstrapMonticelloPackagePatcher new
	from: 'temp-v3-repository' to: 'temp-spur-repository';
	patch.
Smalltalk snapshot: false andQuit: true


#
# This iRule is updated programmatically; any changes will be overwritten.
#

#
# Copyright (c) 2015 Intellectual Reserve, Inc.  All rights reserved.
#
#    Licensed under the Apache License, Version 2.0 (the "License");
#    you may not use this file except in compliance with the License.
#    You may obtain a copy of the License at
#
#        http://www.apache.org/licenses/LICENSE-2.0
#
#    Unless required by applicable law or agreed to in writing, software
#    distributed under the License is distributed on an "AS IS" BASIS,
#    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#    See the License for the specific language governing permissions and
#    limitations under the License.
#

# TODO Add support for wildcard routes

when HTTP_REQUEST {
  set host [getfield [HTTP::host] ":" 1]
  set cfPool [string tolower "`poolNamePrefix`$host"]
  if {([ catch { pool $cfPool } ]) || ([active_members $cfPool] == 0)} {
    set body404Content "<title>404 Not Found</title>

404 Not Found

Could not find route for $host in Cloud Foundry.

      "
    HTTP::respond 404 content $body404Content
  }
}

Disable event processing after sending 404 response.

#
# This iRule is updated programmatically; any changes will be overwritten.
#

#
# Copyright (c) 2015 Intellectual Reserve, Inc.  All rights reserved.
#
#    Licensed under the Apache License, Version 2.0 (the "License");
#    you may not use this file except in compliance with the License.
#    You may obtain a copy of the License at
#
#        http://www.apache.org/licenses/LICENSE-2.0
#
#    Unless required by applicable law or agreed to in writing, software
#    distributed under the License is distributed on an "AS IS" BASIS,
#    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#    See the License for the specific language governing permissions and
#    limitations under the License.
#

# TODO Add support for wildcard routes

when HTTP_REQUEST {
  set host [getfield [HTTP::host] ":" 1]
  set cfPool [string tolower "`poolNamePrefix`$host"]
  if {([ catch { pool $cfPool } ]) || ([active_members $cfPool] == 0)} {
    set body404Content "<title>404 Not Found</title>

404 Not Found

Could not find route for $host in Cloud Foundry.

      "
    HTTP::respond 404 content $body404Content
    event disable all
  }
}


Extension { #name : #BlHost }

{ #category : #'*Bloc-Sparta' }
BlHost >> containsPoint: aPoint element: aBlElement geometry: aBlGeometry [

	self flag: #todo. "This is a feature expected from any BlHost but creates a dependency to Sparta."

	^ aBlGeometry
		  containsPoint: aPoint
		  in: aBlElement
		  on: Bloc preferableSpartaCanvas offscreen
]

{ #category : #'*Bloc-Sparta' }
BlHost >> offscreenMeasureTextParagraph: aBlTextParagraph [

	self flag: #todo. "This is a feature expected from any BlHost but creates a dependency to Sparta."

	(BlSpartaCanvasTextMeasurer new canvas: Bloc preferableSpartaCanvas offscreen)
		measureTextParagraph: aBlTextParagraph
]

{ #category : #'*Bloc-Sparta' }
BlHost >> visualBoundsOf: aBlElement [

	self flag: #todo. "This is a feature expected from any BlHost but creates a dependency to Sparta."

	^ Bloc hasSparta
		ifTrue: [ aBlElement visualBoundsOn: (Bloc preferableSpartaCanvas offscreen) ]
		ifFalse: [ aBlElement geometryBounds ]
]

Fix contains point fo Sparta (I broke it in a recent change)

Extension { #name : #BlHost }

{ #category : #'*Bloc-Sparta' }
BlHost >> containsPoint: aPoint element: aBlElement geometry: aBlGeometry [

	self flag: #todo. "This is a feature expected from any BlHost but creates a dependency to Sparta."

	^ aBlGeometry
		  containsPoint: aPoint
		  in: aBlElement
		  onSpartaCanvas: Bloc preferableSpartaCanvas offscreen
]

{ #category : #'*Bloc-Sparta' }
BlHost >> offscreenMeasureTextParagraph: aBlTextParagraph [

	self flag: #todo. "This is a feature expected from any BlHost but creates a dependency to Sparta."

	(BlSpartaCanvasTextMeasurer new canvas: Bloc preferableSpartaCanvas offscreen)
		measureTextParagraph: aBlTextParagraph
]

{ #category : #'*Bloc-Sparta' }
BlHost >> visualBoundsOf: aBlElement [

	self flag: #todo. "This is a feature expected from any BlHost but creates a dependency to Sparta."

	^ Bloc hasSparta
		ifTrue: [ aBlElement visualBoundsOn: (Bloc preferableSpartaCanvas offscreen) ]
		ifFalse: [ aBlElement geometryBounds ]
]


Class {
	#name : #KEODESystem,
	#superclass : #Object,
	#instVars : [
		'initialState',
		'bindings',
		'equations'
	],
	#category : #'Kendrick-Tests-MM'
}

{ #category : #initialization }
KEODESystem >> equations: aStringArray [

	equations := aStringArray collect: [ :each |
		             each parseAsAnExpression ].

]

{ #category : #initialization }
KEODESystem >> initialState: aVector [

	initialState := aVector.
	equations
		with: initialState
		do: [ :eq :value | bindings at: eq variable symbol put: value ]
]

{ #category : #initialization }
KEODESystem >> initialize [

bindings := Dictionary new
]

{ #category : #initialization }
KEODESystem >> state: aState time: anInteger [

	| state |
	bindings at: #time put: anInteger.

	state := equations collect: [ :each |
		         each expression evaluateWithParameters: bindings ].
	equations
		with: state
		do: [ :eq :value | bindings at: eq variable symbol put: value ].
	^ state
]

Refactor bindings update as a method

Class {
	#name : #KEODESystem,
	#superclass : #Object,
	#instVars : [
		'initialState',
		'bindings',
		'equations'
	],
	#category : #'Kendrick-Tests-MM'
}

{ #category : #initialization }
KEODESystem >> equations: aStringArray [

	equations := aStringArray collect: [ :each |
		             each parseAsAnExpression ].

]

{ #category : #initialization }
KEODESystem >> initialState: aVector [

	initialState := aVector.
	self updateBindingsWithState: aVector
]

{ #category : #initialization }
KEODESystem >> initialize [

bindings := Dictionary new
]

{ #category : #initialization }
KEODESystem >> state: aState time: anInteger [

	| state |
	bindings at: #time put: anInteger.

	state := equations collect: [ :each |
		         each expression evaluateWithParameters: bindings ].
	self updateBindingsWithState: state.
	^ state
]

{ #category : #initialization }
KEODESystem >> updateBindingsWithState: aVector [

equations
		with: aVector
		do: [ :eq :value | bindings at: eq variable symbol put: value ]
]


conveniance
resourcesURL
	^ String
		streamContents: [ :stream |
			stream
				<< self domainName;
				<< $:;
				<< self staticServerPort;
				<< $/;
				<< self class resourcesURLName ]

Correct resources link to not get stranges errors

conveniance
resourcesURL
	^ String
		streamContents: [ :stream |
			stream
				<< 'http://';
				<< self domainName;
				<< $:;
				<< self staticServerPort;
				<< $/;
				<< self class resourcesURLName ]


  Hackage :: [Package]

      <form action="/packages/search" method="get" class="search">
        <button type="submit">Search </button>
        <input type="text" name="terms" />
      </form>

Browse

What's new

Upload

User accounts

Add 'autofocus' to Hackage's home page 'Search' field

  Hackage :: [Package]

      <form action="/packages/search" method="get" class="search">
        <button type="submit">Search </button>
        <input type="text" name="terms" autofocus />
      </form>

Browse

What's new

Upload

User accounts


| pwd |
Utilities authorInitialsPerSe isEmpty ifTrue:
	[Utilities setAuthorInitials: 'autoboot'].
pwd := FileDirectory default fullName.
SpurBootstrap bootstrapImage: pwd, '/', 'trunk46forspur'.
SpurBootstrapMonticelloPackagePatcher new
	from: 'temp-v3-repository' to: 'temp-spur-repository';
	patch.
Smalltalk snapshot: false andQuit: true

Update bootstrap for Cog-eem.166 (bootstrapImage: => bootstrapSqueakImage:)

| pwd |
Utilities authorInitialsPerSe isEmpty ifTrue:
	[Utilities setAuthorInitials: 'autoboot'].
pwd := FileDirectory default fullName.
SpurBootstrap bootstrapSqueakImage: pwd, '/', 'trunk46forspur'.
SpurBootstrapMonticelloPackagePatcher new
	from: 'temp-v3-repository' to: 'temp-spur-repository';
	patch.
Smalltalk snapshot: false andQuit: true


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

{ #category : #'as yet unclassified' }
K2CMTCWithTwoStatesTest >> createCTMCWithTwoStates [

^ [
[ -0.4, 0.4 ],
[ 0.7, -0.7 ]
] asCTMC.
]

{ #category : #tests }
K2CMTCWithTwoStatesTest >> testANewCTMCHasNoStates [
	<gtExample>
	| ctmc |
	ctmc := K2CTMC new.
	self assert: ctmc states isEmpty.
	^ctmc
]

{ #category : #tests }
K2CMTCWithTwoStatesTest >> testANewCTMCHaveCurrentStateInitilizeToNil [
	<gtExample>
	| ctmc |
	ctmc := K2CTMC new.
	self assert: ctmc currentState isNil.
	^ctmc
]

{ #category : #tests }
K2CMTCWithTwoStatesTest >> testCreateCTMC [

<gtExample>
| ctmc |

ctmc :=self createCTMCWithTwoStates .

self assert: (ctmc class  = K2CTMC).
^ctmc
]

Test that the number of states is 2

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

{ #category : #'as yet unclassified' }
K2CMTCWithTwoStatesTest >> createCTMCWithTwoStates [

^ [
[ -0.4, 0.4 ],
[ 0.7, -0.7 ]
] asCTMC.
]

{ #category : #tests }
K2CMTCWithTwoStatesTest >> testANewCTMCHasNoStates [
	<gtExample>
	| ctmc |
	ctmc := K2CTMC new.
	self assert: ctmc states isEmpty.
	^ctmc
]

{ #category : #tests }
K2CMTCWithTwoStatesTest >> testANewCTMCHaveCurrentStateInitilizeToNil [
	<gtExample>
	| ctmc |
	ctmc := K2CTMC new.
	self assert: ctmc currentState isNil.
	^ctmc
]

{ #category : #tests }
K2CMTCWithTwoStatesTest >> testCreateCTMC [

<gtExample>
| ctmc |

ctmc :=self createCTMCWithTwoStates .

self assert: (ctmc class  = K2CTMC).
^ctmc
]

{ #category : #tests }
K2CMTCWithTwoStatesTest >> testNumberOfStatesofCTMC [

<gtExample>
| ctmc |

ctmc :=self createCTMCWithTwoStates.

self assert: (ctmc states size)  equals: 2.
^ctmc

]


Class {
	#name : #BaselineOfNewBrick,
	#superclass : #BaselineOf,
	#category : #BaselineOfNewBrick
}

{ #category : #baseline }
BaselineOfNewBrick >> baseline: spec [
	<baseline>
	spec for: #'common' do: [
		spec
			baseline: 'NewBloc' with: [
				spec repository: 'github://pharo-graphics/Bloc/src' ];
			baseline: 'NewBlocPac' with: [
				spec repository: 'github://pharo-graphics/bloc-pac:main/src' ].

		spec
			package: #'Brick-Core' with: [
				spec requires: #('NewBloc' 'NewBlocPac') ];
			package: #'Brick-Editor' with: [
				spec requires: #('Brick-Core') ];

			package: #'Brick' with: [
				spec requires: #(#'Brick-Core' #'Brick-Editor') ];
			package: #'Brick-Theme' with: [
				spec requires: #(#'Brick') ];

			package: #'Brick-Glamorous' with: [
				spec requires: #(#'Brick') ];

			package: #'Brick-DevTool' with: [
				spec requires: #(#'Brick' #'NewBloc' #'NewBlocPac') ]
		]
]

Disable DevTool for the moment

Class {
	#name : #BaselineOfNewBrick,
	#superclass : #BaselineOf,
	#category : #BaselineOfNewBrick
}

{ #category : #baseline }
BaselineOfNewBrick >> baseline: spec [
	<baseline>
	spec for: #'common' do: [
		spec
			baseline: 'NewBloc' with: [
				spec repository: 'github://pharo-graphics/Bloc/src' ];
			baseline: 'NewBlocPac' with: [
				spec repository: 'github://pharo-graphics/bloc-pac:main/src' ].

		spec
			package: #'Brick-Core' with: [
				spec requires: #('NewBloc' 'NewBlocPac') ];
			package: #'Brick-Editor' with: [
				spec requires: #('Brick-Core') ];

			package: #'Brick' with: [
				spec requires: #(#'Brick-Core' #'Brick-Editor') ];
			package: #'Brick-Theme' with: [
				spec requires: #(#'Brick') ];

			package: #'Brick-Glamorous' with: [
				spec requires: #(#'Brick') ]";

			package: #'Brick-DevTool' with: [
				spec requires: #(#'Brick' #'NewBloc' #'NewBlocPac') ]"
		]
]


actions
useSharedCacheRepository

	| dropboxRepoFolder |
	MCCacheRepository cacheDirectory resolve = self class sharedCacheFolder resolve ifTrue: [ ^ self ].
	dropboxRepoFolder := FileLocator home / 'Dropbox (Personal)' / 'Repositories'.
	dropboxRepoFolder exists
		ifTrue: [
			self class sharedCacheFolder exists ifFalse: [
				UIManager default inform: 'Attempting to create the repository symlink...'.
				self class run: 'ln -s ~/Dropbox/Repositories/ ~/Dynabook/Repositories' ] ]
		ifFalse: [ UIManager default inform: 'Dropbox repo folder doesn''t exist; creating new shared cache' ].
	[ MCCacheRepository cacheDirectory: self class sharedCacheFolder ensureCreateDirectory ]
		on: Error
		do: [ :err | UIManager default inform: 'Failed setting the shared cache' ]

Remove Dropbox Shared Cache Code

actions
useSharedCacheRepository

	MCCacheRepository cacheDirectory resolve = self class sharedCacheFolder resolve ifTrue: [ ^ self ].
	[ MCCacheRepository cacheDirectory: self class sharedCacheFolder ensureCreateDirectory ]
		on: Error
		do: [ :err | UIManager default inform: 'Failed setting the shared cache' ]


Extension { #name : 'OrderedCollection' }

{ #category : '*GToolkit-GemStone' }
OrderedCollection >> asGtRsrProxyObjectForConnection: aRsrConnection [
	"Answer the receiver with unsupported objects converted to GtRsrProxyServiceServers.
	Ideally we would look up objects in the connection and use the same proxy, but that isn't happening yet."

	^ self collect: [ :each | each asGtRsrProxyObjectForConnection: aRsrConnection ]
]

Send directly a proxy to ordered collections

Extension { #name : 'OrderedCollection' }

{ #category : '*GToolkit-GemStone' }
OrderedCollection >> asGtRsrProxyObjectForConnection: aRsrConnection [
	"Answer the receiver with unsupported objects converted to GtRsrProxyServiceServers.
	Ideally we would look up objects in the connection and use the same proxy, but that isn't happening yet."

	"^ self collect: [ :each | each asGtRsrProxyObjectForConnection: aRsrConnection ]"
    ^ GtRsrProxyServiceServer object: self
]


Class {
	#name : #DADependencyCheckerTest,
	#superclass : #TestCase,
	#instVars : [
		'checker'
	],
	#category : #'Tool-DependencyAnalyser-Test-Core'
}

{ #category : #running }
DADependencyCheckerTest >> setUp [
	super setUp.
	checker := DADependencyChecker new
]

{ #category : #tests }
DADependencyCheckerTest >> testShouldGetDirectDependencies [
	self
		assert: (checker dependenciesOf: 'Tool-DependencyAnalyser-Test-Data')
		equals: #(#Kernel)
]

{ #category : #tests }
DADependencyCheckerTest >> testShouldGetUnresolvedDependencies [
	| result |

	result := (checker unresolvedDependenciesOf: 'Tool-DependencyAnalyser-Test-Data').

	self
		assert: result size
		equals: 1.

	self assert: ((result at: #collect:as:) includesAll: #(#'GT-Spotter' #'Collections-Abstract')).

]

Remove space to trigger CI again


"
Architectural report for Glamorous Toolkit.
"
Class {
	#name : #GtGtoolkitArchitecturalReport,
	#superclass : #GtConstrainerReport,
	#category : #'GToolkit-Constraints'
}

{ #category : #accessing }
GtGtoolkitArchitecturalReport class >> yourself [
	<gtExample>
	^ self new
]

{ #category : #building }
GtGtoolkitArchitecturalReport >> build: aComposite [
	aComposite name: 'GToolkit Architectural Report'.
	aComposite
		addConstraint: GtClassWithCommentsContainingMissingReferences new;
		addConstraint: GtReturnPragmasShouldPointToExistingClasses new;
		addConstraint: GtRBAcceptVisitorCalledFromNonVisitingMethods  new;
		addConstraint: GtButtonsDefiningActionsThroughModels new;
		addConstraint: GtLooksSubscribingToEventsNotFromInitializeListenerMethods new;
		addConstraint: GtBlocEventsShouldHaveDispatchMethodSimilarToClass new;
		addConstraint: GtSubscriptionsShouldNotUseDeliveryConditionWhere new;
		addConstraint: GtTraitsShouldNotBeNested new;
		addConstraint: GtWeakSubscriptionsWithBlockSubscribers new;
		addConstraint: GtBaselinesShouldProperlySpecifyDependencies new";
		addConstraint: GtGitRepositoryWithoutJenkinsFile new"
]

Disable GtClassWithCommentsContainingMissingReferences for the moment

"
Architectural report for Glamorous Toolkit.
"
Class {
	#name : #GtGtoolkitArchitecturalReport,
	#superclass : #GtConstrainerReport,
	#category : #'GToolkit-Constraints'
}

{ #category : #accessing }
GtGtoolkitArchitecturalReport class >> yourself [
	<gtExample>
	^ self new
]

{ #category : #building }
GtGtoolkitArchitecturalReport >> build: aComposite [
	aComposite name: 'GToolkit Architectural Report'.
	aComposite
		"addConstraint: GtClassWithCommentsContainingMissingReferences new;"
		addConstraint: GtReturnPragmasShouldPointToExistingClasses new;
		addConstraint: GtRBAcceptVisitorCalledFromNonVisitingMethods  new;
		addConstraint: GtButtonsDefiningActionsThroughModels new;
		addConstraint: GtLooksSubscribingToEventsNotFromInitializeListenerMethods new;
		addConstraint: GtBlocEventsShouldHaveDispatchMethodSimilarToClass new;
		addConstraint: GtSubscriptionsShouldNotUseDeliveryConditionWhere new;
		addConstraint: GtTraitsShouldNotBeNested new;
		addConstraint: GtWeakSubscriptionsWithBlockSubscribers new;
		addConstraint: GtBaselinesShouldProperlySpecifyDependencies new";
		addConstraint: GtGitRepositoryWithoutJenkinsFile new"
]


Extension { #name : #AsyncSomeValue }

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

	(self value class isComposedBy: TAsyncFuture) ifTrue: [
		^ { self value } ].
	(self value class isComposedBy: TAsyncStream) ifTrue: [
		^ { self value } ].
	^ #(  )
]

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

	^ self printString asRopedText
		  append: ': ' asRopedText;
		  append: ('value=' asRopedText foreground:
					   BrGlamorousColors disabledButtonTextColor);
		  append: (self value printString asRopedText foreground:
					   BrGlamorousColors disabledButtonTextColor)
]

{ #category : #'*GToolkit-Extensions' }
AsyncSomeValue >> gtCompositionFor: aView [

	<gtView>
	^ aView columnedTree
		  title: 'Composition';
		  items: [ { self } ];
		  children: #gtCompositionChildren;
		  expandAll;
		  column: 'Name' text: #gtCompositionDescription;
		  actionUpdateButtonTooltip: 'Update composition tree'
]

{ #category : #'*GToolkit-Extensions' }
AsyncSomeValue >> gtLiveFor: aView [
	^ self gtCompositionFor: aView
]

Make composition in AsyncSomeValue work when collections are involved

Extension { #name : #AsyncSomeValue }

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

	(self value class isComposedBy: TAsyncFuture) ifTrue: [
		^ { self value } ].
	(self value class isComposedBy: TAsyncStream) ifTrue: [
		^ { self value } ].
	(self value isCollection and: [
		 self value allSatisfy: [ :anElement |
			 (anElement class isComposedBy: TAsyncFuture) or: [
				 anElement class isComposedBy: TAsyncStream ] ] ]) ifTrue: [
		^ self value ].
	^ #(  )
]

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

	^ self printString asRopedText
		  append: ': ' asRopedText;
		  append: ('value=' asRopedText foreground:
					   BrGlamorousColors disabledButtonTextColor);
		  append: (self value printString asRopedText foreground:
					   BrGlamorousColors disabledButtonTextColor)
]

{ #category : #'*GToolkit-Extensions' }
AsyncSomeValue >> gtCompositionFor: aView [

	<gtView>
	^ aView columnedTree
		  title: 'Composition';
		  items: [ { self } ];
		  children: #gtCompositionChildren;
		  expandAll;
		  column: 'Name' text: #gtCompositionDescription;
		  actionUpdateButtonTooltip: 'Update composition tree'
]

{ #category : #'*GToolkit-Extensions' }
AsyncSomeValue >> gtLiveFor: aView [
	^ self gtCompositionFor: aView
]


Trait {
	#name : #RSTWalkBasedRegularHorizontalTreeLayout,
	#traits : 'RSTGapsHolder',
	#classTraits : 'RSTGapsHolder classTrait',
	#category : #'Roassal3-Layouts-Core'
}

{ #category : #positioning }
RSTWalkBasedRegularHorizontalTreeLayout >> breadthGapAmong: aShapeParent and: aShape [

	^ self
		  verticalGapAmong: aShapeParent
		  and: aShape
		  default: RSAbstractGraphLayout verticalGap
]

{ #category : #positioning }
RSTWalkBasedRegularHorizontalTreeLayout >> breadthMeasureOf: aShape [

	^ aShape height
]

{ #category : #positioning }
RSTWalkBasedRegularHorizontalTreeLayout >> depthGapAmong: aShapeParent and: aShape [

	^ self
		  horizontalGapAmong: aShapeParent
		  and: aShape
		  default: RSAbstractGraphLayout horizontalGap
]

{ #category : #positioning }
RSTWalkBasedRegularHorizontalTreeLayout >> depthMeasureOf: aShape [

	^ aShape width
]

{ #category : #positioning }
RSTWalkBasedRegularHorizontalTreeLayout >> positionOfShape: aShape atDepth: depth atBreadth: breadth [

	| shift |
	shift := aShape extent / 2.
	^ depth @ breadth + shift
]

Fix the gaps for the horizontal version of the van der Ploeg algorithm.

Trait {
	#name : #RSTWalkBasedRegularHorizontalTreeLayout,
	#traits : 'RSTGapsHolder',
	#classTraits : 'RSTGapsHolder classTrait',
	#category : #'Roassal3-Layouts-Core'
}

{ #category : #positioning }
RSTWalkBasedRegularHorizontalTreeLayout >> breadthGapAmong: aShapeParent and: aShape [

	^ self
		  verticalGapAmong: aShapeParent
		  and: aShape
		  default: RSAbstractGraphLayout horizontalGap
]

{ #category : #positioning }
RSTWalkBasedRegularHorizontalTreeLayout >> breadthMeasureOf: aShape [

	^ aShape height
]

{ #category : #positioning }
RSTWalkBasedRegularHorizontalTreeLayout >> depthGapAmong: aShapeParent and: aShape [

	^ self
		  horizontalGapAmong: aShapeParent
		  and: aShape
		  default: RSAbstractGraphLayout verticalGap
]

{ #category : #positioning }
RSTWalkBasedRegularHorizontalTreeLayout >> depthMeasureOf: aShape [

	^ aShape width
]

{ #category : #positioning }
RSTWalkBasedRegularHorizontalTreeLayout >> positionOfShape: aShape atDepth: depth atBreadth: breadth [

	| shift |
	shift := aShape extent / 2.
	^ depth @ breadth + shift
]


Class {
	#name : #GtSceneryDocumenterTutorialForFaceAPI,
	#superclass : #GtScenery,
	#category : #'GToolkit-Scenery'
}

{ #category : #initialization }
GtSceneryDocumenterTutorialForFaceAPI >> setUp [
	| book |
	book := GtPlayBook newDefault.
	book pages first snippets first sourceCode: 'IceLibgitRepository repositoriesLocation / ''feenkcom''/ ''gtoolkit-demos'' / ''doc'' / ''tutorial'' / ''esug-2018'' / ''esug-2018-exemplifying-software.pillar'''.
	(GtInspector openOnPlayBook: book)
]

Add scenery for the FaceAPI example document

Class {
	#name : #GtSceneryDocumenterTutorialForFaceAPI,
	#superclass : #GtScenery,
	#category : #'GToolkit-Scenery'
}

{ #category : #'world menu' }
GtSceneryDocumenterTutorialForFaceAPI class >> menuCommandOn: aBuilder [
	<worldMenu>
	(aBuilder item: self name)
		order: 221.0;
		parent: #GToolkitScenery;
		label: 'Documenter: Examples tutorial - Face API';
		action: [self new setUp]
]

{ #category : #initialization }
GtSceneryDocumenterTutorialForFaceAPI >> setUp [
	| book |
	book := GtPlayBook newDefault.
	book pages first snippets first sourceCode: 'IceLibgitRepository repositoriesLocation / ''feenkcom''/ ''gtoolkit-demos'' / ''doc'' / ''tutorial'' / ''esug-2018'' / ''esug-2018-exemplifying-software.pillar'''.
	(GtInspector openOnPlayBook: book)
]


tests
testDoIt
	"Serialization of DoIt methods should be possible by default.
	Note: apparently this test didn't use to terminate some times.
	I've added the #valueWithin:onTimeout: as a fallback for that."
	| context |
	[
		[ Smalltalk compiler evaluate: 'self error' ]
			on: Error
			do: [:error | context := error signalerContext copyStack ].

		self serialize: context ]
			valueWithin: 30 seconds
			onTimeout: [ self fail ]

Use TestCase>>timeLimit: to prevent test from never terminating instead on BlockClosure>>valueWithin:onTimeout:

tests
testDoIt
	"Serialization of DoIt methods should be possible by default.
	Note: apparently this test didn't use to terminate some times."

	| context |
	self timeLimit: 30 seconds.
	[ Smalltalk compiler evaluate: 'self error' ]
		on: Error
		do: [ :error | context := error signalerContext copyStack ].
	self serialize: context


tests
testCanSerializeAPackageDependencyOnExternalCargoProject
	| project projectStonString |

	project := self counterUiProject.
	projectStonString := STON toStringPretty: project asVcsSerializedCargoProject.

	self
		assert: projectStonString
		equals: 'OngoingProject {
	#name : #Counter-UI,
	#description : ''Small UI for the counter model.'',
	#externalProjects : [
		CGOCargoProjectDependency {
			#repository : CGOGitRepository {
				#repositoryUrl : ''git://git@github.com/demarey/pharo-counter-ui.git'',
				#version : ''master''
			}
		}
	],
	#units : [
		OngoingPackageUnit {
			#name : #Counter-UI-Spec,
			#description : ''Core package with the counter UI based on Spec.'',
			#dependencies : [
				#''Counter::Counter-Core''
			]
		}
	]
}'

Fix test broken due to merge

tests
testCanSerializeAPackageDependencyOnExternalCargoProject
	| project projectStonString |

	project := self counterUiProject.
	projectStonString := STON toStringPretty: project asVcsSerializedCargoProject.

	self
		assert: projectStonString
		equals: 'OngoingProject {
	#name : #Counter-UI,
	#description : ''Small UI for the counter model.'',
	#externalProjects : [
		CGOCargoProjectDependency {
			#repository : CGOGitRepository {
				#repositoryUrl : ''git://git@github.com/demarey/pharo-counter-ui.git'',
				#version : ''master''
			},
			#name : ''pharo-counter'',
			#version : ''''
		}
	],
	#units : [
		OngoingPackageUnit {
			#name : #Counter-UI-Spec,
			#description : ''Core package with the counter UI based on Spec.'',
			#dependencies : [
				#''Counter::Counter-Core''
			]
		}
	]
}'


"
A number animation to handle a number and interpolate between values
"
Class {
	#name : #RTNumberAnimation,
	#superclass : #RTAnimation,
	#instVars : [
		'time',
		'blockToExcute',
		'animatedValue'
	],
	#category : #'Roassal2-Animation'
}

{ #category : #api }
RTNumberAnimation >> during: seconds [
	time := TRVITimer new cycleLength: seconds.
]

{ #category : #refreshing }
RTNumberAnimation >> hasCompleted [
	| r |
	(r := animatedValue hasCompleted)
		ifTrue: [ self refresh ].
	^ r
]

{ #category : #enumerating }
RTNumberAnimation >> onStepDo: aBlock [
	blockToExcute := aBlock
]

{ #category : #refreshing }
RTNumberAnimation >> refresh [
	blockToExcute value: animatedValue value
]

{ #category : #actions }
RTNumberAnimation >> start [
	animatedValue := TRVIAnimatedValue new
		timer: time;
		yourself.
	animatedValue start.
]

Update interaction for execute a block after finished

"
A number animation to handle a number and interpolate between values
"
Class {
	#name : #RTNumberAnimation,
	#superclass : #RTAnimation,
	#instVars : [
		'time',
		'blockToExcute',
		'animatedValue',
		'afterBlock'
	],
	#category : #'Roassal2-Animation'
}

{ #category : #accessing }
RTNumberAnimation >> after: aBlock [
	afterBlock := aBlock
]

{ #category : #api }
RTNumberAnimation >> during: seconds [
	time := TRVITimer new cycleLength: seconds.
]

{ #category : #refreshing }
RTNumberAnimation >> hasCompleted [
	| r |
	(r := animatedValue hasCompleted)
		ifTrue: [ self refresh ].
	^ r
]

{ #category : #enumerating }
RTNumberAnimation >> onStepDo: aBlock [
	blockToExcute := aBlock
]

{ #category : #refreshing }
RTNumberAnimation >> refresh [
	blockToExcute value: animatedValue value
]

{ #category : #actions }
RTNumberAnimation >> start [
	animatedValue := TRVIAnimatedValue new
		timer: time;
		finishCallback: afterBlock;
		yourself.
	animatedValue start.
]


Class {
	#name : #BlRadialGradientPaint,
	#superclass : #BlGradientPaint,
	#instVars : [
		'center',
		'radius',
		'focalPoint'
	],
	#category : #'Bloc-Paint'
}

{ #category : #accessing }
BlRadialGradientPaint >> center [
	^ center
]

{ #category : #accessing }
BlRadialGradientPaint >> center: aPoint [
	center := aPoint
]

{ #category : #geometry }
BlRadialGradientPaint >> matchExtent: anExtent [
]

{ #category : #accessing }
BlRadialGradientPaint >> radius [
	^ radius
]

{ #category : #accessing }
BlRadialGradientPaint >> radius: aNumber [
	radius := aNumber
]

Remove unused slot in BlRadialGradientPaint

Class {
	#name : #BlRadialGradientPaint,
	#superclass : #BlGradientPaint,
	#instVars : [
		'center',
		'radius'
	],
	#category : #'Bloc-Paint'
}

{ #category : #accessing }
BlRadialGradientPaint >> center [
	^ center
]

{ #category : #accessing }
BlRadialGradientPaint >> center: aPoint [
	center := aPoint
]

{ #category : #geometry }
BlRadialGradientPaint >> matchExtent: anExtent [
]

{ #category : #accessing }
BlRadialGradientPaint >> radius [
	^ radius
]

{ #category : #accessing }
BlRadialGradientPaint >> radius: aNumber [
	radius := aNumber
]


Class {
	#name : #BaselineOfPetitParser2Core,
	#superclass : #BaselineOf,
	#category : 'BaselineOfPetitParser2Core'
}

{ #category : #baselines }
BaselineOfPetitParser2Core >> baseline: spec [
	<baseline>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec description: 'PetitParser2Core'.
		spec repository: 'github://kursjan/petitparser2:master'.
		spec
			package: 'PetitParser2';
			package: 'PetitParser2-Tests' with: [
				spec requires: #('PetitParser2') ];
			package: 'PetitParser2-Validation' with: [
				spec requires: #('PetitParser2') ];
			package: 'PetitParser2-Validation-Tests' with: [
				spec requires: #('PetitParser2-Validation' 'PetitParser2-Tests') ];

			package: 'PetitParser2-Benchmarks' with: [
				spec requires: #('PetitParser2' 'PetitParser2-Validation') ]
	]
]

Remove the baseline repo spec to allow for forking.

Class {
	#name : #BaselineOfPetitParser2Core,
	#superclass : #BaselineOf,
	#category : 'BaselineOfPetitParser2Core'
}

{ #category : #baselines }
BaselineOfPetitParser2Core >> baseline: spec [
	<baseline>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec description: 'PetitParser2Core'.
		spec
			package: 'PetitParser2';
			package: 'PetitParser2-Tests' with: [
				spec requires: #('PetitParser2') ];
			package: 'PetitParser2-Validation' with: [
				spec requires: #('PetitParser2') ];
			package: 'PetitParser2-Validation-Tests' with: [
				spec requires: #('PetitParser2-Validation' 'PetitParser2-Tests') ];

			package: 'PetitParser2-Benchmarks' with: [
				spec requires: #('PetitParser2' 'PetitParser2-Validation') ]
	]
]


Class {
	#name : #BrTextStylerSignal,
	#superclass : #ContextStackSignal,
	#category : #'Brick-Editor-Signals'
}

Make BrTextStylerSignal just a BeaconSignal.

Class {
	#name : #BrTextStylerSignal,
	#superclass : #BeaconSignal,
	#category : #'Brick-Editor-Signals'
}


"
I'm a file strategy that identifies the pillar file on the root of the repository: i.e., index.pillar or book.pillar.

I (will be) used when the user types
	pillar build pdf
"
Class {
	#name : #PRBuildRootMainStrategy,
	#superclass : #PRBuildStrategy,
	#category : #'Pillar-ExporterCore-Base'
}

{ #category : #accessing }
PRBuildRootMainStrategy >> filesToBuildOn: aProject [
	"select the only file with pillar extension in current directory ; if there is no OR several pillar files, relative error is raised"
	"Now it select a file named index which can be a pillar or a microdown file and if there is no one, relative error is raised"

	| pillarFiles|
	pillarFiles := aProject baseDirectory children select: [ :each | each isFile and: [ each base = 'index'  and: [ self isSupportedExtension: each  extension ]] ].
	pillarFiles ifEmpty: [ self error: 'There is no pillar (md or pillar) file in the repository root.' ].
	pillarFiles size = 1 ifTrue: [ ^ { (PRInputDocument forFile: pillarFiles first)
			project: aProject;
			yourself } ].
	self error: 'There is more than one pillar file in the repository root.'
]

Change fileToBuildOn for not considering the README as file to convert

"
I'm a file strategy that identifies the pillar file on the root of the repository: i.e., index.pillar or book.pillar.

I (will be) used when the user types
	pillar build pdf
"
Class {
	#name : #PRBuildRootMainStrategy,
	#superclass : #PRBuildStrategy,
	#category : #'Pillar-ExporterCore-Base'
}

{ #category : #accessing }
PRBuildRootMainStrategy >> filesToBuildOn: aProject [
	"select the only file with pillar extension in current directory ; if there is no OR several pillar files, relative error is raised"
	"Now it select a file named index which can be a pillar or a microdown file and if there is no one, relative error is raised"

	| pillarFiles|
	pillarFiles := aProject baseDirectory children select: [ :each | each isFile and:[ self isSupportedExtension: each  extension ] ].
	pillarFiles reject: [ :each | each basename = 'README' ].
	pillarFiles ifEmpty: [ self error: 'There is no pillar (md or pillar) file in the repository root.' ].
	pillarFiles size = 1 ifTrue: [ ^ { (PRInputDocument forFile: pillarFiles first)
			project: aProject;
			yourself } ].
	self error: 'There is more than one pillar file in the repository root.'
]


"
I am an object representing the current image to get all sorted packages for browsing.

CurrentImage new packages
	=> all packages in the image sorted

THIS CLASS IS NOW DEPRECATED AND BSOLETE - please use

  Smalltalk image packages

to receive all packages in the image sorted
"
Class {
	#name : #CurrentImage,
	#superclass : #Object,
	#category : #Deprecated70
}

{ #category : #testing }
CurrentImage class >> isDeprecated [

	^true
]

{ #category : #accessing }
CurrentImage >> packages [
	self deprecated: 'Use Smalltalk image packages'.
	^ (RPackageOrganizer default packages) sorted
]

Add missing character in word OBSOLETE

"
I am an object representing the current image to get all sorted packages for browsing.

CurrentImage new packages
	=> all packages in the image sorted

THIS CLASS IS NOW DEPRECATED AND OBSOLETE - please use

  Smalltalk image packages

to receive all packages in the image sorted
"
Class {
	#name : #CurrentImage,
	#superclass : #Object,
	#category : #Deprecated70
}

{ #category : #testing }
CurrentImage class >> isDeprecated [

	^true
]

{ #category : #accessing }
CurrentImage >> packages [
	self deprecated: 'Use Smalltalk image packages'.
	^ (RPackageOrganizer default packages) sorted
]


accessing
userLocalDirectory
	^ UserLocalDirectory ifNil: [
		FileLocator workingDirectory / self defaultLocalDirectoryName  ]

Move localDirectory to imageDirectory by default

accessing
userLocalDirectory
	^ UserLocalDirectory ifNil: [
		FileLocator imageDirectory / self defaultLocalDirectoryName  ]


execution
execute
	| icePackages iceRepos mcPackages |
	packages ifEmpty: [ ^IceRepositoriesBrowser open ].

	icePackages := packages select: [ :each | [each iceRepository. true] ifError: [false]].
	iceRepos := icePackages collect: [ :each | each iceRepository ] as: Set.
	iceRepos do: [ :each | IceSynchronizeBrowser synchronize: each ].

	mcPackages := packages copyWithoutAll: icePackages.
	mcPackages ifNotEmpty: [
		Komitter openAndCommitToMonticelloWorkingCopiesFilteredBy: [ :workingCopy |
			"simple #includes: not works here. Somehow packages are different"
			mcPackages anySatisfy: [ :each | each name = workingCopy package name]]]

Remove support for mc driven packages. Adopted to latest iceberg 0.7 with dialog to choose repository for commit

execution
execute
	| repoBrowser commitBrowser repos targetRepo |
	repoBrowser := self class environment at: #IceTipRepositoriesBrowser ifAbsent: [
		^ self inform: 'Iceberg 0.7 and higher is required'].
	commitBrowser := self class environment at: #IceTipCommitBrowser ifAbsent: [
		^ self inform: 'Iceberg 0.7 and higher is required'].
	packages ifEmpty: [ ^repoBrowser new openWithSpec ].

	repos := IceRepository registry select: [ :repo |
		packages anySatisfy: [:each | repo includesPackageNamed: each name ]].
	repos ifEmpty: [ ^self inform: 'Selected packages does not managed by Iceberg'].
	targetRepo := repos size = 1 ifTrue: [ repos first ] ifFalse: [
		UIManager default
			chooseFrom: (repos collect: #name) values: repos title: 'Choose repository'].
	targetRepo ifNil: [ ^self ].

	(commitBrowser onRepository: targetRepo) openWithSpec


execution
execute
	unitName := UIManager default
		request: 'Package unit name'
		initialAnswer: ''.
	unitName isEmptyOrNil ifTrue: [ CmdCommandAborted signal ].

	(toolContext systemEnvironment packageOrganizer includesPackageNamed: unitName)
		ifTrue: [ self error: 'Package ', unitName ,' already exists' ].

	self createSystemPackage.
	project newPackageUnit: unitName.

Enhance a bit the Package name dialog

execution
execute
	unitName := UIManager default
		request: 'New package name'
		initialAnswer: project name, '-'.
	unitName isEmptyOrNil ifTrue: [ CmdCommandAborted signal ].

	(toolContext systemEnvironment packageOrganizer includesPackageNamed: unitName)
		ifTrue: [ self error: 'Package ', unitName ,' already exists' ].

	self createSystemPackage.
	project newPackageUnit: unitName.


"Use Latin American Mirror"
Gofer new
  url: 'http://dsal.cl/squeaksource/ObjectsAsMethodsWrap';
  package: 'ObjectAsMethodWrapper';
  load.

Gofer new
  url: 'http://dsal.cl/squeaksource/MonticelloRedirect';
  package: 'MontiRedirect';
  load.

"If the LatAm mirror is available, use that. Otherwise, try use SqueakSource."
(NetNameResolver addressForName: 'dsal.cl')
    ifNotNil: [(Smalltalk at: #MRManager)
      redirectFrom: 'http://www.squeaksource.com/'
    to: 'http://dsal.cl/squeaksource/'].

Use SS directly while dsal.cl is down.

"Use Latin American Mirror"
Gofer new
  url: 'http://www.squeaksource.com/squeaksource/ObjectsAsMethodsWrap';
  package: 'ObjectAsMethodWrapper';
  load.

Gofer new
  url: 'http://www.squeaksource.com/squeaksource/MonticelloRedirect';
  package: 'MontiRedirect';
  load.

"If the LatAm mirror is available, use that. Otherwise, try use SqueakSource."
(NetNameResolver addressForName: 'dsal.cl')
    ifNotNil: [(Smalltalk at: #MRManager)
      redirectFrom: 'http://www.squeaksource.com/'
    to: 'http://dsal.cl/squeaksource/'].


private
ensureIceberg
	(Smalltalk hasClassNamed: #Iceberg)
		ifTrue: [ ^ self ].

	"Iceberg is not installed, installing..."
	Metacello new
		baseline: 'Iceberg';
		repository: 'github://npasserini/iceberg';
		load

Update baseline, move to Iceberg dev-0.4

private
ensureIceberg
	(Smalltalk hasClassNamed: #Iceberg)
		ifTrue: [ ^ self ].

	"Iceberg is not installed, installing..."
	Metacello new
		baseline: 'Iceberg';
		repository: 'github://npasserini/iceberg:dev-0.4';
		load


| runner failures errors buildDir |

buildDir := OSPlatform current environment at: 'TRAVIS_BUILD_DIR'.

Gofer new
  url: 'filetree://', buildDir, '/src'
    username: ''
    password: '';
  package: 'MicroKanren';
  load.

runner := CommandLineTestRunner runPackage: 'MicroKanren'.

failures := runner instVarNamed: #suiteFailures.
errors := runner instVarNamed: #suiteErrors.

(errors ~= 0) | (failures ~= 0)
  ifTrue: [ SmalltalkImage current exitFailure ].

SmalltalkImage current exitSuccess.

Use Metacello to fetch the package and init the image

| runner failures errors buildDir |

buildDir := OSPlatform current environment at: 'TRAVIS_BUILD_DIR'.

Metacello new
  baseline: 'MicroKanren';
  repository: 'filetree://', buildDir, '/src';
  load.

runner := CommandLineTestRunner runPackage: 'MicroKanren'.

failures := runner instVarNamed: #suiteFailures.
errors := runner instVarNamed: #suiteErrors.

(errors ~= 0) | (failures ~= 0)
  ifTrue: [ SmalltalkImage current exitFailure ].

SmalltalkImage current exitSuccess.


"
The principal class of `CTMC`
"
Class {
	#name : #K2CTMC,
	#superclass : #Object,
	#instVars : [
		'states',
		'currentState'
	],
	#category : #'Kendrick2-CTMC-Core'
}

{ #category : #accessing }
K2CTMC >> currentState [
	^ currentState
]

{ #category : #accessing }
K2CTMC >> currentState: anObject [
	currentState := anObject
]

{ #category : #'as yet unclassified' }
K2CTMC >> goToNextState [
	currentState := currentState nextState.
]

{ #category : #'as yet unclassified' }
K2CTMC >> probabilityFrom: aFromStateIndex to: aToStateIndex [

	^ ((self states at: aFromStateIndex ) transitionArray at: aToStateIndex ) probability .
]

{ #category : #accessing }
K2CTMC >> states [
	^ states
]

{ #category : #accessing }
K2CTMC >> states: anObject [
	states := anObject
]

Define the transition of CTMC

"
The principal class of `CTMC`
"
Class {
	#name : #K2CTMC,
	#superclass : #Object,
	#instVars : [
		'states',
		'currentState'
	],
	#category : #'Kendrick2-CTMC-Core'
}

{ #category : #accessing }
K2CTMC >> currentState [
	^ currentState
]

{ #category : #accessing }
K2CTMC >> currentState: anObject [
	currentState := anObject
]

{ #category : #'instance creation' }
K2CTMC >> fromState: anInteger toAnotherState: anInteger2 probability: aNumber [
	|transition|
	transition := K2CTMCTransition new.
	transition from: (states at: anInteger);to: (states at: anInteger2 );probability: aNumber.
	(states at: anInteger) transitionArray add: transition .
]

{ #category : #'as yet unclassified' }
K2CTMC >> goToNextState [
	currentState := currentState nextState.
]

{ #category : #'as yet unclassified' }
K2CTMC >> probabilityFrom: aFromStateIndex to: aToStateIndex [

	^ ((self states at: aFromStateIndex ) transitionArray at: aToStateIndex ) probability .
]

{ #category : #accessing }
K2CTMC >> states [
	^ states
]

{ #category : #accessing }
K2CTMC >> states: anObject [
	states := anObject
]


Extension { #name : #ClassTestCase }

{ #category : #'*Manifest-Core' }
ClassTestCase >> assertValidLintRule: aLintRule [
	| runner |
	runner := ReSmalllintChecker new.
	runner
		rule: {aLintRule};
		environment: RBBrowserEnvironment default;
		run.
	self
		assert: (runner criticsOf: aLintRule) isEmpty
		description: [ aLintRule rationale ]
]

{ #category : #'*Manifest-Core' }
ClassTestCase >> targetClassEnvironment [
	^RBClassEnvironment class: self targetClass.
]

Use targetClassEnvironment in ClassTestCase rule validation

Extension { #name : #ClassTestCase }

{ #category : #'*Manifest-Core' }
ClassTestCase >> assertValidLintRule: aLintRule [
	| runner |
	runner := ReSmalllintChecker new.
	runner
		rule: {aLintRule};
		environment: self targetClassEnvironment;
		run.
	self
		assert: (runner criticsOf: aLintRule) isEmpty
		description: [ aLintRule rationale ]
]

{ #category : #'*Manifest-Core' }
ClassTestCase >> targetClassEnvironment [
	^RBClassEnvironment class: self targetClass.
]


"
I am bridging RoassalModel and RTView
"
Class {
	#name : #MorphicRoassalAdapter,
	#superclass : #AbstractMorphicAdapter,
	#instVars : [
		'view',
		'canvas'
	],
	#category : #Roassal2Spec
}

{ #category : #specs }
MorphicRoassalAdapter class >> defaultSpec [
	<spec>

	^ #(RTView)
]

{ #category : #private }
MorphicRoassalAdapter >> adapt: aComposableModel [

	super adapt: aComposableModel.
	view := widget.
	canvas := widget createAndFillCanvas.
	widget := canvas buildMorph.
	widget
		hResizing: #spaceFill;
		vResizing: #spaceFill.

	self applyScript

]

{ #category : #private }
MorphicRoassalAdapter >> applyScript [

	self freeCanvas.

	self model script
		cull: view
		cull: canvas.

	self widgetDo: [ :w | w startStepping ]
]

{ #category : #private }
MorphicRoassalAdapter >> freeCanvas [

	view elements do: [ :e | view removeElement: e ].
	self widgetDo: [ :w | w changed ]
]

Fix it to stick with latest Roassal2 changes

"
I am bridging RoassalModel and RTView
"
Class {
	#name : #MorphicRoassalAdapter,
	#superclass : #AbstractMorphicAdapter,
	#instVars : [
		'view',
		'canvas'
	],
	#category : #Roassal2Spec
}

{ #category : #specs }
MorphicRoassalAdapter class >> defaultSpec [
	<spec>

	^ #(RTView)
]

{ #category : #private }
MorphicRoassalAdapter >> adapt: aComposableModel [

	super adapt: aComposableModel.
	view := widget.
	canvas := widget setUpCanvas.
	widget := canvas buildMorph.
	widget
		hResizing: #spaceFill;
		vResizing: #spaceFill.

	self applyScript

]

{ #category : #private }
MorphicRoassalAdapter >> applyScript [

	self freeCanvas.

	self model script
		cull: view
		cull: canvas.

	self widgetDo: [ :w | w startStepping ]
]

{ #category : #private }
MorphicRoassalAdapter >> freeCanvas [

	view elements do: [ :e | view removeElement: e ].
	self widgetDo: [ :w | w changed ]
]


"Load Phanide"
Metacello new
    baseline: 'Phanide';
    repository: 'tonel://source-deps/phanide/tonel';
    load.

"Load Lowtalk"
Metacello new
    baseline: 'Lowtalk';
    repository: 'tonel://source-deps/lowtalk/tonel';
    load.

"Load BabylonGraphics API"
Metacello new
    baseline: 'Babylon';
    repository: 'tonel://source-deps/babylon-graphics/tonel';
    load: #(API).
Metacello new
    baseline: 'CyrusToolkit';
    repository: 'tonel://source-deps/babylon-graphics/tonel';
    load.

"Build the Lowtalk source code"
SourceFiles deferFlushDuring: [
    | compilationTarget compilerClass compiler |
    compilationTarget := (Smalltalk globals at: #SLVMCompilationTarget) forCurrentImage.
    compilerClass := Smalltalk globals at: #LowtalkCompiler.

    compiler := compilerClass compilationTarget: compilationTarget.
    compiler
    	optimizationLevel: 1;
    	evaluateFileNamed: 'source/woden.ltk';
	    buildModule;
    	ssaModule.

].

"Load WodenEngine"
FileStream stdout nextPutAll: 'Loading Woden'; lf.
Metacello new
  baseline: 'WodenEngine';
  repository: 'tonel://tonel';
  load.

"Save the image"
(Smalltalk saveAs: 'woden')
    ifFalse: [ Smalltalk snapshot: false andQuit: true ].

Use the correct baseline for loading babylon graphics.

"Load Phanide"
Metacello new
    baseline: 'Phanide';
    repository: 'tonel://source-deps/phanide/tonel';
    load.

"Load Lowtalk"
Metacello new
    baseline: 'Lowtalk';
    repository: 'tonel://source-deps/lowtalk/tonel';
    load.

"Load BabylonGraphics API"
Metacello new
    baseline: 'BabylonGraphics';
    repository: 'tonel://source-deps/babylon-graphics/tonel';
    load: #(API).
Metacello new
    baseline: 'CyrusToolkit';
    repository: 'tonel://source-deps/babylon-graphics/tonel';
    load.

"Build the Lowtalk source code"
SourceFiles deferFlushDuring: [
    | compilationTarget compilerClass compiler |
    compilationTarget := (Smalltalk globals at: #SLVMCompilationTarget) forCurrentImage.
    compilerClass := Smalltalk globals at: #LowtalkCompiler.

    compiler := compilerClass compilationTarget: compilationTarget.
    compiler
    	optimizationLevel: 1;
    	evaluateFileNamed: 'source/woden.ltk';
	    buildModule;
    	ssaModule.

].

"Load WodenEngine"
FileStream stdout nextPutAll: 'Loading Woden'; lf.
Metacello new
  baseline: 'WodenEngine';
  repository: 'tonel://tonel';
  load.

"Save the image"
(Smalltalk saveAs: 'woden')
    ifFalse: [ Smalltalk snapshot: false andQuit: true ].


Class {
	#name : #BlWeakRef,
	#superclass : #WeakArray,
	#type : #weak,
	#traits : 'TBlDebug',
	#classTraits : 'TBlDebug classTrait',
	#category : #'Bloc-Basic-Support'
}

{ #category : #'as yet unclassified' }
BlWeakRef class >> new [
	^ self new: 1
]

{ #category : #'as yet unclassified' }
BlWeakRef >> value [
	^ self at: 1 ifAbsent: [ nil ]
]

{ #category : #'as yet unclassified' }
BlWeakRef >> value: anObject [
	self at:1 put: anObject
]

Remove BlWeakRef since it is unused.


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

Test create CTMC who have 4 states

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

{ #category : #tests }
K2CMTCWithFourStatesTest >> testCreateCTMCofFourStates [

<gtExample>
| ctmc |

ctmc :=self createCTMCWithFourStates.

self assert: (ctmc class  = K2CTMC).
^ctmc
]


"
The principal class of `CTMC`
"
Class {
	#name : #K2CTMC,
	#superclass : #Object,
	#instVars : [
		'states',
		'currentState'
	],
	#category : #'Kendrick2-CTMC-Core'
}

{ #category : #accessing }
K2CTMC >> states [
	^ states
]

{ #category : #accessing }
K2CTMC >> states: anObject [
	states := anObject
]

Define the current state of CTMC

"
The principal class of `CTMC`
"
Class {
	#name : #K2CTMC,
	#superclass : #Object,
	#instVars : [
		'states',
		'currentState'
	],
	#category : #'Kendrick2-CTMC-Core'
}

{ #category : #accessing }
K2CTMC >> currentState [
	^ currentState
]

{ #category : #accessing }
K2CTMC >> currentState: anObject [
	currentState := anObject
]

{ #category : #accessing }
K2CTMC >> states [
	^ states
]

{ #category : #accessing }
K2CTMC >> states: anObject [
	states := anObject
]


actions
updateReadme
	<script>
	| repo |
	repo := MCFileTreeGitRepository allInstances
		detect: [ :each | each shortDirectoryDescription = 'IconFactory/repository' ].
	(repo directory parent / 'README.md')
		ensureDelete;
		writeStreamDo: [ :stream |
			stream wantsLineEndConversion: true.
			stream
				nextPutAll: '# IconFactory';
				nextPutAll: String lf;
				nextPutAll: String lf.
			stream nextPutAll: IconFactory comment ]

Add travis icon to the build.

actions
updateReadme
	<script>
	| repo |
	repo := MCFileTreeGitRepository allInstances
		detect: [ :each | each shortDirectoryDescription = 'IconFactory/repository' ].
	(repo directory parent / 'README.md')
		ensureDelete;
		writeStreamDo: [ :stream |
			stream wantsLineEndConversion: true.
			stream
				nextPutAll: '# IconFactory ';
				nextPutAll:
					'[![Build Status](https://travis-ci.org/peteruhnak/IconFactory.svg?branch=master)](https://travis-ci.org/peteruhnak/IconFactory)';
				nextPutAll: String lf;
				nextPutAll: String lf.
			stream nextPutAll: IconFactory comment ]


Class {
	#name : #BlSlideHandler,
	#superclass : #BlElementEventListener,
	#instVars : [
		'originalPosition',
		'dragStartPosition'
	],
	#category : #'Bloc-Utilities - Drag&Drop'
}

{ #category : #'dnd handlers' }
BlSlideHandler >> dragEvent: anEvent [
	| aSlideDelta |
	anEvent consumed: true.

	aSlideDelta := anEvent localPosition - dragStartPosition.

	anEvent currentTarget childrenDo: [ :aChild | aChild relocate: aChild position + aSlideDelta ].
	dragStartPosition := anEvent localPosition.
]

{ #category : #'dnd handlers' }
BlSlideHandler >> dragStartEvent: anEvent [
	anEvent consumed: true.

	"drag start position in local"
	dragStartPosition := anEvent localPosition.
]

Move only those children who are accounted by layout

Class {
	#name : #BlSlideHandler,
	#superclass : #BlElementEventListener,
	#instVars : [
		'originalPosition',
		'dragStartPosition'
	],
	#category : #'Bloc-Utilities - Drag&Drop'
}

{ #category : #'dnd handlers' }
BlSlideHandler >> dragEvent: anEvent [
	| aSlideDelta |
	anEvent consumed: true.

	aSlideDelta := anEvent localPosition - dragStartPosition.

	anEvent currentTarget children accountedByLayout do: [ :aChild | aChild relocate: aChild position + aSlideDelta ].
	dragStartPosition := anEvent localPosition.
]

{ #category : #'dnd handlers' }
BlSlideHandler >> dragStartEvent: anEvent [
	anEvent consumed: true.

	"drag start position in local"
	dragStartPosition := anEvent localPosition.
]


Class {
	#name : #LowtalkMethodArgument,
	#superclass : #LowtalkMethodLocalVariable,
	#category : #'Lowtalk-Core-Environment'
}

{ #category : #'code generation' }
LowtalkMethodArgument >> emitSSAVariableLoadWith: codeGenerator builder: builder at: node [
	self assert: ssaValue isNotNil.
	method ~~ codeGenerator method ifTrue: [
		^ codeGenerator captureInClosure: ssaValue
	].

	^ ssaValue
]

{ #category : #'code generation' }
LowtalkMethodArgument >> emitSSAVariableReferenceWith: codeGenerator builder: builder at: node [
	self error: 'Cannot get reference to argument'
]

{ #category : #testing }
LowtalkMethodArgument >> isArgument [
	^ true
]

{ #category : #accessing }
LowtalkMethodArgument >> valueType: aValueType [
	valueType := aValueType.
	type := aValueType.
]

Allow a method argument to be a reference.

Class {
	#name : #LowtalkMethodArgument,
	#superclass : #LowtalkMethodLocalVariable,
	#category : #'Lowtalk-Core-Environment'
}

{ #category : #'code generation' }
LowtalkMethodArgument >> emitSSAVariableLoadWith: codeGenerator builder: builder at: node [
	self assert: ssaValue isNotNil.
	method ~~ codeGenerator method ifTrue: [
		^ codeGenerator captureInClosure: ssaValue
	].

	^ ssaValue
]

{ #category : #'code generation' }
LowtalkMethodArgument >> emitSSAVariableReferenceWith: codeGenerator builder: builder at: node [
	valueType isReferenceType ifTrue: [ ^ self emitSSAVariableLoadWith: codeGenerator builder: builder at: node ].
	self error: 'Cannot get reference to argument'
]

{ #category : #testing }
LowtalkMethodArgument >> isArgument [
	^ true
]

{ #category : #accessing }
LowtalkMethodArgument >> valueType: aValueType [
	valueType := aValueType.
	type := aValueType.
]


"
A number animation to handle a number and interpolate between values
"
Class {
	#name : #RTNumberAnimation,
	#superclass : #RTAnimation,
	#instVars : [
		'time',
		'blockToExcute',
		'animatedValue'
	],
	#category : #'Roassal2-Animation'
}

{ #category : #api }
RTNumberAnimation >> during: seconds [
	time := TRVITimer new cycleLength: seconds.
]

{ #category : #refreshing }
RTNumberAnimation >> hasCompleted [
	| r |
	(r := animatedValue hasCompleted)
		ifTrue: [ self refresh ].
	^ r
]

{ #category : #enumerating }
RTNumberAnimation >> onStepDo: aBlock [
	blockToExcute := aBlock
]

{ #category : #refreshing }
RTNumberAnimation >> refresh [
	blockToExcute value: animatedValue value
]

{ #category : #actions }
RTNumberAnimation >> start [
	animatedValue := TRVIAnimatedValue new
		timer: time;
		yourself.
	animatedValue start.
]

Update interaction for execute a block after finished

"
A number animation to handle a number and interpolate between values
"
Class {
	#name : #RTNumberAnimation,
	#superclass : #RTAnimation,
	#instVars : [
		'time',
		'blockToExcute',
		'animatedValue',
		'afterBlock'
	],
	#category : #'Roassal2-Animation'
}

{ #category : #accessing }
RTNumberAnimation >> after: aBlock [
	afterBlock := aBlock
]

{ #category : #api }
RTNumberAnimation >> during: seconds [
	time := TRVITimer new cycleLength: seconds.
]

{ #category : #refreshing }
RTNumberAnimation >> hasCompleted [
	| r |
	(r := animatedValue hasCompleted)
		ifTrue: [ self refresh ].
	^ r
]

{ #category : #enumerating }
RTNumberAnimation >> onStepDo: aBlock [
	blockToExcute := aBlock
]

{ #category : #refreshing }
RTNumberAnimation >> refresh [
	blockToExcute value: animatedValue value
]

{ #category : #actions }
RTNumberAnimation >> start [
	animatedValue := TRVIAnimatedValue new
		timer: time;
		finishCallback: afterBlock;
		yourself.
	animatedValue start.
]


structure class
createInImageClassObject
	| layoutClass instanceSlots superClassObject |
	layoutClass := self inImageStructureLayoutClass.
	self slots.
	instanceSlots := allSlots collect: [:slot | (SLVMStructureFieldSlot named: slot name) type: slot type ssaType].

	self flag: 'HACK: remove the methods from the class to avoid triggering recompilation with the wrong compiler.'.
	(name isNotNil and: [ Smalltalk globals includesKey: name ]) ifTrue: [
		(Smalltalk globals at: name) methodDict removeAll.
		(Smalltalk globals at: name) class methodDict removeAll.
	].

	superClassObject := SLVMInternalStructure.
	classObject := superClassObject classInstaller make: [ :builder |
		name ifNotNil: [
			builder name: name asSymbol
		].
		builder
			superclass: superClassObject;
			layoutClass: layoutClass;
			slots: instanceSlots;
			sharedVariables: '';
			sharedPools: '';
			category: self category
	].

	classObject classLayout minimalAlignment: minimalAlignment.
	compiler importImageClassType: classObject importedValue: self.
	bindingVariable ifNotNil: [
		bindingVariable ssaBindingValue: classObject binding
	].
	self createPublicAccessors

Set the slvm type of the create in image class object.

structure class
createInImageClassObject
	| layoutClass instanceSlots superClassObject |
	layoutClass := self inImageStructureLayoutClass.
	self slots.
	instanceSlots := allSlots collect: [:slot | (SLVMStructureFieldSlot named: slot name) type: slot type ssaType].

	self flag: 'HACK: remove the methods from the class to avoid triggering recompilation with the wrong compiler.'.
	(name isNotNil and: [ Smalltalk globals includesKey: name ]) ifTrue: [
		(Smalltalk globals at: name) methodDict removeAll.
		(Smalltalk globals at: name) class methodDict removeAll.
	].

	superClassObject := SLVMInternalStructure.
	classObject := superClassObject classInstaller make: [ :builder |
		name ifNotNil: [
			builder name: name asSymbol
		].
		builder
			superclass: superClassObject;
			layoutClass: layoutClass;
			slots: instanceSlots;
			sharedVariables: '';
			sharedPools: '';
			category: self category
	].

	classObject classLayout minimalAlignment: minimalAlignment.
	classObject _slvm_type: self ssaType.
	compiler importImageClassType: classObject importedValue: self.
	bindingVariable ifNotNil: [
		bindingVariable ssaBindingValue: classObject binding
	].
	self createPublicAccessors


Extension { #name : #InputEventHandler }

{ #category : #'*Deprecated70' }
InputEventHandler >> isKbdEvent: bufEvt [

	self
		deprecated: 'Use #isKeyboardEvent: for better understandability'
		transformWith: '`@receiver isKbdEvent: `@bufEvt'
						-> '`@receiver isKeyboardEvent: `@bufEvt'.

	^self isKeyboardEvent: bufEvt
]

Add space to trigger ci


Class {
	#name : #FFICompilerPlugin,
	#superclass : #OCCompilerASTPlugin,
	#category : #UnifiedFFI
}

{ #category : #api }
FFICompilerPlugin >> transform [
	| rule pattern |
	pattern := '`@message ffiCall: ``@args'.
	rule := RBParseTreeSearcher new
		matchesAnyOf: {pattern}
		do: [ :node :answer | ast propertyAt: #methodProperties ifAbsentPut: [ FFIAdditionalFFIMethodState new: 0 ] ].
	rule executeTree: ast.
	ast propertyAt: #methodProperties ifPresent: [ :methodState | methodState argsNames: ast argumentNames ] ifAbsent: [  ].
	^ ast
]

Add more patterns in the transformation

Class {
	#name : #FFICompilerPlugin,
	#superclass : #OCCompilerASTPlugin,
	#category : #UnifiedFFI
}

{ #category : #api }
FFICompilerPlugin >> transform [
	| rule patterns |
	patterns := {'`@message ffiCall: ``@args' . '`@message ffiCall: ``@args module: ``@args' .
	'`@message ffiCall: ``@args  module: ``@args options: ``@args' . '`@message ffiCall: ``@args options: ``@args'}.
	rule := RBParseTreeSearcher new
		matchesAnyOf: patterns
		do:
			[ :node :answer | ast propertyAt: #methodProperties ifAbsentPut: [ FFIAdditionalFFIMethodState new: 0 ] ].
	rule executeTree: ast.
	ast
		propertyAt: #methodProperties
		ifPresent: [ :methodState | methodState argsNames: ast argumentNames ]
		ifAbsent: [  ].
	^ ast
]


Extension { #name : #PluggableMenuItemSpec }

{ #category : #'*Morphic-Base' }
PluggableMenuItemSpec >> asMenuItemMorphFrom: parentMenu isLast: aBoolean [

	| it act lbl menu |
	it := self morphClass new.
	lbl := self label ifNil: [''].
	"here checked can be nil, true, false"
	checked notNil
		ifTrue: [ lbl := self hasCheckBox -> lbl].
	it contents: lbl.
	it icon: self icon.
	it keyText: self keyText.
	it isEnabled: self enabled.
	(act := self action) ifNotNil: [
				it
					target: act receiver;
					selector: act selector;
					arguments: act arguments ].
	(menu := self subMenu) ifNotNil: [ self enabled ifTrue: [ it subMenu: (menu asMenuMorph) ]].

	parentMenu ifNotNil: [ parentMenu addMorphBack: it ].
	aBoolean ifFalse: [ self separator ifTrue: [ parentMenu addLine ] ].
	^it
]

{ #category : #'*Morphic-Base' }
PluggableMenuItemSpec >> morphClass [
	^ ToggleMenuItemMorph
]

Set balloonText after the spec's help.

Extension { #name : #PluggableMenuItemSpec }

{ #category : #'*Morphic-Base' }
PluggableMenuItemSpec >> asMenuItemMorphFrom: parentMenu isLast: aBoolean [

	| it act lbl menu |
	it := self morphClass new.
	lbl := self label ifNil: [''].
	"here checked can be nil, true, false"
	checked notNil
		ifTrue: [ lbl := self hasCheckBox -> lbl].
	it contents: lbl.
	it icon: self icon.
	it keyText: self keyText.
	it isEnabled: self enabled.
	it balloonText: self help.
	(act := self action) ifNotNil: [
				it
					target: act receiver;
					selector: act selector;
					arguments: act arguments ].
	(menu := self subMenu) ifNotNil: [ self enabled ifTrue: [ it subMenu: (menu asMenuMorph) ]].

	parentMenu ifNotNil: [ parentMenu addMorphBack: it ].
	aBoolean ifFalse: [ self separator ifTrue: [ parentMenu addLine ] ].
	^it
]

{ #category : #'*Morphic-Base' }
PluggableMenuItemSpec >> morphClass [
	^ ToggleMenuItemMorph
]


#########################################
External Configuration Specification
#########################################

Abstract
==========

This document is described for the specifications of the external setting.

Registries
==========

$_output.Entries.RegistryEntries:{entry|
ID: $entry.Define.ID$
------------------------------

$entry.Define.Description$

* Type: $entry.Define.Type$
* Key: $entry.Key$
* Name: $entry.Name$
* Default: $entry.DefaultValue$

}$

Environment Variables
======================

$_output.Entries.EnvironmentVariableEntries:{entry|
ID: $entry.Define.ID$
------------------------------

$entry.Define.Description$

* Type: $entry.Define.Type$
* Name: $entry.VariableName$
* Default: $entry.DefaultValue$

}$

Commandline Arguments
=====================

$_output.Entries.CommandLineArgumentEntries:{entry|
ID: $entry.Define.ID$
------------------------------

$entry.Define.Description$

* Type: $entry.Define.Type$
* Name: $entry.ArgumentName$
* Ignore Case: $entry.IgnoreCase$
* Default: $entry.DefaultValue$

}$

Static Values
==============

$_output.Entries.StaticValueEntries:{entry|
ID: $entry.Define.ID$
------------------------------

$entry.Define.Description$

* Type: $entry.Define.Type$
* Value: $entry.Value$

}$

Remove title from rst template.


sources, change log
lastUpdateString
	"SmalltalkImage current lastUpdateString"
	^'Latest update: #', SystemVersion current highestUpdate printString

Fix case 20321: about window should show build info

sources, change log
lastUpdateString
	"SmalltalkImage current lastUpdateString"
	^'Build information: ', SystemVersion current suffix asString


Class {
	#name : #GtBaselinesShouldProperlySpecifyDependencies,
	#superclass : #GtPharoConstraint,
	#category : #'GToolkit-Constraints'
}

{ #category : #accessing }
GtBaselinesShouldProperlySpecifyDependencies >> issues [
	| gtProject allDependencies analyzers |
	gtProject := BaselineOfGToolkit gtRlProjectWithRepository: 'github://feenkcom/gtoolkit/src'.
	allDependencies := gtProject withAllChildProjects.

	analyzers := allDependencies collect: [:aProject |
		(GtDependencyAnalyzerForBaseline new baseline: aProject baselineClass)
			preloadedBaselines: aProject baselineClass gtDependencyAnalysisPreloadedBaselines ].

	^ analyzers select: [ :aBaselineAnalizer |
		(aBaselineAnalizer issuesWithContext: GtDependencyAnalyzerContext new) size > 0 ]

]

{ #category : #accessing }
GtBaselinesShouldProperlySpecifyDependencies >> name [
	^ 'Baselines should properly define project dependencies'
]

{ #category : #accessing }
GtBaselinesShouldProperlySpecifyDependencies >> status [
	^ GtNeutralConstraintStatus new
]

Add an example for using in documentation in blocSpartaPackageAnalysisExample

Class {
	#name : #GtBaselinesShouldProperlySpecifyDependencies,
	#superclass : #GtPharoConstraint,
	#category : #'GToolkit-Constraints'
}

{ #category : #example }
GtBaselinesShouldProperlySpecifyDependencies class >> blocSpartaPackageAnalysisExample [
	<gtExample>
	| analyzer packageAnalyzers blocSpartaPackageAnaluser |
	analyzer :=GtDependencyAnalyzerEasy analyzeBaseline: BaselineOfBloc.

	packageAnalyzers := analyzer directlyDefinedPackagesWithContext: GtDependencyAnalyzerContext new.

	blocSpartaPackageAnaluser := packageAnalyzers detect: [ :aPackageAnalyser | aPackageAnalyser name = 'Bloc-Sparta' ].

	^ blocSpartaPackageAnaluser
]

{ #category : #accessing }
GtBaselinesShouldProperlySpecifyDependencies >> issues [
	| gtProject allDependencies analyzers |
	gtProject := BaselineOfGToolkit gtRlProjectWithRepository: 'github://feenkcom/gtoolkit/src'.
	allDependencies := gtProject withAllChildProjects.

	analyzers := allDependencies collect: [:aProject |
		(GtDependencyAnalyzerForBaseline new baseline: aProject baselineClass)
			preloadedBaselines: aProject baselineClass gtDependencyAnalysisPreloadedBaselines ].

	^ analyzers select: [ :aBaselineAnalizer |
		(aBaselineAnalizer issuesWithContext: GtDependencyAnalyzerContext new) size > 0 ]

]

{ #category : #accessing }
GtBaselinesShouldProperlySpecifyDependencies >> name [
	^ 'Baselines should properly define project dependencies'
]

{ #category : #accessing }
GtBaselinesShouldProperlySpecifyDependencies >> status [
	^ GtNeutralConstraintStatus new
]


specs
defaultSpec
	<spec: #default>
	^ SpecColumnLayout composed
		add: #menu height: self toolbarHeight;
			"withConstraints: [ :constraints | constraints height: self toolbarHeight ];"
		add:
			(SpecRowLayout composed
				"position: 200;"
				add: #list;
				addSplitter;
				add: #pane;
				yourself);
		yourself
	"^ SpecBoxLayout newVertical
		add: #menu
			withConstraints: [ :constraints | constraints height: self toolbarHeight ];
		add:
			(SpecPanedLayout newHorizontal
				position: 200;
				add: #list;
				add: #pane;
				yourself);
		yourself"

Remove the currently not needed splitter.

specs
defaultSpec
	<spec: #default>
	^ SpecColumnLayout composed
		add: #menu height: self toolbarHeight;
			"withConstraints: [ :constraints | constraints height: self toolbarHeight ];"
		add:
			(SpecRowLayout composed
				"position: 200;"
				add: #pane;
				yourself);
		yourself
	"^ SpecBoxLayout newVertical
		add: #menu
			withConstraints: [ :constraints | constraints height: self toolbarHeight ];
		add:
			(SpecPanedLayout newHorizontal
				position: 200;
				add: #list;
				add: #pane;
				yourself);
		yourself"


Class {
	#name : #BaselineOfBlocSparta,
	#superclass : #BaselineOf,
	#category : #BaselineOfBlocSparta
}

{ #category : #baseline }
BaselineOfBlocSparta >> baseline: spec [
	<baseline>
	spec for: #'common' do: [
		spec
			baseline: 'Sparta' with: [
				spec repository: 'github://feenkcom/Sparta/src' ];
			baseline: 'BlocCore' with: [
				spec repository: 'github://pharo-graphics/Bloc/src' ];
			baseline: 'BlocText' with: [
				spec repository: 'github://pharo-graphics/Bloc/src' ].

		spec
			package: #'Bloc-Compositor' with: [
				spec requires: #('BlocCore' 'Sparta'). ].

		spec
			package: #'Bloc-Sparta' with: [
				spec requires: #('Sparta' 'BlocCore' 'BlocText' 'Bloc-Compositor'). ] ].
]

Use pharo-graphics fork of Sparta

Class {
	#name : #BaselineOfBlocSparta,
	#superclass : #BaselineOf,
	#category : #BaselineOfBlocSparta
}

{ #category : #baseline }
BaselineOfBlocSparta >> baseline: spec [
	<baseline>
	spec for: #'common' do: [
		spec
			baseline: 'Sparta' with: [
				spec repository: 'github://pharo-graphics/Sparta/src' ];
			baseline: 'BlocCore' with: [
				spec repository: 'github://pharo-graphics/Bloc/src' ];
			baseline: 'BlocText' with: [
				spec repository: 'github://pharo-graphics/Bloc/src' ].

		spec
			package: #'Bloc-Compositor' with: [
				spec requires: #('BlocCore' 'Sparta'). ].

		spec
			package: #'Bloc-Sparta' with: [
				spec requires: #('Sparta' 'BlocCore' 'BlocText' 'Bloc-Compositor'). ] ].
]


| runner failures errors |

Gofer new
  url: 'http://smalltalkhub.com/mc/adolfopa/MicroKanren/main'
    username: ''
    password: '';
  package: 'MicroKanren';
  load.

runner := CommandLineTestRunner runPackage: 'MicroKanren'.

failures := runner instVarNamed: #suiteFailures.
errors := runner instVarNamed: #suiteErrors.

(errors ~= 0) | (failures ~= 0)
  ifTrue: [ SmalltalkImage current exitFailure ].

SmalltalkImage current exitSuccess.

Load package from cloned Git repo

| runner failures errors buildDir |

buildDir := OSPlatform current environment at: 'TRAVIS_BUILD_DIR'.

Gofer new
  url: 'filetree://', buildDir, '/src'
    username: ''
    password: '';
  package: 'MicroKanren';
  load.

runner := CommandLineTestRunner runPackage: 'MicroKanren'.

failures := runner instVarNamed: #suiteFailures.
errors := runner instVarNamed: #suiteErrors.

(errors ~= 0) | (failures ~= 0)
  ifTrue: [ SmalltalkImage current exitFailure ].

SmalltalkImage current exitSuccess.


"
This class is here for compatibility.
"
Class {
	#name : #RTLabelled,
	#superclass : #RTLabeled,
	#category : #'Roassal2-Interactions'
}

{ #category : #'instance creation' }
RTLabelled class >> new [
	self error: 'RTLabelled is deprecated. Please use RTLabeled'.
	^ super new
]

Use the usual way of deprecation

"
This class is here for compatibility.
"
Class {
	#name : #RTLabelled,
	#superclass : #RTLabeled,
	#category : #'Roassal2-Interactions'
}

{ #category : #'instance creation' }
RTLabelled class >> new [
	self deprecated: 'RTLabelled is deprecated. Please use RTLabeled'.
	^ super new
]


private
filteredMasterStack
	| masterHolder entryPointHolder |
	masterHolder := interruptedProcess masterProcessHolder.
	entryPointHolder := masterHolder findContextHolderSuchThat: [ :contextHolder |
		contextHolder originalContext selector = #newUserProcess ].

	^ masterHolder stackStartingAt: entryPointHolder

Use full stack of master for remote promises

private
filteredMasterStack
	| masterHolder entryPointHolder |
	masterHolder := interruptedProcess masterProcessHolder.
	entryPointHolder := masterHolder findContextHolderSuchThat: [ :contextHolder |
		contextHolder originalContext selector = #newUserProcess ].

	^ entryPointHolder
		ifNil: [ masterHolder stack ]
		ifNotNil: [ masterHolder stackStartingAt: entryPointHolder ]


"If Seaside loads Parasol and Parasol loads Seaside, an infinite reload loop can occur. For GemStone, the infinite
	reloade loop has been broken. Travis tests require Seaside to be installed, so install Seaside, explicitly"
Metacello new
 baseline:'Seaside3';
 repository: 'github://SeasideSt/Seaside:master/repository';
 load: #('Zinc-Seaside' 'Seaside-JSON-Core' 'Javascript-Core').

Revert "Should not load the Seaside Parasol Tests"

"If Seaside loads Parasol and Parasol loads Seaside, an infinite reload loop can occur. For GemStone, the infinite
	reloade loop has been broken. Travis tests require Seaside to be installed, so install Seaside, explicitly"
Metacello new
 baseline:'Seaside3';
 repository: 'github://SeasideSt/Seaside:master/repository';
 load: #('Parasol-Tests' 'Zinc-Seaside' 'Seaside-JSON-Core' 'Javascript-Core').


"
This provider uses CairoFontMetricsProvider to calculate the width of text, but uses `font height` to calculate the height
"
Class {
	#name : #RSCairoMetricsProvider,
	#superclass : #RSCairoFitMetricsProvider,
	#category : #'Roassal3-Shapes-Text'
}

{ #category : #hooks }
RSCairoMetricsProvider >> extentsOf: aRSLabel [
	| res font h|
	font := aRSLabel font.
	res := super extentsOf: aRSLabel.
	h := font height asFloat.
	res
		height: h;
		y_bearing: (h / 4) - h.
	^ res
]

Update y_bearing for now It seems to work

"
This provider uses CairoFontMetricsProvider to calculate the width of text, but uses `font height` to calculate the height
"
Class {
	#name : #RSCairoMetricsProvider,
	#superclass : #RSCairoFitMetricsProvider,
	#category : #'Roassal3-Shapes-Text'
}

{ #category : #hooks }
RSCairoMetricsProvider >> extentsOf: aRSLabel [
	| res font h |
	font := aRSLabel font.
	res := super extentsOf: aRSLabel.
	h := font height asFloat.
	res
		height: h;
		y_bearing: h *2/ -3.
	^ res
]


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

{ #category : #accessing }
GLMAbstractExportingAction >> category [
	^ 'Export as...'
]

{ #category : #hooks }
GLMAbstractExportingAction >> doExportToFull: fileName [

	self subclassResponsibility
]

{ #category : #hooks }
GLMAbstractExportingAction >> execute [
	| fileName |
	fileName := UITheme builder
						fileSave: 'Enter the ', self titleExtension,' file name'
						extensions: self extensions
						path: nil.
	fileName notNil ifTrue: [
		self doExportToFull: fileName asAbsolute ]
]

{ #category : #hooks }
GLMAbstractExportingAction >> extensions [
	"
	May return for example: #('png')
	"
	^ #()
]

{ #category : #hooks }
GLMAbstractExportingAction >> title [
	^ 'Export to ', self titleExtension
]

{ #category : #hooks }
GLMAbstractExportingAction >> titleExtension [
	^ 'TOOVERRIDE'
]

Fix bad message send to UITheme builder

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

{ #category : #accessing }
GLMAbstractExportingAction >> category [
	^ 'Export as...'
]

{ #category : #hooks }
GLMAbstractExportingAction >> doExportToFull: fileName [

	self subclassResponsibility
]

{ #category : #hooks }
GLMAbstractExportingAction >> execute [
	| fileName |
	fileName := UITheme builder
						chooseForSaveFileReference: 'Enter the ', self titleExtension, ' file name'
						extensions: self extensions
						path: FileLocator home asPath.

	fileName notNil ifTrue: [
		self doExportToFull: fileName asAbsolute ]
]

{ #category : #hooks }
GLMAbstractExportingAction >> extensions [
	"
	May return for example: #('png')
	"
	^ #()
]

{ #category : #hooks }
GLMAbstractExportingAction >> title [
	^ 'Export to ', self titleExtension
]

{ #category : #hooks }
GLMAbstractExportingAction >> titleExtension [
	^ 'TOOVERRIDE'
]


Class {
	#name : #BlTktCommonPriorityQueueWorkerPool,
	#superclass : #BlTktCommonQueueWorkerPool,
	#category : #'Bloc-TaskIt-Workers'
}

{ #category : #initialization }
BlTktCommonPriorityQueueWorkerPool >> initialize [
	super initialize.
	taskQueue := AtomicSharedPriorityQueue new.
]

Use SharedPriorityUniqueQueue in TaskIt queues

Class {
	#name : #BlTktCommonPriorityQueueWorkerPool,
	#superclass : #BlTktCommonQueueWorkerPool,
	#category : #'Bloc-TaskIt-Workers'
}

{ #category : #initialization }
BlTktCommonPriorityQueueWorkerPool >> initialize [
	super initialize.
	taskQueue := SharedPriorityUniqueQueue new.
]


Home

<form action="/packages/search" method="get" class="search"><button type="submit" />Search </button><input type="text" name="terms" /></form>

Browse

What's new

Upload

User accounts

Admin

Hackage :: [Package]

Fix invalid html in page header template

Home

<form action="/packages/search" method="get" class="search"><button type="submit">Search </button><input type="text" name="terms" /></form>

Browse

What's new

Upload

User accounts

Admin

Hackage :: [Package]


running
setUp
	repository := VOArangoRepository uri: 'http://localhost:8529'

Set up generator class for arango

running
setUp
	repository := VOArangoRepository uri: 'http://localhost:8529'.
	PQQueryBuilder generatorClass: PQArangoQueryGenerator.


initialization
initialize
	super initialize.

	selectionHolder := Object selectionReactiveVariable.
	listHolder := Array new asReactiveVariable.
	sortingBlockHolder := self defaultSortingBlock asReactiveVariable.
	filteringBlockHolder := self defaultFilteringBlock asReactiveVariable.
	wrapBlockHolder := [ :object | object asStringOrText ] asReactiveVariable.
	menuHolder := [ :menu :shifted | nil ] asReactiveVariable.
	multiSelectionHolder := IdentityDictionary new asReactiveVariable.
	multiSelection := false asReactiveVariable.
	allowToSelect := true asReactiveVariable.
	backgroundColorBlock := [ :item :index | UITheme current backgroundColor ] asReactiveVariable.
	autoDeselect := true asReactiveVariable.
	listAnnouncer := Announcer new.
	self registerEvents.

	self
		bindKeyCombination: Character space
		toAction: [ self clickOnSelectedItem ]

Use `windowColor` instead of `backgroundColor`

initialization
initialize
	super initialize.

	selectionHolder := Object selectionReactiveVariable.
	listHolder := Array new asReactiveVariable.
	sortingBlockHolder := self defaultSortingBlock asReactiveVariable.
	filteringBlockHolder := self defaultFilteringBlock asReactiveVariable.
	wrapBlockHolder := [ :object | object asStringOrText ] asReactiveVariable.
	menuHolder := [ :menu :shifted | nil ] asReactiveVariable.
	multiSelectionHolder := IdentityDictionary new asReactiveVariable.
	multiSelection := false asReactiveVariable.
	allowToSelect := true asReactiveVariable.
	backgroundColorBlock := [ :item :index | UITheme current windowColor ] asReactiveVariable.
	autoDeselect := true asReactiveVariable.
	listAnnouncer := Announcer new.
	self registerEvents.

	self
		bindKeyCombination: Character space
		toAction: [ self clickOnSelectedItem ]


class initialization
initialize
	self reset.
	self subscribe

Add the old instance unsubscription to the rule manager initialization

class initialization
initialize
	self allInstances do: [ :inst |
		self flag: 'remove in future. this is just to stop
		            the announcements from choaking old instances'.
		SystemAnnouncer uniqueInstance unsubscribe: inst ].

	self reset.
	self subscribe.


Home

      <form action="/packages/search" method="get" class="search">
        <button type="submit">Search </button>
        <input type="text" name="terms" />
      </form>

Browse

What's new

Upload

User accounts

$if(title)$
$title$

$else$
Hackage :: [Package]
$endif$

Fix stray
 in page-header template


menu
openDataSource
	" Private - Request file "

	BioObject requestXmlFile ifNotNilDo: [ : fileName |
		self openBlastNamed: fileName ].

Clean classifier from CSV behavior Added abstract rule tree hierarchy

menu
openDataSource
	" Private - Request file "

	BioObject requestOpenXMLFile ifNotNilDo: [ : fileName |
		self openBlastNamed: fileName ].


"
A RTDraggableChildren makes an element draggable. When dragged, children of the elements are also being dragged.
"
Class {
	#name : #RTDraggableChildren,
	#superclass : #RTInteraction,
	#category : #'Roassal2-Core'
}

{ #category : #hooks }
RTDraggableChildren >> initializeElement: element [
	| recursiveDrag set |

	set := Set new.

	recursiveDrag := [ :elem :ancestor|
		set add: elem.
		elem outgoingEdges do: [ :edge |
			(edge to = ancestor) ifFalse: [
				recursiveDrag value: edge to value: ancestor].
			].
		].

	element when: TRMouseDragging do: [ :e |
		recursiveDrag value: e element value: e element. e signalUpdate.
		set do: [ :e1 | e1 translateBy: e step ].
		 ]

]

Fix RTDraggableChildren to work with zoom

"
A RTDraggableChildren makes an element draggable. When dragged, children of the elements are also being dragged.
"
Class {
	#name : #RTDraggableChildren,
	#superclass : #RTInteraction,
	#category : #'Roassal2-Core'
}

{ #category : #hooks }
RTDraggableChildren >> initializeElement: element [
	| recursiveDrag set |

	set := Set new.

	recursiveDrag := [ :elem :ancestor|
		set add: elem.
		elem outgoingEdges do: [ :edge |
			(edge to = ancestor) ifFalse: [
				recursiveDrag value: edge to value: ancestor].
			].
		].

	element when: TRMouseDragging do: [ :e |
		| d |
		recursiveDrag value: e element value: e element. e signalUpdate.
		d := element view canvas camera distanceFromPixelToSpace: e step.
		set do: [ :e1 | e1 translateBy: d ].
		 ]

]


Class {
	#name : #K2AutomatonTest,
	#superclass : #TestCase,
	#category : #'K2-Automata'
}

{ #category : #tests }
K2AutomatonTest >> testANewAutomatonHasNoStates [

		<gtExample>
	| a |
	a := K2Automaton new.
	self assert: a states isEmpty.
	^ a
]

Remove `testANewAutomatonHasNoStates` and turn it into `testANewAutomatonHasNoStatesExample`.

Class {
	#name : #K2AutomatonTest,
	#superclass : #TestCase,
	#category : #'K2-Automata'
}

{ #category : #tests }
K2AutomatonTest >> testANewAutomatonHasNoStatesExample [

	<gtExample>
	| a |
	a := K2Automaton new.
	self assert: a states isEmpty.
	^ a
]


"
I am a transpiler that can be controlled to support the timing application/
"
Class {
	#name : #PjTimingTestTranspiler,
	#superclass : #PjDependentTranspiler,
	#instVars : [
		'delayDNU'
	],
	#category : #'PharoJsTiming-Timing'
}

{ #category : #accessing }
PjTimingTestTranspiler >> delayDNU [
	^delayDNU
]

{ #category : #accessing }
PjTimingTestTranspiler >> delayDNU: anObject [
	delayDNU := anObject
]

{ #category : #transpiling }
PjTimingTestTranspiler >> generateCodeStringFrom: jsAst [
	self delayDNU ifFalse: [self convertAllClasses: #() writeDnu: true].
	generator asString: jsAst on: self jsStream.

]

{ #category : #'initailize-release' }
PjTimingTestTranspiler >> initialize [
	super initialize.
	self delayDNU: false.
]

Clean up based on DNU registration IV support

"
I am a transpiler that can be controlled to support the timing application/
"
Class {
	#name : #PjTimingTestTranspiler,
	#superclass : #PjDependentTranspiler,
	#instVars : [
		'delayDNU'
	],
	#category : #'PharoJsTiming-Timing'
}

{ #category : #accessing }
PjTimingTestTranspiler >> delayDNU [
	^delayDNU
]

{ #category : #accessing }
PjTimingTestTranspiler >> delayDNU: anObject [
	delayDNU := anObject
]

{ #category : #transpiling }
PjTimingTestTranspiler >> generateCodeStringFrom: jsAst [
	self delayDNU ifFalse: [
		self enableWriteDnuDuring: [self writeDnuList]].
	generator asString: jsAst on: self jsStream.

]

{ #category : #'initailize-release' }
PjTimingTestTranspiler >> initialize [
	super initialize.
	self delayDNU: false.
]


| results |

"Load in the tests appropriate for DPRO and run them,"
Package manager install: 'Core\Object Arts\Dolphin\Base\Dolphin Base Tests.pax'.

results := SmalltalkSystem current runRegressionTests.
SessionManager current quit: results failureCount+results errorCount !

Allow message queue to stabilize

[ | results |

Processor sleep: 1000.

"Load in the tests appropriate for DPRO and run them,"
Package manager install: 'Core\Object Arts\Dolphin\Base\Dolphin Base Tests.pax'.

results := SmalltalkSystem current runRegressionTests.
SessionManager current quit: results failureCount+results errorCount] postToInputQueue !


    <title>Aurora $cluster_name$ slaves</title>
    <link href="/css/bootstrap.min.css" rel="stylesheet" />

Slave Hosts

        Host
        Slave ID
        Maintenance mode
        Attributes

        $slaves:{ slave |

          $slave.host$
          $slave.id$
          $slave.mode$
          $slave.attributes$

        }$

    $if(exception)$
      Exception: $exception$
    $endif$

Update slave url to use the thermos port.


Class {
	#name : #MCDirectoryRepositoryTest,
	#superclass : #MCRepositoryTest,
	#instVars : [
		'directory'
	],
	#category : #'Monticello-Tests-Repository'
}

{ #category : #actions }
MCDirectoryRepositoryTest >> addVersion: aVersion [
	| file |
	file := (directory / aVersion fileName) asFileReference binaryWriteStream.
	aVersion fileOutOn: file.
	file close.
]

{ #category : #accessing }
MCDirectoryRepositoryTest >> directory [
	directory ifNil:
		[directory := 'mctest' asFileReference.
		directory ensureCreateDirectory].
	^ directory
]

{ #category : #running }
MCDirectoryRepositoryTest >> setUp [
	super setUp.
	repository := MCDirectoryRepository new directory: self directory
]

{ #category : #running }
MCDirectoryRepositoryTest >> tearDown [
	self directory ensureDeleteAll.
	super tearDown

]

Make sure write streams are closed

Class {
	#name : #MCDirectoryRepositoryTest,
	#superclass : #MCRepositoryTest,
	#instVars : [
		'directory'
	],
	#category : #'Monticello-Tests-Repository'
}

{ #category : #actions }
MCDirectoryRepositoryTest >> addVersion: aVersion [

	(directory / aVersion fileName) asFileReference
		binaryWriteStreamDo: [ :stream |
			aVersion fileOutOn: stream ]
]

{ #category : #accessing }
MCDirectoryRepositoryTest >> directory [
	directory ifNil:
		[directory := 'mctest' asFileReference.
		directory ensureCreateDirectory].
	^ directory
]

{ #category : #running }
MCDirectoryRepositoryTest >> setUp [
	super setUp.
	repository := MCDirectoryRepository new directory: self directory
]

{ #category : #running }
MCDirectoryRepositoryTest >> tearDown [

	self directory ensureDeleteAll.
	super tearDown
]


"
I am not a test! I provide usage examples for the SUnit debugger.
"
Class {
	#name : #GTSUnitExampleWithProblematicSetUpTest,
	#superclass : #TestCase,
	#category : #'GT-SUnitDebugger'
}

{ #category : #testing }
GTSUnitExampleWithProblematicSetUpTest class >> isAbstract [
	^ true
]

{ #category : #testing }
GTSUnitExampleWithProblematicSetUpTest class >> isUnitTest [
	^ false
]

{ #category : #running }
GTSUnitExampleWithProblematicSetUpTest >> setUp [
	super setUp.
	42 messageThatIsNotUnderstood
]

{ #category : #testing }
GTSUnitExampleWithProblematicSetUpTest >> testWithErrorInSetup [
	self assert: true
]

Add space to trigger CI


as yet unclassified
build
|b normalize lb|
	b := RTGrapher new.
	b extent: 400 @ 200.
	normalize := RTMultiLinearColorForIdentity new
						objects: self legends;
						colors: (RTColorPalette qualitative colors: 9 scheme: 'Set1').
	1 to: legends size do: [ :i|
		|ds|
		ds := RTDataSet new.
		ds noDot.
		ds points: (data at: i) value index.
		ds x: #yourself.
		ds y: [ :x| (data at: i) value at: x ].
		ds connectColor: (normalize rtValue: (legends at: i)).
		b add: ds.
		 ].
	xLabel ifNil: [ b axisX title: 'Time (days)' ]
	       ifNotNil: [ b axisX title: xLabel ].
	yLabel ifNil: [ b axisY title: 'Number of individuals' ]
	       ifNotNil: [ b axisY title: yLabel ].
	b axisY noDecimal.
	lb := RTLegendBuilder new.
	lb view: b view.
	self legendTitle ifNil: [ legendTitle := 'Compartments' ].
	lb addText: legendTitle.
	1 to: legends size do: [ :i| |c|
		c:= (normalize rtValue: (legends at: i)).
		lb addColor: c text: (legends at: i) ].
	lb build.
	"b build."
	b view @ RTZoomableView.
	^ b

Return to use RTData because this bug has been fixed by A. Bergel

as yet unclassified
build
|b normalize lb|
	b := RTGrapher new.
	b extent: 400 @ 200.
	normalize := RTMultiLinearColorForIdentity new
						objects: self legends;
						colors: (RTColorPalette qualitative colors: 9 scheme: 'Set1').
	1 to: legends size do: [ :i|
		|ds|
		ds := RTData new.
		ds noDot.
		ds points: (data at: i) value index.
		ds x: #yourself.
		ds y: [ :x| (data at: i) value at: x ].
		ds connectColor: (normalize rtValue: (legends at: i)).
		b add: ds.
		 ].
	xLabel ifNil: [ b axisX title: 'Time (days)' ]
	       ifNotNil: [ b axisX title: xLabel ].
	yLabel ifNil: [ b axisY title: 'Number of individuals' ]
	       ifNotNil: [ b axisY title: yLabel ].
	b axisY noDecimal.
	lb := RTLegendBuilder new.
	lb view: b view.
	self legendTitle ifNil: [ legendTitle := 'Compartments' ].
	lb addText: legendTitle.
	1 to: legends size do: [ :i| |c|
		c:= (normalize rtValue: (legends at: i)).
		lb addColor: c text: (legends at: i) ].
	lb build.
	"b build."
	b view @ RTZoomableView.
	^ b